Megatest

Diff
Login

Differences From Artifact [7e6fcbd15f]:

To Artifact [4aeaf761b4]:


224
225
226
227
228
229
230
231


232
233
234
235
236
237
238
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238
239







-
+
+







  -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove
                            cmd: keep-html, restore, save, save-remove, get (use 
                            -dest to set destination), -include path1,path2... to get or save specific files
  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -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>

297
298
299
300
301
302
303

304
305
306
307
308
309
310
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312







+







			"-logpro"
			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-to"
			"-dest"
			;; values and messages
			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"
327
328
329
330
331
332
333


334
335
336



337
338
339
340
341
342
343
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350







+
+



+
+
+







			"-setvars"
			"-set-state-status"

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

			;; archive 
			"-archive"
			"-actions"
			"-precmd"
			"-include"
			"-exclude-rx"
			"-exclude-rx-from"
			
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
503
504
505
506
507
508
509
510

511
512







513
514
515
516
517
518
519
510
511
512
513
514
515
516

517
518

519
520
521
522
523
524
525
526
527
528
529
530
531
532







-
+

-
+
+
+
+
+
+
+







       (start-watchdog (null? no-watchdog-args-vals)))
  ;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals) 
  (if start-watchdog
      (thread-start! *watchdog*)))


;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath)
(define (open-logfile logpath-in)
  (condition-case
   (let* ((log-dir (or (pathname-directory logpath) ".")))
   (let* ((log-dir (or (pathname-directory logpath-in) "."))
	  (fname   (pathname-strip-directory logpath-in))
	  (logpath (if (> (string-length fname) 250)
		       (let ((newlogf (conc log-dir "/" (common:get-signature fname) ".log")))
			 (debug:print 0 *default-log-port* "WARNING: log file " logpath-in " path too long, converted to " newlogf)
			 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)
        (define *didsomething* #t)  
        (exit 1))))
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
1066
1067
1068
1069
1070
1071
1072
1073



1074
1075
1076
1077
1078
1079
1080
1052
1053
1054
1055
1056
1057
1058

1059
1060
1061
1062
1063
1064
1065
1066
1067
1068

1069
1070
1071
1072

1073
1074
1075



1076
1077
1078
1079


1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094



1095
1096
1097
1098
1099
1100
1101
1102
1103
1104







-
+

+
+
+
+
+
+
+
+
-
+
+


-
+
+

-
-
-
+
+
+

-
-
+
+
+












-
-
-
+
+
+








;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action #!key (mode #f)) ;; #f is "use default"
(define (operate-on action #!key (mode #f)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default"
  (let* ((runrec (runs:runrec-make-record))
	 (target (or target-in   (common:args-get-target))) ;; eventually get rid of the call to common:args-get-target
	 (runname (or runname-in
		      (args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
	 (testpatt (or (args:get-arg "-testpatt")
		       (and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
			    (common:get-full-test-name))
		       (and (eq? action 'kill-runs)
			    "%/%") ;; I'm just guessing that this is correct :(
	 (target (common:args-get-target)))
		       (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
		       ))) ;;
    (cond
     ((not target)
      (debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify -target or -reqtarg")
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
			 action ", you must specify -target or -reqtarg")
      (exit 1))
     ((not (or (args:get-arg ":runname")
	       (args:get-arg "-runname")))
      (debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the run name pattern with -runname patt")
     ((not runname)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
			 action ", you must specify the run name pattern with -runname patt")
      (exit 2))
     ((not (or (args:get-arg "-testpatt") (eq? action 'kill-runs)))
      (debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the test pattern with -testpatt")
     ((not testpatt)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
			 action ", you must specify the test pattern with -testpatt")
      (exit 3))
     (else
      (if (not (car *configinfo*))
	  (begin
	    (debug:print-error 0 *default-log-port* "Attempted " action "on test(s) but run area config file not found")
	    (exit 1))
	  ;; put test parameters into convenient variables
	  (begin
	    ;; check for correct version, exit with message if not correct
	    (common:exit-on-version-changed)
	    (runs:operate-on  action
			      target
			      (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
			      (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
			      state: (common:args-get-state)
			      runname
			      testpatt
			      state:  (common:args-get-state)
			      status: (common:args-get-status)
			      new-state-status: (args:get-arg "-set-state-status")
                              mode: mode)))
      (set! *didsomething* #t)))))

(if (args:get-arg "-kill-runs")
    (general-run-call 
1862
1863
1864
1865
1866
1867
1868







1869
1870
1871
1872
1873





1874
1875
1876
1877
1878
1879
1880
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899





1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911







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








;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
    ;; else do a general-run-call
    (begin
      ;; for the archive get we need to preserve the starting dir as part of the target path
      (if (and (args:get-arg "-dest")
	       (not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
	  (let ((newpath  (conc (current-directory) "/" (args:get-arg "-dest"))))
	    (debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
	    (hash-table-set! args:arg-hash "-dest" newpath)))
    (general-run-call 
     "-archive"
     "Archive"
     (lambda (target runname keys keyvals)
       (operate-on 'archive))))
      (general-run-call 
       "-archive"
       "Archive"
       (lambda (target runname keys keyvals)
	 (operate-on 'archive target-in: target runname-in: runname )))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call