Megatest

Diff
Login

Differences From Artifact [cecad5eaf2]:

To Artifact [5e8fbfc66e]:


49
50
51
52
53
54
55

56
57
58
59
60
61
62
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63







+








(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
(declare (uses redo-logpro))
(declare (uses ftail))
(import ftail)

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

(include "common_records.scm")
(include "key_records.scm")
113
114
115
116
117
118
119

120
121
122
123
124
125
126
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128







+







                            Optionally use :state and :status, use -keep-records to remove only
                            the run data.
  -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)
  -rerun-clean            : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
                            and then run the specified testpatt with -preclean
  -rerun-all              : set all tests to NOT_STARTED,n/a and run with -preclean
  -redo-logpro            : do not rerun tests, but reapply logpro rules (ez-step flavor tests only; runs all tests unless -testpatt specified)
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname
  -set-run-status status  : sets status for run to status, requires -target and -runname
  -get-run-status         : gets status for run specified by target and runname
  -run-wait               : wait on run specified by target and runname
  -preclean               : remove the existing test directory before running the test
  -clean-cache            : remove the cached megatest.config and runconfigs.config files
289
290
291
292
293
294
295

296
297
298
299
300
301
302
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305







+







			"-itempatt"
			"-setlog"
			"-set-toplog"
			"-runstep"
			"-logpro"
			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-to"
			;; values and messages
			":category"
			":variable"
			":value"
400
401
402
403
404
405
406

407
408
409
410
411
412
413
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417







+







			"-get-run-status"

			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first

			"-runall"    ;; run all tests, respects -testpatt, defaults to %
			"-run"       ;; alias for -runall
                        "-redo-logpro"
			"-remove-runs"
                        "-keep-records" ;; use with -remove-runs to remove only the run data
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-create-megatest-area"
569
570
571
572
573
574
575
576

577
578
579
580
581
582
583
573
574
575
576
577
578
579

580
581
582
583
584
585
586
587







-
+







					    (printf "Sending signal/term to ~A\n" pid)
					    (process-signal pid signal/term))))))
		       (process:children #f))
		      (original-exit exit-code)))))

;; for some switches always print the command to stderr
;;
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status")
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-redo-logpro")
    (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))

;; some switches imply homehost. Exit here if not on homehost
;;
(let ((homehost-required  (list "-cleanup-db" "-server")))
  (if (apply args:any? homehost-required)
      (if (not (common:on-homehost?))
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066







+







	  (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)
            (BB> "before runs:operate-on")
	    (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)
			      status: (common:args-get-status)
			      new-state-status: (args:get-arg "-set-state-status")
1087
1088
1089
1090
1091
1092
1093








1094
1095
1096
1097
1098
1099
1100
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113







+
+
+
+
+
+
+
+








(if (args:get-arg "-set-state-status")
    (general-run-call 
     "-set-state-status"
     "set state and status"
     (lambda (target runname keys keyvals)
       (operate-on 'set-state-status))))

(when (args:get-arg "-redo-logpro")
    (BB> "redo-logpro request from command line detected")
    (general-run-call 
     "-redo-logpro"
     "rerun logpro in ezsteps"
     (lambda (target runname keys keyvals)
       (operate-on 'redo-logpro))))

(if (or (args:get-arg "-set-run-status")
	(args:get-arg "-get-run-status"))
    (general-run-call
     "-set-run-status"
     "set run status"
     (lambda (target runname keys keyvals)
1239
1240
1241
1242
1243
1244
1245


1246
1247
1248
1249
1250
1251
1252
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267







+
+







          (for-each (lambda(table-row)
                      (print (string-join (map ->string table-row) ",")))

                    
                            table-rows))))
  (set! *didsomething* #t)
  (set! *time-to-exit* #t))





;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
;; IDEA: megatest list -runname blah% ...
;;