Megatest

Check-in [b0d737abcc]
Login
Overview
Comment:Completed -since support and reversed order of runs in the stats summary table
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: b0d737abcc16960826d66cfe8007bf4c5ccb492c
User & Date: mrwellan on 2015-05-28 09:02:51
Other Links: branch diff | manifest | tags
Context
2015-05-28
09:55
Remove dotlock from opening dbs check-in: 3ebddba754 user: mrwellan tags: v1.60
09:02
Completed -since support and reversed order of runs in the stats summary table check-in: b0d737abcc user: mrwellan tags: v1.60
06:57
Added basic template for getting changed runs. Fixed exit handling, exit promptly after cleanup check-in: 33295b94b3 user: matt tags: v1.60
Changes

Modified db.scm from [9ce696701e] to [2f7bc00249].

1692
1693
1694
1695
1696
1697
1698
















1699
1700
1701
1702
1703
1704
1705
		   (lambda (a . x)
		     (set! res (cons (apply vector a x) res)))
		   db
		   qrystr
		   )))
    (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

















;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
		   (lambda (a . x)
		     (set! res (cons (apply vector a x) res)))
		   db
		   qrystr
		   )))
    (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))
	      (if res
		  (string->number (cadr res))
		  (begin
		    (debug:print 2 "WARNING: Failed to process " dbfile " for run-id")
		    0))))
	  changed))))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
	 (runs-info    '()))
    ;; First get all the runname/run-ids
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list run-id runname) runs-info)))
     db
     "SELECT id,runname FROM runs WHERE state != 'deleted';")
    ;; for each run get stats data
    (for-each
     (lambda (run-info)
       ;; get the net state/status counts for this run
       (let* ((run-id   (car  run-info))
	      (run-name (cadr run-info)))
	 (db:with-db







|







1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
	 (runs-info    '()))
    ;; First get all the runname/run-ids
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list run-id runname) runs-info)))
     db
     "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats
    ;; for each run get stats data
    (for-each
     (lambda (run-info)
       ;; get the net state/status counts for this run
       (let* ((run-id   (car  run-info))
	      (run-name (cadr run-info)))
	 (db:with-db

Modified megatest.scm from [3bcf86d151] to [9d3d552d20].

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
  -list-db-targets        : list the target combinations used in the db
  -show-config            : dump the internal representation of the megatest.config file
  -show-runconfig         : dump the internal representation of the runconfigs.config file
  -dumpmode json          : dump in json format instead of sexpr
  -show-cmdinfo           : dump the command info for a test (run in test environment)
  -section sectionName
  -var varName            : for config and runconfig lookup value for sectionName varName
  -changed-runs-since N   : get list of runs changed since time N (Unix seconds)

Misc 
  -start-dir path         : switch to this directory before running megatest
  -rebuild-db             : bring the database schema up to date
  -cleanup-db             : remove any orphan records, vacuum the db
  -import-megatest.db     : migrate a database from v1.55 series to v1.60 series
  -sync-to-megatest.db    : migrate data back to megatest.db







|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
  -list-db-targets        : list the target combinations used in the db
  -show-config            : dump the internal representation of the megatest.config file
  -show-runconfig         : dump the internal representation of the runconfigs.config file
  -dumpmode json          : dump in json format instead of sexpr
  -show-cmdinfo           : dump the command info for a test (run in test environment)
  -section sectionName
  -var varName            : for config and runconfig lookup value for sectionName varName
  -since N   : get list of runs changed since time N (Unix seconds)

Misc 
  -start-dir path         : switch to this directory before running megatest
  -rebuild-db             : bring the database schema up to date
  -cleanup-db             : remove any orphan records, vacuum the db
  -import-megatest.db     : migrate a database from v1.55 series to v1.60 series
  -sync-to-megatest.db    : migrate data back to megatest.db
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
			"-dumpmode"
			"-run-id"
			"-ping"
			"-refdb2dat"
			"-o"
			"-log"
			"-archive"
			"-changed-runs-since"
			) 
		 (list  "-h" "-help" "--help"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-show-keys"







|







242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
			"-dumpmode"
			"-run-id"
			"-ping"
			"-refdb2dat"
			"-o"
			"-log"
			"-archive"
			"-since"
			) 
		 (list  "-h" "-help" "--help"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-show-keys"
899
900
901
902
903
904
905
906
907













908
909
910
911
912
913
914
	       (testpatt (if (args:get-arg "-testpatt") 
			     (args:get-arg "-testpatt") 
			     "%"))
	       (keys     (db:get-keys dbstruct))
	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))













	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table))
	       (dmode    (let ((d (args:get-arg "-dumpmode")))
			   (if d (string->symbol d) #f)))
	       (data     (make-hash-table)))
	  ;; Each run
	  (for-each 







|

>
>
>
>
>
>
>
>
>
>
>
>
>







899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
	       (testpatt (if (args:get-arg "-testpatt") 
			     (args:get-arg "-testpatt") 
			     "%"))
	       (keys     (db:get-keys dbstruct))
	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat  (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
					 #f #f))
	       (runstmp  (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (runs     (if (and (not (null? runstmp))
				  (args:get-arg "-since"))
			     (let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
			       (let loop ((hed (car runstmp))
					  (tal (cdr runstmp))
					  (res '()))
				 (let ((new-res (if (member (db:get-value-by-header hed header "id") changed-ids)
						    (cons hed res)
						    res)))
				   (if (null? tal)
				       (reverse new-res)
				       (loop (car tal)(cdr tal) new-res)))))
			     runstmp))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table))
	       (dmode    (let ((d (args:get-arg "-dumpmode")))
			   (if d (string->symbol d) #f)))
	       (data     (make-hash-table)))
	  ;; Each run
	  (for-each 
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
			(print "Run: " targetstr "/" runname 
			       " status: " (db:get-value-by-header run header "state")
			       " run-id: " run-id ", number tests: " (length tests))))
		     (for-each 
		      (lambda (test)
		      	(handle-exceptions
			 exn
			 (debug:print 0 "ERROR: Bad data in test record? " test)
			 (let ((test-id    (db:test-get-id test))
			       (fullname   (conc (db:test-get-testname test)
						 (if (equal? (db:test-get-item-path test) "")
						     "" 
						     (conc "(" (db:test-get-item-path test) ")"))))
			       (tstate     (db:test-get-state test))
			       (tstatus    (db:test-get-status test))







|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
			(print "Run: " targetstr "/" runname 
			       " status: " (db:get-value-by-header run header "state")
			       " run-id: " run-id ", number tests: " (length tests))))
		     (for-each 
		      (lambda (test)
		      	(handle-exceptions
			 exn
			 (debug:print 4 "ERROR: Bad data in test record? " test)
			 (let ((test-id    (db:test-get-id test))
			       (fullname   (conc (db:test-get-testname test)
						 (if (equal? (db:test-get-item-path test) "")
						     "" 
						     (conc "(" (db:test-get-item-path test) ")"))))
			       (tstate     (db:test-get-state test))
			       (tstatus    (db:test-get-status test))
987
988
989
990
991
992
993


994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
						 (tdb:step-get-event_time step)))
				       steps)))))))))
		      tests)))))
	   runs)
	  (if (eq? dmode 'json)(json-write data))
	  (set! *didsomething* #t))))



(if (and (args:get-arg "-changed-runs-since")
	 (launch:setup-for-run))
    (let* ((since-time (string->number (args:get-arg "-changed-runs-since")))
	   (dbdir      (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	   (alldbs     (glob (conc dbdir "/[0-9]*.db")))
	   (changed    (filter (lambda (dbfile)
				 (> (file-modification-time dbfile) since-time))
			       alldbs))
	   (run-ids    (delete-duplicates
			(map (lambda (dbfile)
			       (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile)))
				 (if res
				     (string->number (cadr res))
				     (begin
				       (debug:print 2 "ERROR: Failed to process " dbfile " for run-id")
				       0))))
			     changed))))
      ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
      (print (sort run-ids <))
      (set! *didsomething* #t)))
      
      
;;======================================================================
;; full run
;;======================================================================

;; get lock in db for full run for this directory







>
>
|
|
|
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
|
|







1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011





1012








1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
						 (tdb:step-get-event_time step)))
				       steps)))))))))
		      tests)))))
	   runs)
	  (if (eq? dmode 'json)(json-write data))
	  (set! *didsomething* #t))))

;; Don't think I need this. Incorporated into -list-runs instead
;;
;; (if (and (args:get-arg "-since")
;; 	 (launch:setup-for-run))
;;     (let* ((since-time (string->number (args:get-arg "-since")))





;; 	   (run-ids    (db:get-changed-run-ids since-time)))








;;       ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
;;       (print (sort run-ids <))
;;       (set! *didsomething* #t)))
      
      
;;======================================================================
;; full run
;;======================================================================

;; get lock in db for full run for this directory