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.02)
(define megatest-version 1.03)
(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]
|
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
+
+
+
+
|
(let* ((testpath (assoc/default 'testpath cmdinfo))
(work-area (assoc/default 'work-area cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(db-host (assoc/default 'db-host cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(runname (assoc/default 'runname cmdinfo))
(mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
(fullrunscript (conc testpath "/" runscript))
(db #f))
(print "Exectuing " test-name " on " (get-host-name))
(change-directory testpath)
(setenv "MT_TEST_RUN_DIR" testpath)
(setenv "MT_TEST_NAME" test-name)
(setenv "MT_ITEM_INFO" (conc itemdat))
(setenv "MT_RUNNAME" runname)
(setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))
(if (not (setup-for-run))
(begin
(print "Failed to setup, exiting")
(exit 1)))
;; now can find our db
(set! db (open-db))
|
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
|
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
|
-
+
|
(if logprofile
(let* ((htmllogfile (conc stepname ".html"))
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(print "INFO: running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(change-directory testpath)
(test-set-log! db run-id test-name itemdat logfile)))
(test-set-log! db run-id test-name itemdat htmllogfile)))
(test-set-status! db run-id test-name "end" exitstat itemdat (args:get-arg "-m"))
(sqlite3:finalize! db)
(exit exitstat)
;; open the db
;; mark the end of the test
)))
(sqlite3:finalize! db)
|