Megatest

Check-in [fb4ad2ea7e]
Login
Overview
Comment:threaded-db-calls working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | threaded-db-calls
Files: files | file ages | folders
SHA1: fb4ad2ea7ebdeb5b1fad1b026b779c4595822d28
User & Date: matt on 2013-04-27 00:16:26
Other Links: branch diff | manifest | tags
Context
2013-04-27
15:15
Merged in v1.54 changes Closed-Leaf check-in: c196e891d9 user: matt tags: threaded-db-calls
00:16
threaded-db-calls working check-in: fb4ad2ea7e user: matt tags: threaded-db-calls
2013-04-26
18:05
Partial implementation of threaded remote db calls check-in: 76a411e422 user: mrwellan tags: threaded-db-calls
Changes

Modified megatest.scm from [5c2d1bb47e] to [5723136706].

29
30
31
32
33
34
35
36
37
38
39
40


41
42
43
44
45
46
47
(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 "megatest-fossil-hash.scm")

(use trace dot-locking)
(trace
 cdb:tests-register-test
 cdb:client-call
)


;;  cdb:remote-run
;;  cdb:test-set-status-state
;;  change-directory
;;  db:process-queue-item
;;  db:test-get-logfile-info
;;  db:teststep-set-status!
;;  nice-path







|
|
|
|
<
>
>







29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
(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 "megatest-fossil-hash.scm")

;; (use trace dot-locking)
;; (trace
;;  cdb:tests-register-test
;;  cdb:client-call

;;  db:queue-write-and-wait
;; )
;;  cdb:remote-run
;;  cdb:test-set-status-state
;;  change-directory
;;  db:process-queue-item
;;  db:test-get-logfile-info
;;  db:teststep-set-status!
;;  nice-path

Modified runs.scm from [3512dace32] to [b02ed68626].

443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
		 ;; delay a short while and continue
		 ((eq? (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f) 'start)
		  (thread-sleep! 0.01)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		  (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
		  ;; NEED TO THREADIFY THIS
		  ;; (let ((th (make-thread (lambda ()
		  ;;       		   (print "Got here! AA")
		  ;;       		   (mutex-lock! registery-mutex)
		  ;;       		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'start)
		  ;;       		   (mutex-unlock! registery-mutex)
		         		   (cdb:tests-register-test #f run-id test-name item-path)
		  ;;       		   (print "Got here! AB")
		  ;;       		   (mutex-lock! registery-mutex)
		         		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'done)
		  ;;       		   (mutex-unlock! registery-mutex))
		  ;;       		 (conc test-name "/" item-path))))
		  ;;   (thread-start! th))
		  ;; (thread-sleep! *global-delta*)
(runs:shrink-can-run-more-tests-delay)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not have-resources) ;; simply try again after waiting a second
		  (debug:print-info 1 "no resources to run new tests, waiting ...")
		  ;; (thread-sleep! (+ 2 *global-delta*))
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
		  (loop (car newtal)(cdr newtal) reruns))







|
<
|
|
|
|
<
|
|
|
|
|
|







443
444
445
446
447
448
449
450

451
452
453
454

455
456
457
458
459
460
461
462
463
464
465
466
467
		 ;; delay a short while and continue
		 ((eq? (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f) 'start)
		  (thread-sleep! 0.01)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		  (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
		  ;; NEED TO THREADIFY THIS
		  (let ((th (make-thread (lambda ()

		        		   (mutex-lock! registery-mutex)
		        		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'start)
		        		   (mutex-unlock! registery-mutex)
		      		   (cdb:tests-register-test *runremote* run-id test-name item-path)

		        		   (mutex-lock! registery-mutex)
		      		   (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'done)
		        		   (mutex-unlock! registery-mutex))
		        		 (conc test-name "/" item-path))))
		    (thread-start! th))
		  (thread-sleep! *global-delta*)
(runs:shrink-can-run-more-tests-delay)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not have-resources) ;; simply try again after waiting a second
		  (debug:print-info 1 "no resources to run new tests, waiting ...")
		  ;; (thread-sleep! (+ 2 *global-delta*))
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
		  (loop (car newtal)(cdr newtal) reruns))
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (cdb:tests-register-test #f run-id test-name item-path)
		  (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (cdb:get-test-info-by-id *runremote* test-id))))
      (set! test-id (db:test-get-id testdat))
      (change-directory test-path)
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED







|







679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (cdb:tests-register-test *runremote* run-id test-name item-path)
		  (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (cdb:get-test-info-by-id *runremote* test-id))))
      (set! test-id (db:test-get-id testdat))
      (change-directory test-path)
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED

Added tests/fdktestqa/testqa/runsuite.sh version [07bf5497d9].



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
#!/bin/bash

for i in a b c d e f;do
  # g h i j k l m n o p q r s t u v w x y z;do
  megatest -runtests % -target a/b :runname $i &
done

echo "" > num-running.log
while true; do
  foo=`megatest -list-runs % | grep RUNNING | wc -l`
  echo "Num running: $foo"
  echo $foo >> num-running.log
done