Megatest

Check-in [907e020fcf]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Removed not-working-very-well threading stuff from dashboard and put sync in separate but joined process.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-servload
Files: files | file ages | folders
SHA1: 907e020fcf6f2df431feadaf8c880b74796d3364
User & Date: mrwellan on 2023-05-04 09:21:25
Other Links: branch diff | manifest | tags
Context
2023-05-05
06:46
wip check-in: 411180a81e user: matt tags: v1.80-servload
2023-05-04
09:21
Removed not-working-very-well threading stuff from dashboard and put sync in separate but joined process. check-in: 907e020fcf user: mrwellan tags: v1.80-servload
2023-05-03
22:05
wip check-in: 1e38d0d69d user: matt tags: v1.80-servload
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [3d1081a532] to [1d1d84a489].

︙
241
242
243
244
245
246
247








248

249
250
251
252
253
254
255

241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263








+
+
+
+
+
+
+
+
-
+









  
  (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat
      (let* ((tnum     (or tab-num (dboard:commondat-curr-tab-num commondat)))
	     (updaters (hash-table-ref/default (dboard:commondat-updaters commondat)
					       tnum
					       '())))
	(debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum)
	(for-each ;; perform the function calls for the complete updaters list
	 (lambda (updater)
          ;; (debug:print 3 *default-log-port* "Running " updater)
	   (updater))
	 updaters))))


	(if *updaters-running*
	#;(if *updaters-running*
	    (debug:print 0 *default-log-port* "updaters still running.")
	    (let* ((th1 (make-thread (lambda ()
				       (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum)
				       (for-each ;; perform the function calls for the complete updaters list
					(lambda (updater)
					  (let ((start-ms (current-milliseconds)))
					    (debug:print 0 *default-log-port* "Running updater for tnum "tnum", "updater)
︙
281
282
283
284
285
286
287
288


289
290
291
292
293
294
295

289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304








-
+
+








					      (thread-sleep! 0.5)
					      (loop))))))))
	      (set! *updaters-running* #t)
	      (thread-start! th1)
	      (thread-sleep! 0.1)
	      (thread-start! th2)
	      (thread-join! th1)
	      (set! *updaters-running* #f))))))
(set! *updaters-running* #f)))


;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num
;; adds the updater passed in the updaters list at that hashkey
;;
(define (dboard:commondat-add-updater commondat updater #!key (tab-num #f))
  (let* ((tnum          (or tab-num
			     (dboard:commondat-curr-tab-num commondat)))
︙

Modified dbmod.scm from [e52ded043e] to [a008a03850].

︙
220
221
222
223
224
225
226


227
228
229
230
231
232
233
234
235









236
237
238
239
240
241
242

220
221
222
223
224
225
226
227
228









229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244








+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+








    (dbr:dbstruct-ondiskdb-set!  dbstruct db)
    (dbr:dbstruct-dbfile-set!    dbstruct dbfullname)
    (dbr:dbstruct-dbfname-set!   dbstruct dbfname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if *sync-in-progress*
				       (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
				       (thread-start!
					(make-thread
				       (begin
					 (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db
					 (set! *sync-in-progress* #t)
					 #;(dbmod:sync-gasket tables last-update inmem db
					 dbfullname syncdir)
					 (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname"&"))
					 (mutex-unlock! *db-with-db-mutex*)
					 (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls
					 (set! *sync-in-progress* #f)))))
					 (lambda ()
					   (mutex-lock! *db-with-db-mutex*) ;; this mutex is used when overloaded or during a query that modifies the db
					   (set! *sync-in-progress* #t)
					   #;(dbmod:sync-gasket tables last-update inmem db
					   dbfullname syncdir)
					   (system (conc "megatest -db2db -from "tmpdb" -to "dbfullname))
					   (mutex-unlock! *db-with-db-mutex*)
					   (thread-sleep! 0.5) ;; ensure at least 1/2 second down time between sync calls
					   (set! *sync-in-progress* #f)))))))
    ;; (dbmod:sync-tables tables #f db inmem)
    ;; (if db
    (dbmod:sync-gasket tables #f inmem db dbfullname 'fromdest keys) ;; ) ;; load into inmem
    (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second?
    dbstruct))

;;    (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard
︙
943
944
945
946
947
948
949
950



951
952

945
946
947
948
949
950
951

952
953
954
955
956








-
+
+
+



					     ".")))
			   (if dirname
			       (file-exists? dirname)
			       (file-write-access? dirname)))))
	     (tables (db:sync-all-tables-list keys))
	     (sdb    (dbmod:safely-open-db src-db init-proc #t))
	     (ddb    (dbmod:safely-open-db dest-db init-proc d-wr)))
	(dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))))
	(dbmod:sync-gasket tables last-update sdb ddb dest-db 'todest keys))
      #f
      ))

)

Modified megatest.scm from [4b22029f00] to [a30f723389].

︙
282
283
284
285
286
287
288
289

290
291
292
293
294
295
296

282
283
284
285
286
287
288

289
290
291
292
293
294
295
296








-
+








  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	  : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
  -syscheck               : do some very basic checks; write access and space in tmp, home, runs, links and 
                            is $DISPLAY valid 
  -list-waivers           : dump waivers for specified target, runname, testpatt to stdout
  -db2db                  : sync db to db, use -from and -to to specify the databases
  -db2db                  : sync db to db, use -from, -to for dbs, -period and -timeout for continuous sync

Diff report
  -diff-rep               : generate diff report (must include -src-target, -src-runname, -target, -runname
                                                  and either -diff-email or -diff-html)
  -src-target <target>
  -src-runname <target>
  -diff-email <emails>    : comma separated list of email addresses to send diff report
︙
332
333
334
335
336
337
338
339

340
341
342
343
344
345
346

332
333
334
335
336
337
338

339
340
341
342
343
344
345
346








-
+








			":state"  
			"-state"
			":status"
			"-status"
			"-list-runs"
                        "-testdata-csv"
			"-testpatt"
                        "--modepatt"
                        ;; "--modepatt"
                        "-modepatt"
                        "-tagexpr"
			"-itempatt"
			"-setlog"
			"-set-toplog"
			"-runstep"
			"-logpro"
︙
378
379
380
381
382
383
384


385
386
387
388
389
390
391

378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393








+
+








			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"
			"-import-sexpr"
			"-period"  ;; sync period in seconds
			"-timeout" ;; exit sync if timeout in seconds exceeded since last change

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-age"

			;; archive
︙
2577
2578
2579
2580
2581
2582
2583

2584

2585
2586
2587

2588


2589
2590
2591
2592
2593
2594
2595

2579
2580
2581
2582
2583
2584
2585
2586

2587
2588
2589
2590
2591

2592
2593
2594
2595
2596
2597
2598
2599
2600








+
-
+



+
-
+
+








	   )
      
      (if (and src-db dest-db)
	  (begin
	    (debug:print-info 0 *default-log-port* "Attempting to sync data from "src-db" to "dest-db"...")
	    ;; (if (common:simple-file-lock lockfile)
	    ;; 	(begin
	    (if (and (file-exists? src-db)
	    (if (not (file-exists? dest-db)) ;; use copy to get going
		     (not (file-exists? dest-db))) ;; use copy to get going
		(file-copy src-db dest-db))
	    (let ((res (dbmod:db-to-db-sync src-db dest-db 0 (dbfile:db-init-proc) keys)))
	      ;;    (common:simple-file-release-lock lockfile)
	      (if res
	      (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db)))
		  (debug:print 0 *default-log-port* "Synced " res " records from "src-db" to "dest-db)
		  (debug:print 0 *default-log-port* "No sync due to permissions or non-existant source db."))))
	  (debug:print 0 *default-log-port* "Skipping sync, there is a sync in progress."))
      (set! *didsomething* #t))
    (debug:print 0 *default-log-port* "Usage for -db2db; -to and -from must be specified"))

(if (args:get-arg "-list-test-time")
     (let* ((toppath (launch:setup))) 
     (task:get-test-times)
︙

This page was generated in about 0.111s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00