1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
-
+
|
;; Copyright 2006-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(include "common.scm")
(define megatest-version 1.06)
(define megatest-version 1.07)
(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright Matt Welland 2006-2011
Usage: megatest [options]
|
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
-
-
-
-
+
+
+
+
|
(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 ((newstat (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
((string->number status)(if (equal? (string->number status) 0) "PASS" "FAIL"))
(else 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)))))
|