131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
-test-paths : get the test paths matching target, runname, item and test
patterns.
-list-disks : list the disks available for storing runs
-list-targets : list the targets in runconfigs.config
-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 MODE : dump in MODE format instead of sexpr, MODE=json,ini,sexp etc.
-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)
-fields fieldspec : fields to include in json dump; runs:id,runame+tests:testname+steps
-sort fieldname : in -list-runs sort tests by this field
|
|
|
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
-test-paths : get the test paths matching target, runname, item and test
patterns.
-list-disks : list the disks available for storing runs
-list-targets : list the targets in runconfigs.config
-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 MODE : dump in MODE format instead of sexpr, MODE=json,ini,sexp etc. (add -debug 0,9 to see which file contributes each line)
-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)
-fields fieldspec : fields to include in json dump; runs:id,runame+tests:testname+steps
-sort fieldname : in -list-runs sort tests by this field
|
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
|
(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))))
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
exn
(begin
(print "ERROR: Failed to switch to log output. " ((conition-property-accessor 'exn 'message) exn))
)
(let* ((tl (or (args:get-arg "-log")(launch:setup))) ;; run launch:setup if -server
(logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
(conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
(oup (open-logfile logf)))
(if (not (args:get-arg "-log"))
(hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(debug:print-info 0 *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup))))
|
|
>
>
>
|
|
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
|
(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))))
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
exn
(begin
(print "ERROR: Failed to switch to log output. " ((conition-property-accessor 'exn 'message) exn))
)
(let* ((tl (or (args:get-arg "-log")(launch:setup))) ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
(logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name
(conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log")))
(oup (open-logfile logf)))
(if (not (args:get-arg "-log"))
(hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(debug:print-info 0 *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup))))
|
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
|
(if (and rundir ;; have all needed variabless
(directory-exists? rundir)
(file-write-access? rundir))
(begin
(if (not (common:in-running-test?))
(configf:write-alist data cfgf))
;; force re-read of megatest.config - this resolves circular references between megatest.config
(launch:setup force: #t)
(launch:cache-config))) ;; we can safely cache megatest.config since we have a valid runconfig
data))))
(if (args:get-arg "-show-runconfig")
(let ((tl (launch:setup)))
(push-directory *toppath*)
(let ((data (full-runconfigs-read)))
|
|
|
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
|
(if (and rundir ;; have all needed variabless
(directory-exists? rundir)
(file-write-access? rundir))
(begin
(if (not (common:in-running-test?))
(configf:write-alist data cfgf))
;; force re-read of megatest.config - this resolves circular references between megatest.config
(launch:setup force-reread: #t)
(launch:cache-config))) ;; we can safely cache megatest.config since we have a valid runconfig
data))))
(if (args:get-arg "-show-runconfig")
(let ((tl (launch:setup)))
(push-directory *toppath*)
(let ((data (full-runconfigs-read)))
|
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
|
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")
(args:get-arg "-run")
(args:get-arg "-rerun-clean")
(args:get-arg "-rerun-all")
(args:get-arg "-runtests"))
(general-run-call
"-runall"
"run all tests"
(lambda (target runname keys keyvals)
(if (args:get-arg "-rerun-clean") ;; first set states/statuses correct
(let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states")
"KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED"))
(statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses")
"FAIL,INCOMPLETE,ABORT,CHECK")))
(hash-table-set! args:arg-hash "-preclean" #t)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: states
;; status: statuses
new-state-status: "NOT_STARTED,n/a")
(runs:clean-cache target runname *toppath*)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: statuses
new-state-status: "NOT_STARTED,n/a")))
;; RERUN ALL
(if (args:get-arg "-rerun-all") ;; first set states/statuses correct
(begin
(hash-table-set! args:arg-hash "-preclean" #t)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: #f
;; status: statuses
new-state-status: "NOT_STARTED,n/a")
(runs:clean-cache target runname *toppath*)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: #f
new-state-status: "NOT_STARTED,n/a")))
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash))))
;;======================================================================
;; run one test
;;======================================================================
;; 1. find the config file
;; 2. change to the test directory
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
|
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")
(args:get-arg "-run")
(args:get-arg "-rerun-clean")
(args:get-arg "-rerun-all")
(args:get-arg "-runtests"))
(let ((need-clean (or (args:get-arg "-rerun-clean")
(args:get-arg "-rerun-all"))))
(general-run-call
"-runall"
"run all tests"
(lambda (target runname keys keyvals)
(if (args:get-arg "-rerun-clean") ;; first set states/statuses correct
(let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states")
"KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED"))
(statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses")
"FAIL,INCOMPLETE,ABORT,CHECK")))
(hash-table-set! args:arg-hash "-preclean" #t)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: states
;; status: statuses
new-state-status: "NOT_STARTED,n/a")
(runs:clean-cache target runname *toppath*)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: statuses
new-state-status: "NOT_STARTED,n/a")))
;; RERUN ALL
(if (args:get-arg "-rerun-all") ;; first set states/statuses correct
(begin
(hash-table-set! args:arg-hash "-preclean" #t)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: #f
;; status: statuses
new-state-status: "NOT_STARTED,n/a")
(runs:clean-cache target runname *toppath*)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: #f
new-state-status: "NOT_STARTED,n/a")))
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash)))))
;;======================================================================
;; run one test
;;======================================================================
;; 1. find the config file
;; 2. change to the test directory
|