Megatest

Check-in [49f0afc304]
Login
Overview
Comment:wip. not much improvement...
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 49f0afc30430be9a920ea00612dbe05ab538d5ea
User & Date: matt on 2022-01-07 17:11:31
Other Links: branch diff | manifest | tags
Context
2022-01-08
20:46
Switch to using threads instead of mailbox for worker calls. Seems to not block as much. check-in: ba5884c651 user: matt tags: v2.0001
2022-01-07
17:11
wip. not much improvement... check-in: 49f0afc304 user: matt tags: v2.0001
2022-01-06
18:18
Ensure api calls to db do NOT occur on non-server processes. check-in: 7696fcfff8 user: matt tags: v2.0001
Changes

Modified TODO from [1f8790aebc] to [8c7ba74ce3].

16
17
18
19
20
21
22



23
24
25
26
27
28
29
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32







+
+
+







#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

TODO
====

Loose ends
----------

15:09:29 error in calling find-and-mark-incomplete for run-id 5, exn=#<condition: (exn type)>
         might be related to initial conditions in the db. (no run entry in runs table?).

. -list-servers not correct
. move *remotedat* into bigdata
. add back server stats on exit (look in rmt:run in rmtmod.scm)


WW15

Modified commonmod.scm from [4042487aab] to [9a2ccbe33e].

384
385
386
387
388
389
390

391
392
393
394
395
396
397
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398







+







*task-db*
*db-access-allowed*
*db-access-mutex*
*db-transaction-mutex*
*db-cache-path*
*db-with-db-mutex*
*db-api-call-time*
*didsomething*
*no-sync-db*
*my-signature*
*transport-type*
*logged-in-clients*
*server-run*
*run-id*
*server-kind-run*
922
923
924
925
926
927
928

929
930
931
932
933
934
935
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937







+







;; (define *watchdog* #f)
;; A hash table that can be accessed by #{scheme ...} calls in
;; config files. Allows communicating between confgs
;;
(define *user-hash-data* (make-hash-table))

(define *db-keys* #f)
(define *didsomething* #f)

(define *pkts-info*    (make-hash-table)) ;; store stuff like the last parent here
(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f)   ;; run configs data
(define *configdat*    #f)   ;; megatest.config data ==> moved to configfmod
(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath*      #f)

Modified dbmod.scm from [f6dcc2b111] to [4d2069b432].

3443
3444
3445
3446
3447
3448
3449
3450

3451
3452
3453

3454
3455
3456
3457
3458
3459
3460
3443
3444
3445
3446
3447
3448
3449

3450



3451
3452
3453
3454
3455
3456
3457
3458







-
+
-
-
-
+







      ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted') AND NOT (uname = 'n/a' AND item_path = '');")
      "SELECT count(id) FROM tests WHERE state in ('RUNNING','REMOTEHOSTSTART','LAUNCHED') AND run_id=?;" 
      run-id)))) ;; NOT IN (SELECT id FROM runs WHERE state='deleted');")

;; NEW BEHAVIOR: Look only at single run with run-id
;; 
;; (define (db:get-running-stats dbstruct run-id)
(define (db:get-count-tests-running-for-run-id dbstruct run-id) ;; fastmode)
(define (db:get-count-tests-running-for-run-id dbstruct run-id) 
  (let* ((qry ;; (if fastmode
		 ;;  "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? LIMIT 1;"
		  "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;")) ;; )
  (let* ((qry  "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;")) ;; )
    (db:with-db
     dbstruct
     run-id
     #f
     (lambda (db)
       (let* ((stmth (db:get-cache-stmth dbstruct db qry)))
	 (sqlite3:first-result stmth run-id))))))

Modified megatest.scm from [a1cea3fd33] to [be96ddd230].

159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173







-
+







	  tasksmod
	  testsmod
	  
	  )
	
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(define *didsomething* #f)  
(define *db* #f) ;; this is only for the repl, do not use in general!!!!

;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
;; (include "test_records.scm")
317
318
319
320
321
322
323
324

325
326
327
328
329
330
331
317
318
319
320
321
322
323

324
325
326
327
328
329
330
331







-
+







     			 newlogf)
     		       logpath-in)))
     (if (not (directory-exists? log-dir))
	 (system (conc "mkdir -p " log-dir)))
     (open-output-file logpath))
   (exn ()
	(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath-in)
	(define *didsomething* #t)  
	(set! *didsomething* #t)
	(exit 1))))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
501
502
503
504
505
506
507








508
509
510
511
512
513
514







-
-
-
-
-
-
-
-








Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
     
(define (main)
  (make-and-init-bigdata)

  
  ;; set up the functions in http transport
;;   (hash-table-set! *http-functions* 'api:process-request          api:process-request)
;;   (hash-table-set! *http-functions* 'http-transport:main-page     http-transport:main-page)
;;   (hash-table-set! *http-functions* 'http-transport:show-jquery   http-transport:show-jquery)
;;   (hash-table-set! *http-functions* 'http-transport:html-test-log http-transport:html-test-log)
;;   (hash-table-set! *http-functions* 'http-transport:html-dboard   http-transport:html-dboard)
  
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

;; usage logging, careful with this, it is not designed to deal with all real world challenges!
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
818
819
820
821
822
823
824


825
826
827
828
829
830
831







-
-







           (exit)))
     
     (if (args:get-arg "-version")
         (begin
           (print (common:version-signature)) ;; (print megatest-version)
           (exit)))
     
     (define *didsomething* #f)
     
     ;; Overall exit handling setup immediately
     ;;
     (if (or (args:get-arg "-process-reap"))
             ;; (args:get-arg "-runtests")
     	;; (args:get-arg "-execute")
     	;; (args:get-arg "-remove-runs")
     	;; (args:get-arg "-runstep"))
2638
2639
2640
2641
2642
2643
2644
2645

2646
2647
2648
2649
2650
2651
2652
2628
2629
2630
2631
2632
2633
2634

2635
2636
2637
2638
2639
2640
2641
2642







-
+







         (bdat-time-to-exit-set! *bdat* #t)
         )
     ;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")
     
     ;; join the watchdog thread if it has been thread-start!ed  (it may not have been started in the case of a server that never enters running state)
     ;;   (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
     ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
     (let* ((watchdog (bdat-watchdog *bdat*)))
     #;(let* ((watchdog (bdat-watchdog *bdat*)))
       (if (thread? watchdog)
	   (case (thread-state watchdog)
	     ((ready running blocked sleeping terminated dead)
	      (thread-join! watchdog)))))
     
     (bdat-time-to-exit-set! *bdat* #t)
     

Modified rmtmod.scm from [dd95d47953] to [941de4f2ec].

349
350
351
352
353
354
355
356

357
358
359
360
361
362
363
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363







-
+







	 (sinfo      *db-serv-info*)
	 (dbname     (db:run-id->dbname rid)))
    (if *localmode*
	(api:execute-requests *dbstruct* cmd params)
	(begin
	  (rmt:open-main-connection sinfo apath)
	  (if rid (rmt:general-open-connection sinfo apath dbname))
	  (if (not (member cmd '(log-to-main)))
	  #;(if (not (member cmd '(log-to-main)))
	      (debug:print-info 0 *default-log-port* "rmt:send-receive "cmd" params="params))
	  (rmt:send-receive-real sinfo apath dbname cmd params)))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real sinfo apath dbname cmd params)

Modified runsmod.scm from [e0bbf25b11] to [7c62c7e318].

2554
2555
2556
2557
2558
2559
2560
2561


2562
2563
2564
2565
2566
2567
2568
2554
2555
2556
2557
2558
2559
2560

2561
2562
2563
2564
2565
2566
2567
2568
2569







-
+
+







	      (debug:print-error 0 *default-log-port* "Attempted to " action-desc " but run area config file not found")
	      (exit 1))
	    ;; Extract out stuff needed in most or many calls
	    ;; here then call proc
	    (let* ((keyvals    (keys:target->keyval keys target)))
	      (proc target runname keys keyvals)))
	;; (if db (sqlite3:finalize! db))
	(set! *didsomething* #t))))))
	(set! *didsomething* #t)
	)))))

;;======================================================================
;; Lock/unlock runs
;;======================================================================

(define (runs:handle-locking target keys runname lock unlock user)
  (let* ((db       #f)

Modified ulex/ulex.scm from [01c6cea094] to [3ca1071e09].

92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106







-
+







  ;; work handling
  (work-queue (make-mailbox))
  (work-proc  #f)                ;; set by user
  (cnum       0)                 ;; cookie number
  (mboxes     (make-hash-table)) ;; for the replies
  (avail-cmboxes '())            ;; list of (<cookie> . <mbox>) for re-use
  ;; threads
  (numthreads 50)
  (numthreads 10)
  (cmd-thread #f)
  (work-queue-thread #f)
  ) 

;; ;; struct for keeping track of others we are talking to
;; ;;
;; (defstruct pdat