479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
|
479
480
481
482
483
484
485
486
487
488
489
490
491
492
|
-
-
-
-
-
-
-
-
-
-
-
-
|
(print "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (args:get-arg "-setlog")
(test-set-log! db run-id test-name itemdat (args:get-arg "-setlog")))
(if (args:get-arg "-set-toplog")
(test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-test-status")
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
((string->number status)(if (equal? (string->number status) 0) "PASS" "FAIL"))
(else status))))
(test-set-status! db run-id test-name state newstatus itemdat (args:get-arg "-m")))
(if (and state status)
(if (not (args:get-arg "-setlog"))
(begin
(print "ERROR: You must specify :state and :status with every call to -test-status\n" help)
(sqlite3:finalize! db)
(exit 6)))))
(if (args:get-arg "-runstep")
(if (null? remargs)
(begin
(print "ERROR: nothing specified to run!")
(sqlite3:finalize! db)
(exit 6))
(let* ((stepname (args:get-arg "-runstep"))
|
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
+
+
+
+
+
+
+
+
+
+
+
+
|
(teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m"))
(sqlite3:finalize! db)
(if (not (eq? exitstat 0))
(exit 254)) ;; (exit exitstat) doesn't work?!?
;; open the db
;; mark the end of the test
)))
(if (args:get-arg "-test-status")
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
((string->number status)(if (equal? (string->number status) 0) "PASS" "FAIL"))
(else status))))
(test-set-status! db run-id test-name state newstatus itemdat (args:get-arg "-m")))
(if (and state status)
(if (not (args:get-arg "-setlog"))
(begin
(print "ERROR: You must specify :state and :status with every call to -test-status\n" help)
(sqlite3:finalize! db)
(exit 6)))))
(sqlite3:finalize! db)
(set! *didsomething* #t))))
(if (args:get-arg "-showkeys")
(let ((db #f)
(keys #f))
(if (not (setup-for-run))
|