Megatest

Check-in [d134500c45]
Login
Overview
Comment:Added -run-wait feature.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: d134500c452d6edad4906eccf11746d7d8115dc8
User & Date: mrwellan on 2013-06-05 20:50:02
Other Links: branch diff | manifest | tags
Context
2013-06-05
21:13
added usage of -run-wait to Makefile in tests check-in: cece09e9f5 user: mrwellan tags: dev
20:50
Added -run-wait feature. check-in: d134500c45 user: mrwellan tags: dev
18:20
Made remove-runs more conservative. It attempts to kill runs before removing check-in: 5647188f19 user: mrwellan tags: dev
Changes

Modified megatest.scm from [2314f8b16e] to [74393ec91f].

58
59
60
61
62
63
64

65
66
67
68
69
70
71
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
                            from prior runs with same keys
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname


Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
  -target key1/key2/...   : run for key1, key2, etc.
  -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfig
  -testpatt patt1/patt2,patt3/...  : % is wildcard
  :runname                : required, name for this particular test run
  :state                  : Applies to runs, tests or steps depending on context







>







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
                            from prior runs with same keys
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname
  -run-wait               : wait on run specified by target and runname

Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
  -target key1/key2/...   : run for key1, key2, etc.
  -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfig
  -testpatt patt1/patt2,patt3/...  : % is wildcard
  :runname                : required, name for this particular test run
  :state                  : Applies to runs, tests or steps depending on context
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -transport http|fs      : use http or direct access for transport (default is http) 
  -daemonize              : fork into background and disconnect from stdin/out
  -list-servers           : list the servers 
  -stop-server id         : stop server specified by id (see output of -list-servers)

  -repl                   : start a repl (useful for extending megatest)
  -load file.scm          : load and run file.scm

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile







|
>







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -transport http|fs      : use http or direct access for transport (default is http) 
  -daemonize              : fork into background and disconnect from stdin/out
  -list-servers           : list the servers 
  -stop-server id         : stop server specified by id (see output of -list-servers), use
                            0 to kill all
  -repl                   : start a repl (useful for extending megatest)
  -load file.scm          : load and run file.scm

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
209
210
211
212
213
214
215


216
217
218
219
220
221
222
223
			"-daemonize"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"


			;; mist queries
			"-list-disks"
			"-list-targets"
			"-list-db-targets"
			"-show-runconfig"
			"-show-config"
			"-show-cmdinfo"
			;; queries







>
>
|







211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
			"-daemonize"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)

			;; misc queries
			"-list-disks"
			"-list-targets"
			"-list-db-targets"
			"-show-runconfig"
			"-show-config"
			"-show-cmdinfo"
			;; queries
371
372
373
374
375
376
377
378

379
380
381
382
383
384
385
		 (if (equal? state "dead")
		     (if (> last-update (* 25 60 60)) ;; keep records around for slighly over a day.
			 (open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid action: 'delete))
		     (if (> last-update 20)        ;; Mark as dead if not updated in last 20 seconds
			 (open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid)))
		 (format #t fmtstr id mt-ver pid hostname interface pullport pubport last-update
			 (if status "alive" "dead") transport)
		 (if (equal? id sid)

		     (begin
		       (debug:print-info 0 "Attempting to stop server with pid " pid)
		       (tasks:kill-server status hostname pullport pid transport)))))
	     servers)
	    (debug:print-info 1 "Done with listservers")
	    (set! *didsomething* #t)
	    (exit)) ;; must do, would have to add checks to many/all calls below







|
>







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
		 (if (equal? state "dead")
		     (if (> last-update (* 25 60 60)) ;; keep records around for slighly over a day.
			 (open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid action: 'delete))
		     (if (> last-update 20)        ;; Mark as dead if not updated in last 20 seconds
			 (open-run-close tasks:server-deregister tasks:open-db hostname pullport: pullport pid: pid)))
		 (format #t fmtstr id mt-ver pid hostname interface pullport pubport last-update
			 (if status "alive" "dead") transport)
		 (if (or (equal? id sid)
			 (equal? sid 0)) ;; kill all/any
		     (begin
		       (debug:print-info 0 "Attempting to stop server with pid " pid)
		       (tasks:kill-server status hostname pullport pid transport)))))
	     servers)
	    (debug:print-info 1 "Done with listservers")
	    (set! *didsomething* #t)
	    (exit)) ;; must do, would have to add checks to many/all calls below
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      (open-run-close patch-db #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Update the tests meta data from the testconfig files
;;======================================================================

(if (args:get-arg "-update-meta")
    (begin
      (if (not (setup-for-run))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; now can find our db
      ;; keep this one local
      (open-run-close runs:update-all-test_meta db)
      (set! *didsomething* #t)))

;;======================================================================
;; Start a repl
;;======================================================================

(if (or (args:get-arg "-repl")
	(args:get-arg "-load"))
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db
	  (begin
	    (set! *db* db)
	    (set! *client-non-blocking-mode* #t)
	    ;; (client:setup)
	    ;; (client:launch)
	    (import readline)
	    (import apropos)
	    (gnu-history-install-file-manager
	     (string-append
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (if (args:get-arg "-repl")
		(repl)
		(load (args:get-arg "-load"))))
	  (exit))
      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))







|


|





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







1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034




1035
























1036
1037
1038
1039
1040
1041
1042
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      (open-run-close patch-db #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Wait on a run to complete
;;======================================================================

(if (args:get-arg "-run-wait")
    (begin
      (if (not (setup-for-run))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))




      (operate-on 'run-wait)
























      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))

Modified runs.scm from [ccf97b9702] to [bb443b061f].

562
563
564
565
566
567
568
569







570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591


592
593
594
595
596
597
598
	(begin
	  (debug:print 0 "ERROR: the parameter to -set-state-status is a comma delimited string. E.g. COMPLETED,FAIL")
	  (exit)))
    (for-each
     (lambda (run)
       (let ((runkey (string-intersperse (map (lambda (k)
						(db:get-value-by-header run header k)) keys) "/"))
	     (dirs-to-remove (make-hash-table)))







	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(tests     (if (not (equal? run-state "locked"))
			       (cdb:remote-run db:get-tests-for-run db run-id
						      testpatt states statuses
						      not-in:  #f
						      sort-by: (case action
								 ((remove-runs) 'rundir)
								 (else          'event_time)))
			       '()))
		(lasttpath "/does/not/exist/I/hope"))
	   (debug:print-info 4 "runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
		   ((remove-runs)
		    (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)
		    (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((print-run)
		    (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
		    action)


		   (else
		    (debug:print-info 0 "action not recognised " action)))
		 (let ((sorted-tests     (sort tests (lambda (a b)(let ((dira (db:test-get-rundir a))
									(dirb (db:test-get-rundir b)))
								    (if (and (string? dira)(string? dirb))
									(> (string-length dira)(string-length dirb))
									#f)))))







|
>
>
>
>
>
>
>



|
<
<
<
<
<













>
>







562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580





581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
	(begin
	  (debug:print 0 "ERROR: the parameter to -set-state-status is a comma delimited string. E.g. COMPLETED,FAIL")
	  (exit)))
    (for-each
     (lambda (run)
       (let ((runkey (string-intersperse (map (lambda (k)
						(db:get-value-by-header run header k)) keys) "/"))
	     (dirs-to-remove (make-hash-table))
	     (proc-get-tests (lambda (run-id)
			       (cdb:remote-run db:get-tests-for-run db run-id
					       testpatt states statuses
					       not-in:  #f
					       sort-by: (case action
							  ((remove-runs) 'rundir)
							  (else          'event_time))))))
	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(tests     (if (not (equal? run-state "locked"))
			       (proc-get-tests run-id)





			       '()))
		(lasttpath "/does/not/exist/I/hope"))
	   (debug:print-info 4 "runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
		   ((remove-runs)
		    (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)
		    (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((print-run)
		    (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
		    action)
		   ((run-wait)
		    (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete"))
		   (else
		    (debug:print-info 0 "action not recognised " action)))
		 (let ((sorted-tests     (sort tests (lambda (a b)(let ((dira (db:test-get-rundir a))
									(dirb (db:test-get-rundir b)))
								    (if (and (string? dira)(string? dirb))
									(> (string-length dira)(string-length dirb))
									#f)))))
665
666
667
668
669
670
671
672







673
674
675
676
677
678
679
						(debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
						(debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
					    ))
				    (if (not (null? tal))
					(loop (car tal)(cdr tal))))))
			     ((set-state-status)
			      (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status))
			      (cdb:remote-run db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f)))))







		   )))
	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let ((remtests (cdb:remote-run db:get-tests-for-run db (db:get-value-by-header run header "id") #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining
		     (let* ((dparts  (string-split lasttpath "/"))
			    (runpath (conc "/" (string-intersperse 







|
>
>
>
>
>
>
>







669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
						(debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
						(debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
					    ))
				    (if (not (null? tal))
					(loop (car tal)(cdr tal))))))
			     ((set-state-status)
			      (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status))
			      (cdb:remote-run db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f))
			     ((run-wait)
			      (debug:print-info 2 "still waiting, " (length tests) " tests still running")
			      (thread-sleep! 10)
			      (let ((new-tests (proc-get-tests run-id)))
				(if (null? new-tests)
				    (debug:print-info 1 "Run completed according to zero tests matching provided criteria.")
				    (loop (car new-tests)(cdr new-tests))))))))
		   )))
	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let ((remtests (cdb:remote-run db:get-tests-for-run db (db:get-value-by-header run header "id") #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining
		     (let* ((dparts  (string-split lasttpath "/"))
			    (runpath (conc "/" (string-intersperse 

Modified tests/Makefile from [c4c1dcfb30] to [b619ac307f].

64
65
66
67
68
69
70
71
72


73
74
75
76
77
78
79
	cd fullrun;$(MEGATEST) -runtests runfirst -testpatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v
	cd fullrun;$(MEGATEST) -runtests runfirst -testpatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10
	cd fullrun;$(MEGATEST) -rollup :runname newrun -target ubuntu/nfs/none -debug 10

test7: 
	@echo Only a/c testname c should remain. If there is a run a/b/c then there is a cache issue.
	(cd simplerun;$(MEGATEST) -remove-runs -target %/% :runname % -testpatt %; \
         $(MEGATEST) -runtests % -target a/b :runname c; \
	 $(MEGATEST) -runtests % -target a/c :runname c; \


	 $(MEGATEST) -remove-runs -target a/b :runname c -testpatt % ; \
	 $(MEGATEST) -runtests % -target a/d :runname c;$(MEGATEST) -list-runs %|egrep ^Run:) > test7.log 2> test7.log 
	logpro test7.logpro test7.html < test7.log
	@echo 
	@echo Run \"firefox test7.html\" to see the results.

cleanprep : ../*.scm Makefile */*.config







|
|
>
>







64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
	cd fullrun;$(MEGATEST) -runtests runfirst -testpatt %/1 -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -v
	cd fullrun;$(MEGATEST) -runtests runfirst -testpatt %blahha% -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_itempatt -debug 10
	cd fullrun;$(MEGATEST) -rollup :runname newrun -target ubuntu/nfs/none -debug 10

test7: 
	@echo Only a/c testname c should remain. If there is a run a/b/c then there is a cache issue.
	(cd simplerun;$(MEGATEST) -remove-runs -target %/% :runname % -testpatt %; \
         $(MEGATEST) -runtests % -target a/b :runname c ; \
	 $(MEGATEST) -runtests % -target a/c :runname c ; \
	 $(MEGATEST) -run-wait   -target a/c :runname c :state RUNNING ; \
	 $(MEGATEST) -run-wait   -target a/b :runname c :state RUNNING ; \
	 $(MEGATEST) -remove-runs -target a/b :runname c -testpatt % ; \
	 $(MEGATEST) -runtests % -target a/d :runname c;$(MEGATEST) -list-runs %|egrep ^Run:) > test7.log 2> test7.log 
	logpro test7.logpro test7.html < test7.log
	@echo 
	@echo Run \"firefox test7.html\" to see the results.

cleanprep : ../*.scm Makefile */*.config