Index: .mtutil.scm
==================================================================
--- .mtutil.scm
+++ .mtutil.scm
@@ -1,5 +1,21 @@
+;; Copyright 2006-2017, Matthew Welland.
+;;
+;; This file is part of Megatest.
+;;
+;; Megatest is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Megatest is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Megatest. If not, see .
(use json)
(use ducttape-lib)
(define (get-last-runname area-path target)
Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
@@ -51,10 +53,14 @@
ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')
+
+ifeq ($(MTESTHASH),)
+$(error MTESTHASH is broken!)
+endif
CSIPATH=$(shell which csi)
CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))
# ARCHSTR=$(shell uname -m)_$(shell uname -r)
# BASH_MACHTYPE=$(shell bash -c "echo \$$MACHTYPE")
@@ -68,10 +74,12 @@
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut
mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o
csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest
+showmtesthash:
+ @echo $(MTESTHASH)
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard
ndboard : newdashboard.scm $(OFILES) $(GOFILES)
@@ -120,13 +128,14 @@
$(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html
mkdir -p $(PREFIX)/share/docs
$(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html
for png in $(PNGFILES);do $(INSTALL) docs/manual/$$png $(PREFIX)/share/docs/$$png;done
-js : java-script-lib/jquery-3.1.0.slim.min.js
+# add a fake dependency so this doens't copy everytime
+$(PREFIX)/share/js/jquery-3.1.0.slim.min.js : # .fslckout
mkdir -p $(PREFIX)/share/js
- cp java-script-lib/jquery-3.1.0.slim.min.js $(PREFIX)/share/js/jquery-3.1.0.slim.min.js
+ fossil wiki export java-script-lib > $(PREFIX)/share/js/jquery-3.1.0.slim.min.js
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
mkdir -p $(PREFIX)/share/db
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
@@ -269,11 +278,11 @@
$(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
$(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
$(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
$(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
$(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \
- js
+ $(PREFIX)/share/js/jquery-3.1.0.slim.min.js
# $(PREFIX)/bin/.$(ARCHSTR)/ndboard
# $(PREFIX)/bin/newdashboard
$(PREFIX)/bin/.$(ARCHSTR) :
@@ -349,19 +358,16 @@
(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)
datashare-testing/spublish : spublish.scm $(OFILES)
csc $(CSCOPTS) spublish.scm $(OFILES) -o datashare-testing/spublish
-datashare-testing/sretrieve : sretrieve.scm megatest-version.o margs.o configf.o process.o
- csc $(CSCOPTS) sretrieve.scm megatest-version.o margs.o configf.o process.o -o datashare-testing/sretrieve
-
-datashare-testing/sauthorize : sretrieve.scm megatest-version.o margs.o configf.o process.o common.o
- csc sauthorize.scm megatest-version.o margs.o configf.o process.o common.o -o datashare-testing/sauthorize
+datashare-testing/sretrieve : sretrieve.scm $(OFILES)
+ csc $(CSCOPTS) sretrieve.scm $(OFILES) -o datashare-testing/sretrieve
-datashare-testing/sauthorize : sretrieve.scm megatest-version.o margs.o configf.o process.o common.o
- csc sauthorize.scm megatest-version.o margs.o configf.o process.o common.o -o datashare-testing/sauthorize
+datashare-testing/sauthorize : sauthorize.scm $(OFILES)
+ csc $(CSCOPTS) sauthorize.scm $(OFILES) -o datashare-testing/sauthorize
sretrieve/sretrieve : datashare-testing/sretrieve
csc $(CSCOPTS) -deploy -deployed sretrieve.scm megatest-version.o margs.o configf.o process.o
chicken-install -keep-installed $(PROXY) -deploy -prefix sretrieve defstruct srfi-18 format sql-de-lite \
Index: Makefile.deploy
==================================================================
--- Makefile.deploy
+++ Makefile.deploy
@@ -1,7 +1,9 @@
# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
@@ -244,15 +246,18 @@
$(PREFIX)/bin/.$(ARCHSTR)/mtut : mtut
$(INSTALL) mtut $(PREFIX)/bin/.$(ARCHSTR)/mtut
install-mtut : mtut
- $(INSTALL) mtut $(PREFIX)/bin/mtut
+ echo $(INSTALL)
+ #$(INSTALL) mtut $(PREFIX)/bin/mtut
$(PREFIX)/bin/mtutil : $(PREFIX)/bin/.$(ARCHSTR)/mtut utils/mk_wrapper
utils/mk_wrapper $(PREFIX) mtut $(PREFIX)/bin/mtutil
chmod a+x $(PREFIX)/bin/mtutil
+
+mtutil: $(PREFIX)/bin/mtutil
$(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper
utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard
chmod a+x $(PREFIX)/bin/newdashboard
Index: NOTES
==================================================================
--- NOTES
+++ NOTES
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: README
==================================================================
--- README
+++ README
@@ -1,5 +1,22 @@
+# Copyright 2006-2017, Matthew Welland.
+#
+# This file is part of Megatest.
+#
+# Megatest is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# Megatest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Megatest. If not, see .
+
Megatest
To build:
1. Install chicken scheme. See opensrc repo utils/installall.sh http://www.kiatoa.com/fossils/opensrc
Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: archive.scm
==================================================================
--- archive.scm
+++ archive.scm
@@ -80,29 +80,49 @@
(or (common:get-disk-with-most-free-space candidate-disks dused)
(archive:allocate-new-archive-block #f #f #f)))) ;; BROKEN. testname itempath))))
;; allocate a new archive area
;;
-(define (archive:allocate-new-archive-block run-area-home testsuite-name dneeded)
- (let* ((adisks (archive:get-archive-disks))
- (best-disk (common:get-disk-with-most-free-space adisks dneeded)))
- (if best-disk
- (let* ((bdisk-name (car best-disk))
- (bdisk-path (cdr best-disk))
- (area-key (substring (message-digest-string (md5-primitive) run-area-home) 0 5))
- (bdisk-id (rmt:archive-register-disk bdisk-name bdisk-path (get-df bdisk-path)))
- (archive-name (let ((sec (current-seconds)))
- (conc (time->string (seconds->local-time sec) "%Y")
- "_q" (seconds->quarter sec) "/"
- testsuite-name "_" area-key)))
- (archive-path (conc bdisk-path "/" archive-name))
- (block-id (rmt:archive-register-block-name bdisk-id archive-path)))
- ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key)))
- (if block-id ;; (and block-id allocation-id)
- (cons block-id archive-path)
- #f))
- #f)))
+(define (archive:allocate-new-archive-block blockid-cache run-area-home testsuite-name dneeded target run-name test-name)
+ (let ((key (conc testsuite-name "/" target "/" run-name "/" test-name)))
+ (if (hash-table-exists? blockid-cache key)
+ (hash-table-ref blockid-cache key)
+ (let* ((pscript (configf:lookup *configdat* "archive" "pathscript"))
+ (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
+ (apath (if pscript
+ (handle-exceptions
+ exn
+ (begin
+ (debug:print 0 "ERROR: script \"" pscript-cmd "\" failed to run properly.")
+ (exit 1))
+ (with-input-from-pipe
+ pscript-cmd
+ read-line))
+ #f)) ;; this is the user-calculated archive path
+ (adisks (archive:get-archive-disks))
+ (best-disk (common:get-disk-with-most-free-space adisks dneeded)))
+ (if best-disk
+ (let* ((bdisk-name (car best-disk))
+ (bdisk-path (cdr best-disk))
+ (area-key (substring (message-digest-string (md5-primitive) run-area-home) 0 5))
+ (bdisk-id (rmt:archive-register-disk bdisk-name bdisk-path (get-df bdisk-path)))
+ (archive-name (if apath
+ apath
+ (let ((sec (current-seconds)))
+ (conc (time->string (seconds->local-time sec) "%Y")
+ "_q" (seconds->quarter sec) "/"
+ testsuite-name "_" area-key))))
+ (archive-path (conc bdisk-path "/" archive-name))
+ (block-id (rmt:archive-register-block-name bdisk-id archive-path)))
+ ;; (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key)))
+ (if block-id ;; (and block-id allocation-id)
+ (let ((res (cons block-id archive-path)))
+ (hash-table-set! blockid-cache key res)
+ res)
+ #f))
+ #f)) ;; no best disk found
+ )))
;; archive - run bup
;;
;; 1. create the bup dir if not exists
;; 2. start the du of each directory
@@ -111,28 +131,31 @@
;;
(define (archive:run-bup archive-command run-id run-name tests rp-mutex bup-mutex)
;; move the getting of archive space down into the below block so that a single run can
;; allocate as needed should a disk fill up
;;
- (let* ((min-space (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
- (archive-info (archive:allocate-new-archive-block *toppath* (common:get-testsuite-name) min-space))
- (archive-dir (if archive-info (cdr archive-info) #f))
- (archive-id (if archive-info (car archive-info) -1))
- (disk-groups (make-hash-table))
- (test-groups (make-hash-table)) ;; these two (disk and test groups) could be combined nicely
- (bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup"))
- (compress (or (configf:lookup *configdat* "archive" "compress") "9"))
- (linktree (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))
-
- (if (not archive-dir) ;; no archive disk found, this is fatal
- (begin
- (debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least " min-space " MB space to the [archive-disks] section of megatest.config")
- (debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space")
- (debug:print 0 *default-log-port* " disks: " (string-intersperse (map cadr (archive:get-archive-disks)) "\n "))
- (exit 1))
- (debug:print-info 0 *default-log-port* "Using path " archive-dir " for archiving"))
-
+ (let* ((blockid-cache (make-hash-table))
+ (tsname (common:get-testsuite-name))
+ (min-space (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
+ (arch-groups (make-hash-table)) ;; archive groups, each corrosponds to a bup area
+ (disk-groups (make-hash-table)) ;;
+ (test-groups (make-hash-table)) ;; these two (disk and test groups) could be combined nicely
+ (test-dirs (make-hash-table))
+ (bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup"))
+ (compress (or (configf:lookup *configdat* "archive" "compress") "9"))
+ (linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
+ (archiver (let ((s (configf:lookup *configdat* "archive" "archiver")))
+ (if s (string->symbol s) 'bup)))
+ (archiver-cmd (case archiver
+ ((tar) "tar cfj ARCHIVE_NAME.tar.bz2 ")
+ ((7z) " 7z u -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on ARCHIVE_NAME.7z ")
+ (else #f)))
+ (print-prefix "Running: ") ;; change to #f to turn off printing
+ (preclean-spec (configf:get-section *configdat* "archive-preclean")))
+
+ ;; (tests:match patt testname itempath)
+
;; from the test info bin the path to the test by stem
;;
(for-each
(lambda (test-dat)
(let* ((item-path (db:test-get-item-path test-dat))
@@ -155,68 +178,136 @@
(test-base (if (and partial-path-index
test-physical-path )
(substring test-physical-path
0
partial-path-index)
- #f)))
+ #f))
+ ;; we need our archive dir checked for every test to enable folks who want to store other ways.
+ (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target run-name test-name))
+ (archive-dir (if archive-info (cdr archive-info) #f))
+ (archive-id (if archive-info (car archive-info) -1))
+
+ )
- (cond
+ (if (not archive-dir) ;; no archive disk found, this is fatal
+ (begin
+ (debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least "
+ min-space " MB space to the [archive-disks] section of megatest.config")
+ (debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space")
+ (debug:print 0 *default-log-port* " disks: "
+ (string-intersperse (map cadr (archive:get-archive-disks)) "\n "))
+ (exit 1))
+ (debug:print-info 0 *default-log-port* "Using path " archive-dir " for archiving test " test-path))
+
+ ;; preclean the test directory per the spec if provided
+ (if (not (null? preclean-spec)) ;; we've been asked to preclean before archiving
+ (let loop ((spec (car preclean-spec))
+ (tail (cdr preclean-spec)))
+ (if (> (length spec) 1)
+ (let ((testspec (car spec))
+ (rules (cadr spec)))
+ (if (tests:match testspec test-name item-path)
+ (begin
+ (debug:print 0 *default-log-port* "INFO: cleanup requested for " test-physical-path)
+ (common:dir-clean-up test-physical-path rules remove-empty: #t))
+ (if (not (null? tail))
+ (loop (car tail)(cdr tail)))))
+ (begin
+ (debug:print 0 *default-log-port* "ERROR: bad spec line in [archive-preclean] section. \"" spec "\"")
+ (if (not (null? tail))(loop (car tail)(cdr tail)))))))
+ (cond
(toplevel/children
- (debug:print 0 *default-log-port* "WARNING: cannot archive " test-name " with id " test-id " as it is a toplevel test with children"))
+ (debug:print 0 *default-log-port* "WARNING: cannot archive " test-name " with id " test-id
+ " as it is a toplevel test with children"))
((not (common:file-exists? test-path))
- (debug:print 0 *default-log-port* "WARNING: Cannot archive " test-name "/" item-path " as path " test-path " does not exist"))
+ (debug:print 0 *default-log-port* "WARNING: Cannot archive " test-name "/" item-path
+ " as path " test-path " does not exist"))
(else
(debug:print 0 *default-log-port*
"From test-dat=" test-dat " derived the following:\n"
"test-partial-path = " test-partial-path "\n"
"test-path = " test-path "\n"
"test-physical-path = " test-physical-path "\n"
"partial-path-index = " partial-path-index "\n"
"test-base = " test-base)
- (hash-table-set! disk-groups test-base (cons test-physical-path (hash-table-ref/default disk-groups test-base '())))
- (hash-table-set! test-groups test-base (cons test-dat (hash-table-ref/default test-groups test-base '())))
- test-path))))
- tests)
- ;; for each disk-group
- (for-each
- (lambda (disk-group)
- (debug:print 0 *default-log-port* "Processing disk-group " disk-group)
- (let* ((test-paths (hash-table-ref disk-groups disk-group))
- ;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
- (bup-init-params (list "-d" archive-dir "init"))
- (bup-index-params (append (list "-d" archive-dir "index") test-paths))
- (bup-save-params (append (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
- (conc "-" compress) ;; or (conc "--compress=" compress)
- "-n" (conc (common:get-testsuite-name) "-" run-id)
- (conc "--strip-path=" disk-group))
- test-paths))
- (print-prefix #f)) ;; "Running: ")) ;; change to #f to turn off printing
- (if (not (common:file-exists? archive-dir))
- (create-directory archive-dir #t))
- (if (not (common:file-exists? (conc archive-dir "/HEAD")))
- (begin
- ;; replace this with jobrunner stuff enventually
- (debug:print-info 0 *default-log-port* "Init bup in " archive-dir)
- ;; (mutex-lock! bup-mutex)
- (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)
- ;; (mutex-unlock! bup-mutex)
- ))
- (debug:print-info 0 *default-log-port* "Indexing data to be archived")
- ;; (mutex-lock! bup-mutex)
- (run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
- (debug:print-info 0 *default-log-port* "Archiving data with bup")
- (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)
- ;; (mutex-unlock! bup-mutex)
- (for-each
- (lambda (test-dat)
- (let ((test-id (db:test-get-id test-dat))
- (run-id (db:test-get-run_id test-dat)))
- (rmt:test-set-archive-block-id run-id test-id archive-id)
- (if (member archive-command '("save-remove"))
- (runs:remove-test-directory test-dat 'archive-remove))))
- (hash-table-ref test-groups disk-group))))
- (hash-table-keys disk-groups))
+ (hash-table-set! disk-groups test-base
+ (cons test-physical-path (hash-table-ref/default disk-groups test-base '())))
+ (hash-table-set! test-groups test-base
+ (cons test-dat (hash-table-ref/default test-groups test-base '())))
+ (hash-table-set! arch-groups test-base
+ (cons archive-info (hash-table-ref/default arch-groups test-base '())))
+ (hash-table-set! test-dirs test-id test-path)))))
+ ;; test-path))))
+ tests)
+ (debug:print 0 *default-log-port* "INFO: DISK GROUPS=" (hash-table->alist disk-groups))
+ ;; for each disk-group, initialize the bup area if needed
+ (for-each
+ (lambda (test-base)
+ (let* ((disk-group (hash-table-ref disk-groups test-base))
+ (arch-group (hash-table-ref arch-groups test-base))
+ (arch-info (car arch-group)) ;; don't know yet how this will work, can I get more than one possibility?
+ (archive-id (car arch-info))
+ (archive-dir (cdr arch-info)))
+ (debug:print 0 *default-log-port* "Processing disk-group " test-base)
+ (let* ((test-paths (hash-table-ref disk-groups test-base)))
+ (if (not (common:file-exists? archive-dir))
+ (create-directory archive-dir #t))
+ (case archiver
+ ((bup) ;; Archive using bup
+ (let* ((bup-init-params (list "-d" archive-dir "init"))
+ (bup-index-params (append (list "-d" archive-dir "index") test-paths))
+ (bup-save-params (append (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
+ (conc "-" compress) ;; or (conc "--compress=" compress)
+ "-n" (conc (common:get-testsuite-name) "-" run-id)
+ (conc "--strip-path=" test-base) ;; if we push to the directory do we need this?
+ )
+ test-paths)))
+ (if (not (common:file-exists? (conc archive-dir "/HEAD")))
+ (begin
+ ;; replace this with jobrunner stuff enventually
+ (debug:print-info 0 *default-log-port* "Init bup in " archive-dir)
+ ;; (mutex-lock! bup-mutex)
+ (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)
+ ;; (mutex-unlock! bup-mutex)
+ ))
+ (debug:print-info 0 *default-log-port* "Indexing data to be archived")
+ ;; (mutex-lock! bup-mutex)
+ (run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
+ (debug:print-info 0 *default-log-port* "Archiving data with bup")
+ (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
+ ((7z tar)
+ (for-each
+ (lambda (test-dat)
+ (let* ((test-id (db:test-get-id test-dat))
+ (test-name (db:test-get-testname test-dat))
+ (item-path (db:test-get-item-path test-dat))
+ (test-full-name (db:test-make-full-name test-name item-path))
+ (run-id (db:test-get-run_id test-dat))
+ (target (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
+ (run-name (rmt:get-run-name-from-id run-id))
+ (source-dir (hash-table-ref test-dirs test-id)) ;; (conc test-base "/" test-name "/" item-path))
+ (target-dir (string-substitute "/$" "" (conc archive-dir "/" target "/" run-name "/" test-full-name))))
+ ;; create the test and item-path levels under archive-dir
+ (create-directory (pathname-directory target-dir) #t)
+ (run-n-wait
+ (conc
+ (string-substitute "ARCHIVE_NAME" target-dir archiver-cmd) " "
+ "."
+ )
+ print-cmd: print-prefix
+ run-dir: source-dir)))
+ (hash-table-ref test-groups test-base))))
+ ;; (mutex-unlock! bup-mutex)
+ (for-each
+ (lambda (test-dat)
+ (let ((test-id (db:test-get-id test-dat))
+ (run-id (db:test-get-run_id test-dat)))
+ (rmt:test-set-archive-block-id run-id test-id archive-id)
+ (if (member archive-command '("save-remove"))
+ (runs:remove-test-directory test-dat 'archive-remove))))
+ (hash-table-ref test-groups test-base)))))
+ (hash-table-keys disk-groups))
#t))
(define (archive:bup-restore archive-command run-id run-name tests rp-mutex bup-mutex) ;; move the getting of archive space down into the below block so that a single run can
;; allocate as needed should a disk fill up
;;
DELETED bin/sleeprunner
Index: bin/sleeprunner
==================================================================
--- bin/sleeprunner
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/bin/bash
-
-# This file is part of Megatest.
-#
-# Megatest is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# Megatest is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Megatest. If not, see .
-
-if [[ $SLEEPRUNNER == "" ]];then
-SLEEPRUNNER=0
-fi
-
-echo "nbfake $@ &> /dev/null" | at now + $SLEEPRUNNER minutes &> /dev/null
Index: codescanlib.scm
==================================================================
--- codescanlib.scm
+++ codescanlib.scm
@@ -1,5 +1,7 @@
+;; Copyright 2006-2017, Matthew Welland.
+;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -59,12 +59,12 @@
#f)
(thunk)))
(define getenv get-environment-variable)
(define (safe-setenv key val)
- (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
- (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"")
+ (if (or (substring-index "!" key) (substring-index ":" key)) ;; variables containing : are for internal use and cannot be environment variables.
+ (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
(if (and (string? val)
(string? key))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
@@ -1505,11 +1505,11 @@
(with-output-to-file fullpath (lambda ()(pp dat))))))
;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load remote-host)
- (let* ((actual-hostname (or remote-host (get-host-name))))
+ (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
(or (common:get-cached-info actual-hostname "cpu-load")
(let ((result (if remote-host
(map (lambda (res)
(if (eof-object? res) 9e99 res))
(with-input-from-pipe
@@ -1523,11 +1523,30 @@
;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads
;; returns alist '((adj-cpu-load . normalized-proc-load) ... etc.
;; keys: adj-proc-load, adj-core-load, 1m-load, 5m-load, 15m-load
;;
(define (common:get-normalized-cpu-load remote-host)
- (let ((actual-host (or remote-host (get-host-name)))) ;; #f is localhost
+ (let ((res (common:get-normalized-cpu-load-raw remote-host))
+ (default `((adj-proc-load . 2) ;; there is no right answer
+ (adj-core-load . 2)
+ (1m-load . 2)
+ (5m-load . 0) ;; causes a large delta - thus causing default of throttling if stuff goes wrong
+ (15m-load . 0)
+ (proc . 1)
+ (core . 1)
+ (phys . 1)
+ (error . #t))))
+ (cond
+ ((and (list? res)
+ (> (length res) 2))
+ res)
+ ((eq? res #f) default) ;; add messages?
+ ((eq? res #f) default) ;; this would be the #eof
+ (else default))))
+
+(define (common:get-normalized-cpu-load-raw remote-host)
+ (let* ((actual-host (or remote-host (get-host-name)))) ;; #f is localhost
(or (common:get-cached-info actual-host "normalized-load")
(let ((data (if remote-host
(with-input-from-pipe
(conc "ssh " remote-host " cat /proc/loadavg;cat /proc/cpuinfo;echo end")
read-lines)
@@ -1702,21 +1721,25 @@
(debug:print 0 *default-log-port* "INFO: Found host: " new-best " load: " load " last-used: " delta " seconds ago, with job-rate: " job-rate)
(host-last-used-set! rec curr-time)
new-best)
(if (null? tal) #f (loop (car tal)(cdr tal) best-host)))))))))
-(define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f))
+(define (common:wait-for-cpuload maxload-in numcpus-in waitdelay #!key (count 1000) (msg #f)(remote-host #f)(force-maxload #f))
(let* ((loadavg (common:get-cpu-load remote-host))
(numcpus (if (< 1 numcpus-in) ;; not possible
(common:get-num-cpus remote-host)
numcpus-in))
- (maxload (max maxload-in 0.5)) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
+ (maxload (if force-maxload
+ maxload-in
+ (max maxload-in 0.5))) ;; so maxload must be greater than 0.5 for now BUG - FIXME?
(first (car loadavg))
(next (cadr loadavg))
(adjload (* maxload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude fallback is to at least use 1
(loadjmp (- first next))
- (adjwait (+ (random 10)(/ (- 1000 count) 10) waitdelay))) ;; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously
+ (adjwait (min (+ 300 (random 10)) (* (+ (random 10)(/ (- 1000 count) 10) waitdelay) (- first adjload) ) ))) ;; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously
+ (debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload
+ ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp)
(cond
((and (> first adjload)
(> count 0))
(debug:print-info 0 *default-log-port* "server start delayed " adjwait " seconds due to load " first " exceeding max of " adjload " on server " (or remote-host (get-host-name)) " (normalized load-limit: " maxload ") " (if msg msg ""))
(thread-sleep! adjwait)
@@ -1888,10 +1911,86 @@
(set! bestsize freespc)))))
(map car disks))
(if (and best (> bestsize minsize))
best
#f))) ;; #f means no disk candidate found
+
+;; convert a spec string to a list of vectors #( rx action rx-string )
+(define (common:spec-string->list-of-specs spec-string actions)
+ (let ((spec-strings (string-split-fields "\\s*;\\s*" spec-string #:infix))
+ (actions-regex (regexp (conc "^(.*)\\s+(" (string-intersperse (map conc actions) "|") ")"))))
+ (filter
+ (lambda (x) x)
+ (map (lambda (s)
+ (let ((m (string-match actions-regex s)))
+ (if m
+ (vector (regexp (cadr m))(string->symbol (caddr m))(cadr m))
+ (begin
+ (debug:print 0 *default-log-port* "WARNING: Unrecognised rule \"" s "\" in clean-up specification.")
+ #f))))
+ spec-strings))))
+
+;; given a list of specs rx . rule and a file return the first matching rule
+;;
+(define (common:file-find-rule fname rules) ;; rule is vector #( rx action rx-string)
+ (let loop ((rule (car rules))
+ (tail (cdr rules)))
+ (let ((rx (vector-ref rule 0))
+ (rn (vector-ref rule 1))) ;; rule name
+ (if (string-match rx fname)
+ rule ;; return the whole rule so regex can be printed etc.
+ (if (null? tail)
+ #f
+ (loop (car tail)(cdr tail)))))))
+
+;; given a spec apply some rules to a directory
+;;
+;; WARNING: This function will REMOVE files - be sure your spec and path is correct!
+;;
+;; spec format:
+;; file-regex1 action; file-regex2 action; ...
+;; e.g.
+;; .*\.log$ keep; .* remove
+;; --> keep all .log files, remove everything else
+;; limitations:
+;; cannot have a rule with ; as part of the spec
+;; not very flexible, would be nice to return binned file names?
+;; supported rules:
+;; keep - keep this file
+;; remove - remove this file
+;; compress - compress this file
+;;
+(define (common:dir-clean-up path spec-string #!key (compress "gzip")(actions '(keep remove compress))(remove-empty #f))
+ (let* ((specs (common:spec-string->list-of-specs spec-string actions))
+ (keepers (make-hash-table))
+ (directories (make-hash-table)))
+ (find-files
+ path
+ action: (lambda (p res)
+ (let ((rule (common:file-find-rule p specs)))
+ (cond
+ ((directory? p)(hash-table-set! directories p #t))
+ (else
+ (case (vector-ref rule 1)
+ ((keep)(hash-table-set! keepers p rule))
+ ((remove)
+ (print "Removing file " p)
+ (delete-file p))
+ ((compress)
+ (print "Compressing file " p)
+ (system (conc compress " " p)))
+ (else
+ (print "No match for file " p))))))))
+ (if remove-empty
+ (for-each
+ (lambda (d)
+ (if (null? (glob (conc d "/.*")(conc d "/*")))
+ (begin
+ (print "Removing empty directory " d)
+ (delete-directory d))))
+ (sort (hash-table-keys directories) (lambda (a b)(> (string-length a)(string-length b))))))
+ ))
;;======================================================================
;; E N V I R O N M E N T V A R S
;;======================================================================
(define (bb-check-path #!key (msg "check-path: "))
@@ -2701,11 +2800,11 @@
toppath-in))
(pdbpath (or (configf:lookup mtconf "setup" "pdbpath") pktsdir)))
(cond
((not (and pktsdir toppath pdbpath))
(debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.")
- (debug:print 0 *default-log-port* " you need to have pktsdir in the [setup] section."))
+ (debug:print 0 *default-log-port* " you need to have pktsdirs in the [setup] section."))
((not (common:file-exists? pktsdir))
(debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir))
((not (equal? (file-owner pktsdir)(current-effective-user-id)))
(debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
(else
Index: commonstructs
==================================================================
--- commonstructs
+++ commonstructs
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -59,18 +59,21 @@
(config:assoc-safe-add
(hash-table-ref/default cfgdat section-name '())
var value metadata: metadata)))
(define (config:eval-string-in-environment str)
- (handle-exceptions
- exn
- (begin
- (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
- #f)
- (let ((cmdres (process:cmd-run->list (conc "echo " str))))
- (if (null? cmdres) ""
- (caar cmdres)))))
+ ;; (if (or (string-null? str)
+ ;; (equal? "!" (substring str 0 1))) ;; null string or starts with ! are preserved but NOT set in the environment
+ str
+ (handle-exceptions
+ exn
+ (begin
+ (debug:print-error 0 *default-log-port* "problem evaluating \"" str "\" in the shell environment")
+ #f)
+ (let ((cmdres (process:cmd-run->list (conc "echo " str))))
+ (if (null? cmdres) ""
+ (caar cmdres))))) ;; )
;;======================================================================
;; Make the regexp's needed globally available
;;======================================================================
@@ -323,31 +326,32 @@
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
curr-section-name #f #f)))
(configf:include-rx ( x include-file )
(let* ((curr-conf-dir (pathname-directory path))
- (full-conf (if (absolute-pathname? include-file)
+ (full-conf (if (and (absolute-pathname? include-file) (file-exists? include-file))
include-file
(common:nice-path
(conc (if curr-conf-dir
curr-conf-dir
".")
"/" include-file)))))
- (if (common:file-exists? full-conf)
- (begin
- ;; (push-directory conf-dir)
- (debug:print 9 *default-log-port* "Including: " full-conf)
- (read-config full-conf res allow-system environ-patt: environ-patt
- curr-section: curr-section-name sections: sections settings: settings
- keep-filenames: keep-filenames)
- ;; (pop-directory)
- (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
- (begin
- (debug:print '(2 9) #f "INFO: include file " include-file " not found (called from " path ")")
- (debug:print 2 *default-log-port* " " full-conf)
- (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
- curr-section-name #f #f)))))
+ (let ((all-matches (sort (handle-exceptions exn (list) (glob full-conf)) string<=?)))
+ (if (null? all-matches)
+ (begin
+ (debug:print '(2 9) #f "INFO: include file(s) matching " include-file " not found (called from " path ")")
+ (debug:print 2 *default-log-port* " " full-conf))
+ (for-each
+ (lambda (fpath)
+ ;; (push-directory conf-dir)
+ (debug:print 9 *default-log-port* "Including: " full-conf)
+ (read-config fpath res allow-system environ-patt: environ-patt
+ curr-section: curr-section-name sections: sections settings: settings
+ keep-filenames: keep-filenames))
+ all-matches))
+ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings)
+ curr-section-name #f #f))))
(configf:script-rx ( x include-script params);; handle-exceptions
;; exn
;; (begin
;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
@@ -437,11 +441,16 @@
settings)
curr-section-name key #f)))
(configf:key-val-pr ( x key unk1 val unk2 )
(let* ((alist (hash-table-ref/default res curr-section-name '()))
- (envar (and environ-patt (string-search (regexp environ-patt) curr-section-name)))
+ (envar (and environ-patt
+ (string-search (regexp environ-patt) curr-section-name) ;; does the section match the envionpatt?
+ (and (not (string-null? key))
+ (not (equal? "!" (substring key 0 1)))) ;; ! as leading character is a signature to NOT export to the environment
+ ;; (string-match "^.*:.*:.*$" key) ;; ;; something:something:something reserved for triggers in runconfigs
+ ))
(realval (if envar
(config:eval-string-in-environment val)
val)))
(debug:print-info 6 *default-log-port* "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar (safe-setenv key realval))
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -101,10 +101,23 @@
"-rh5.11" ;; fix to allow running on rh5.11
)
args:arg-hash
0))
+;; check for MT_* environment variables and exit if found
+(if (not (args:get-arg "-test"))
+ (begin
+ (display "Checking for MT_ vars: ")
+ (for-each (lambda (var)
+ (display " ")(display var)
+ (if (get-environment-variable var)
+ (begin
+ (print "ERROR: environment variable " var " is set in this terminal, this will cause you problems. Exiting now.")
+ (exit 1))))
+ '("MT_RUN_AREA_HOME" "MT_MEGATEST" "MT_CMDINFO" "MT_TEST_RUN_DIR" "MT_LINKTREE" "MT_TESTSUITENAME"))
+ (print ". Done. All ok.")))
+
(if (not (null? remargs))
(begin
(print "Unrecognised arguments: " (string-intersperse remargs " "))
(exit)))
@@ -118,11 +131,11 @@
(let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
(setenv "PWD" fullpath)
(change-directory fullpath))
(begin
(debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
- (exit 1))))
+ (exit 1))))
;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
(begin
@@ -824,12 +837,13 @@
(begin
(when (> elapsed-time 2)
(debug:print 0 *default-log-port* "NOTE: updates are taking a long time, " elapsed-time "s elapsed.")
(let* ((old-val (iup:attribute *tim* "TIME"))
(new-val (number->string (inexact->exact (floor (* 2 (string->number old-val)))))))
- (debug:print 0 *default-log-port* "NOTE: increasing poll interval from "old-val" to "new-val)
- (iup:attribute-set! *tim* "TIME" new-val))
+ (if (< (string->number new-val) 5000)
+ ((debug:print 0 *default-log-port* "NOTE: increasing poll interval from "old-val" to "new-val)
+ (iup:attribute-set! *tim* "TIME" new-val))))
)
(dboard:tabdat-allruns-set! tabdat new-res)
maxtests)
@@ -847,11 +861,11 @@
(parts (string-split fulltestname "("))
(basetestname (if (null? parts) "" (car parts))))
;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
(if (hash-table-ref/default *collapsed* basetestname #f)
(begin
- ;(iup:attribute-set! btn "FGCOLOR" "0 0 0")
+ ;(iup:attribute-set! btn "FGCOLOR" "0 0 0")s
(hash-table-delete! *collapsed* basetestname))
(begin
;(iup:attribute-set! btn "FGCOLOR" "0 192 192")
(hash-table-set! *collapsed* basetestname #t)))))
@@ -3426,11 +3440,11 @@
(common:exit-on-version-changed)))
(let* ((commondat (dboard:commondat-make)))
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
(cond
((args:get-arg "-test") ;; run-id,test-id
- (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
+ (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
(if (> (length d) 1)
d
(list #f #f))))
(run-id (car dat))
(test-id (cadr dat)))
@@ -3453,21 +3467,21 @@
tab-num: 1)
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (time-obj)
(let ((update-is-running #f))
- (mutex-lock! (dboard:commondat-update-mutex commondat))
- (set! update-is-running (dboard:commondat-updating commondat))
- (if (not update-is-running)
- (dboard:commondat-updating-set! commondat #t))
- (mutex-unlock! (dboard:commondat-update-mutex commondat))
- (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
- (begin
- (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
- (mutex-lock! (dboard:commondat-update-mutex commondat))
- (dboard:commondat-updating-set! commondat #f)
- (mutex-unlock! (dboard:commondat-update-mutex commondat)))
+ (mutex-lock! (dboard:commondat-update-mutex commondat))
+ (set! update-is-running (dboard:commondat-updating commondat))
+ (if (not update-is-running)
+ (dboard:commondat-updating-set! commondat #t))
+ (mutex-unlock! (dboard:commondat-update-mutex commondat))
+ (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
+ (begin
+ (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
+ (mutex-lock! (dboard:commondat-update-mutex commondat))
+ (dboard:commondat-updating-set! commondat #f)
+ (mutex-unlock! (dboard:commondat-update-mutex commondat)))
))
1))))
(let ((th1 (make-thread (lambda ()
(thread-sleep! 1)
Index: datashare-testing/.sd.config
==================================================================
--- datashare-testing/.sd.config
+++ datashare-testing/.sd.config
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: datashare-testing/.spublish.config
==================================================================
--- datashare-testing/.spublish.config
+++ datashare-testing/.spublish.config
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: datashare-testing/.sretrieve.config
==================================================================
--- datashare-testing/.sretrieve.config
+++ datashare-testing/.sretrieve.config
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: datashare-testing/NOTES
==================================================================
--- datashare-testing/NOTES
+++ datashare-testing/NOTES
@@ -1,3 +1,20 @@
+# Copyright 2006-2017, Matthew Welland.
+#
+# This file is part of Megatest.
+#
+# Megatest is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# Megatest is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Megatest. If not, see .
+
To test sretrieve first publish megatest as v1.60 at least twice to get
iterations 0 and 1
Index: datashare-testing/megatest.config
==================================================================
--- datashare-testing/megatest.config
+++ datashare-testing/megatest.config
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: datashare-testing/packages.config
==================================================================
--- datashare-testing/packages.config
+++ datashare-testing/packages.config
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -318,21 +318,26 @@
(let* ((dbpath (db:dbfile-path )) ;; path to tmp db area
(dbexists (common:file-exists? dbpath))
(tmpdbfname (conc dbpath "/megatest.db"))
(dbfexists (common:file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db")))
(mtdbexists (common:file-exists? (conc *toppath* "/megatest.db")))
-
+
+ (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db")) #f))
+ (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
(mtdb (db:open-megatest-db))
(mtdbpath (db:dbdat-get-path mtdb))
(tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
(refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
(write-access (file-write-access? mtdbpath))
- (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f))
- (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
+ ;(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) ; moving this before db:open-megatest-db is called. if wal mode is on -WAL and -shm file get created with causing the tmpdbmodtime timestamp always greater than mtdbmodtime
+ ;(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
+ ;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced
+ ;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f))
+ ;(fmt (file-modification-time tmpdbfname))
(modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime))))
-
- ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
+ ;(print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db"))
+ ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access)
(if (and dbexists (not write-access))
(begin
(set! *db-write-access* #f)
(dbr:dbstruct-read-only-set! dbstruct #t)))
(dbr:dbstruct-mtdb-set! dbstruct mtdb)
@@ -346,16 +351,32 @@
(> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
do-sync)
(begin
(debug:print 1 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta)
(db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb)
+ ;touch tmp db to avoid wal mode wierdness
+ (set! (file-modification-time tmpdbfname) (current-seconds))
(debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
)
(debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) )
;; (db:multi-db-sync dbstruct 'old2new)) ;; migrate data from megatest.db automatically
tmpdb))))
+
+(define (db:get-last-update-time db)
+; (db:with-db
+; dbstruct #f #f
+; (lambda (db)
+ (let ((last-update-time #f))
+ (sqlite3:for-each-row
+ (lambda (lup)
+ (set! last-update-time lup))
+ db
+ "select max(lup) from ( select max(last_update) as lup from tests union select max(last_update) as lup from runs);")
+ last-update-time))
+;))
+
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (db:setup do-sync #!key (areapath #f))
@@ -489,22 +510,20 @@
'("run_duration" #f)
'("comment" #f)
'("event_time" #f)
'("fail_count" #f)
'("pass_count" #f)
- '("archived" #f)
- '("last_update" #f))
+ '("archived" #f))
(list "test_steps"
'("id" #f)
'("test_id" #f)
'("stepname" #f)
'("state" #f)
'("status" #f)
'("event_time" #f)
'("comment" #f)
- '("logfile" #f)
- '("last_update" #f))
+ '("logfile" #f))
(list "test_data"
'("id" #f)
'("test_id" #f)
'("category" #f)
'("variable" #f)
@@ -512,12 +531,11 @@
'("expected" #f)
'("tol" #f)
'("units" #f)
'("comment" #f)
'("status" #f)
- '("type" #f)
- '("last_update" #f))))
+ '("type" #f))))
;; needs db to get keys, this is for syncing all tables
;;
(define (db:sync-main-list dbstruct)
(let ((keys (db:get-keys dbstruct)))
@@ -529,11 +547,11 @@
(list "metadat" '("var" #f) '("val" #f))
(append (list "runs"
'("id" #f))
(map (lambda (k)(list k #f))
(append keys
- (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour" "last_update"))))
+ (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour" ))))
(list "test_meta"
'("id" #f)
'("testname" #f)
'("owner" #f)
'("description" #f)
@@ -1706,32 +1724,37 @@
;; a. If have tests that are not deleted, set state='unknown'
;; b. ....
;;
(define (db:clean-up dbdat)
;; (debug:print 0 *default-log-port* "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db")
- (let* ((db (db:dbdat-get-db dbdat))
+ (let* ((keep-record-age ( - (current-seconds) (common:hms-string->seconds (or (configf:lookup *configdat* "setup" "delete-record-age") "30d"))))
+ (db (db:dbdat-get-db dbdat))
(count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
(statements
(map (lambda (stmt)
(sqlite3:prepare db stmt))
(list
;; delete all tests that belong to runs that are 'deleted'
- "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted');"
+ (conc "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted') and last_update < " keep-record-age ";")
;; delete all tests that are 'DELETED'
- "DELETE FROM tests WHERE state='DELETED';"
+ (conc "DELETE FROM tests WHERE state='DELETED' and last_update < " keep-record-age " ;")
;; delete all tests that have no run
- "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs);"
+ (conc "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs) and last_update < " keep-record-age "; ")
;; delete all runs that are state='deleted'
- "DELETE FROM runs WHERE state='deleted';"
+ (conc "DELETE FROM runs WHERE state='deleted' and last_update < " keep-record-age ";")
;; delete empty runs
- "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id);"
+ (conc "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id) and last_update < " keep-record-age ";")
;; remove orphaned test_rundat entries
- "DELETE FROM test_rundat where test_id NOT IN (SELECT id FROM tests);"
- ;;
- "DELETE FROM test_steps WHERE test_id NOT IN (SELECT id FROM tests);"
+ (conc "DELETE FROM test_rundat where test_id NOT IN (SELECT id FROM tests);")
+ ;; remove orphaned test_steps entries
+ (conc "DELETE FROM test_steps WHERE test_id NOT IN (SELECT id FROM tests);")
+ ;; remove orphaned test_dat entries
+ (conc "DELETE FROM test_data WHERE test_id NOT IN (SELECT id FROM tests);")
+
))))
;; (db:delay-if-busy dbdat)
+ ;(debug:print-info 0 *default-log-port* statements)
(sqlite3:with-transaction
db
(lambda ()
(sqlite3:for-each-row (lambda (tot)
(debug:print-info 0 *default-log-port* "Records count before clean: " tot))
@@ -2263,30 +2286,32 @@
(lambda (db)
(let ((numruns 0)
(qry-str #f)
(key-patt "")
(keyvals (if targetpatt (keys:target->keyval keys targetpatt) '())))
+
(for-each (lambda (keyval)
(let* ((key (car keyval))
(patt (cadr keyval))
(fulkey (conc ":" key))
(wildtype (if (substring-index "%" patt) "like" "glob")))
+
(if patt
(set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
(begin
(debug:print-error 0 *default-log-port* "searching for runs with no pattern set for " fulkey)
(exit 6)))))
keyvals)
- ; (print runpatt " -- " key-patt)
- (set! qry-str (conc "SELECT COUNT(id) FROM runs WHERE state != 'deleted' AND runname like " runpatt key-patt))
- ; (print qry-str )
- (debug:print-info 11 *default-log-port* "db:get-num-runs START " runpatt)
-; (sqlite3:for-each-row
-; (lambda (count)
-; (set! numruns count))
-; db
-; qry-str)
+ ;(print runpatt " -- " key-patt)
+ (set! qry-str (conc "SELECT COUNT(id) FROM runs WHERE state != 'deleted' AND runname like '" runpatt "'" key-patt))
+ ;(print qry-str )
+
+ (sqlite3:for-each-row
+ (lambda (count)
+ (set! numruns count))
+ db
+ qry-str)
(debug:print-info 11 *default-log-port* "db:get-num-runs END " runpatt)
numruns))))
;; (sqlite3#fold-row proc3670 init3671 db-or-stmt3672 . params3673)>
@@ -2439,11 +2464,11 @@
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; to extract info from the structure returned
;;
-(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit fields last-update) ;; test-name)
+(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit fields last-update sort-order ) ;; test-name)
(let* ((tmp (runs:get-std-run-fields keys (or fields '("id" "runname" "state" "status" "owner" "event_time"))))
(keystr (car tmp))
(header (cadr tmp))
(key-patt "")
(runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
@@ -2462,15 +2487,17 @@
keyvals)
(set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt
(if last-update
(conc " AND last_update >= " last-update " ")
" ")
- " ORDER BY event_time "
+ " ORDER BY event_time " sort-order " "
(if limit (conc " LIMIT " limit) "")
(if offset (conc " OFFSET " offset) "")
";"))
(debug:print-info 4 *default-log-port* "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
+ ;(print "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
+
(vector header
(reverse
(db:with-db dbstruct #f #f ;; reads db, does not write to it.
(lambda (db)
(sqlite3:fold-row
@@ -4170,11 +4197,11 @@
(delete-duplicates
(cons testname (hash-table-ref/default res tag '())))))
tags)))
db
"SELECT testname,tags FROM test_meta")
- res))))
+ (hash-table->alist res)))))
;; read the record given a testname
(define (db:testmeta-get-record dbstruct testname)
(let ((res #f))
(db:with-db
Index: db_records.scm
==================================================================
--- db_records.scm
+++ db_records.scm
@@ -1,5 +1,7 @@
+;; Copyright 2006-2017, Matthew Welland.
+;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
Index: diff-report.scm
==================================================================
--- diff-report.scm
+++ diff-report.scm
@@ -1,5 +1,7 @@
+;; Copyright 2006-2017, Matthew Welland.
+;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
Index: docs/Makefile
==================================================================
--- docs/Makefile
+++ docs/Makefile
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/api.txt
==================================================================
--- docs/api.txt
+++ docs/api.txt
@@ -16,10 +16,12 @@
The Megatest Web App aims to make as much of the power of the dashboard available to the web based user.
:numbered:
+// Copyright 2006-2017, Matthew Welland.
+//
// This file is part of Megatest.
//
// Megatest is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
Index: docs/architecture-brainstorming.fig
==================================================================
--- docs/architecture-brainstorming.fig
+++ docs/architecture-brainstorming.fig
@@ -4,10 +4,12 @@
Inches
Letter
100.00
Single
-2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
DELETED docs/html/dashboard-test.png
Index: docs/html/dashboard-test.png
==================================================================
--- docs/html/dashboard-test.png
+++ /dev/null
cannot compute difference between binary files
DELETED docs/html/dashboard.png
Index: docs/html/dashboard.png
==================================================================
--- docs/html/dashboard.png
+++ /dev/null
cannot compute difference between binary files
DELETED docs/html/megatest.html
Index: docs/html/megatest.html
==================================================================
--- docs/html/megatest.html
+++ /dev/null
@@ -1,1717 +0,0 @@
-
-
-
-
-Megatest is free software released under the General Public License v2.0. Please see the file COPYING in the source distribution for details.
-
-
-
Email: matt@kiatoa.com.
-
-
-Web: www.kiatoa.com/fossils/megatest
-
-
-
This document is believed to be acurate at the time of writing but as with any opensource project the source code itself is the reference. It is the responsibility of the end user to validate that the code will perform as they expect. The author assumes no responsibility for any inaccuracies that this document may contain. In no event will Matthew Welland be liable for direct, indirect, special, exemplary, incidental, or consequential damages resulting from any defect or omission in this document, even if advised of the possibility of such damages.
-
-
-This document is a snapshot in time and Megatest software has likely changed since publication. This document and Megatest may be improved at any time, without notice or obligation.
-
-
-
-
-
-
-
-Megatest/document Revision History
-
-
-Notable revisions of the software are occasionally documented here.
-
-Megatest is intended to provide the minimum needed resources to make writing a suite of tests and implementing continuous build for software, design engineering or process control (via owlfs for example) without being specialized for any specific problem space. Megatest in of itself does not know what constitutes a PASS or FAIL of a test. In most cases megatest is best used in conjunction with logpro or a similar tool to parse, analyze and decide on the test outcome.
-
-All data to specify the tests and configure the system is stored in plain text files. All system state is stored in an sqlite3 database. Tests are launched using the launching system available for the distributed compute platform in use. A template script is provided which can launch jobs on local and remote Linux hosts. Currently megatest uses the network filesystem to “call home” to your master sqlite3 database.
-
-Chicken scheme and a number of “eggs” are required for building megatest. See the file utils/installall.sh for an automated way to install the dependencies on Linux.
-
-Create the file megatest.config using the megatest.config template from the tests directory. At a minimum you need the following:
-
-
-
-
# Fields are the keys under which your test runs are organized
-[fields]
-field1 TEXT
-field2 TEXT
-
-[jobtools]
-# The launcher launches jobs to the local or remote hosts,
-# the job is managed on the target host by megatest,
-# comment out launcher to run local only. An example launcher
-# "nbfake" can be found in the utils directory.
-launcher nbfake
-
-# The disks section specifies where the tests will be run. As you
-# run out of space in a partition you can add additional disks
-# entries.
-# Format is:
-# name /path/to/area
-[disks]
-disk1 /tmp
-
-Note: Using csh is NOT recommended. Use bash, perl, ruby, zsh or anything other than csh. We use csh here because it is popular in the EDA industry for which Megatest was originally created.
-
-
-
-
-
#!/bin/tcsh -x
-
-# run the cpu1 simulation.
-# The step name is "run_simulation"
-# The commandline being run for this step is "runsim cpu1"
-# The logpro file to validate the output from the run is "runsim.logpro"
-
-$MT_MEGATEST -runstep run_simulation -logpro runsim.logpro "runsim cpu1"
-$MT_MEGATEST -test-status :state COMPLETED :status $?
-
-
-
-
-
-
-
-You can now run megatest and the created test directory will contain the new files “run_simulation.html” and “run_simulation.log”. If you are using the dashboard you can click on the run and then push the “View log” button to view the log file in firefox.
-
-To run multiple steps simply add them to the main.csh file. Here we add a step to test “cpu2”. The second step that tests cpu2 will only run after the step that tested “cpu1” completes.
-
-
-
-
#!/bin/tcsh -x
-
-# run the cpu1 simulation.
-# The step name is "run_simulation"
-# The commandline being run for this step is "runsim cpu1"
-# The logpro file to validate the output from the run is "runsim.logpro"
-
-$MT_MEGATEST -runstep run_simulation_cpu1 -logpro runsim.logpro "runsim cpu1" && \
-$MT_MEGATEST -runstep run_simulation_cpu2 -logpro runsim.logpro "runsim cpu2"
-$MT_MEGATEST -test-status :state COMPLETED :status $?
-
-
-
-
-
-6 Simple Test with Multiple Steps, Some in Parallel
-
-A good way to run steps in parallel within a single test, especially when there are following steps, is to use the Unix Make utility. Writing Makefiles is beyond the scope of this document but here is a minimal example that will run “runsim cpu1” and “runsim cpu2” in parallel. For more information on make try “info make” at the Linux command prompt.
-
-
-
-
# Example Makefile to run two steps in parallel
-
-RTLDIR=/path/to/rtl
-CPUS = cpu1 cpu2
-
-run_simulation_$(CPUS).html : $(RTLDIR)/$(CPUS)
- $(MT_MEGATEST) -runstep run_simulation_$(CPUS) -logpro runsim.logpro "runsim $(CPUS)
-
#!/bin/tcsh -x
-
-# run the cpu simulation but now use the environment variable $CPU
-# to select what cpu to run the simulation against
-
-$MT_MEGATEST -runstep run_simulation -logpro runsim.logpro "runsim $CPU"
-# As of version 1.07 Megatest automatically converts a status of "0"
-# to "PASS", any other number to "FAIL" and directly uses the value of
-# a string passed in.
-$MT_MEGATEST -test-status :state COMPLETED :status $?
-
-Sometimes a test depends on the output from a previous test or it may not make sense to run a test is another test does not complete with status “PASS”. In either of these scenarios you can use the “waiton” keyword in your testconfig file to indicate that this test must wait on one or more tests to complete before being launched. In this example there is no point in running the “system” test if the “cpu” and “mem” tests either do not complete or complete but with status “FAIL”.
-
-
-
-
# testconfig for the "system" test
-[setup]
-runscript main.csh
-waiton cpu mem
-
-Use the -load-test-data switch to roll up arbitrary data from a test into the test_data table.
-
-
-
-
# Fields are:
-# category,variable,value,expected,tol,units,comment,status
-
-$MT_MEGATEST -load-test-data << EOF
-foo,bar,1.2,1.9,>
-foo,rab,1.0e9,10e9,1e9
-foo,bla,1.2,1.9,<
-foo,bal,1.2,1.2,<,,Check for overload
-foo,alb,1.2,1.2,<=,Amps,This is the high power circuit test
-foo,abl,1.2,1.3,0.1
-foo,bra,1.2,pass,silly stuff
-faz,bar,10,8mA,,,"this is a comment"
-EOF
-
-
-
-
-
-New entries are keyed on the category and variable. If a new record is inserted with a category and variable that have already been used the new record will replace the old record.
-
-
-Where value, expected and tol are specified the behavior is as follows.
-
-
-
-If value, expected and tol are numbers then status is calculated as PASS if (expected-tol) <= value <= (expected+tol)
-
-
-If value and expected are numbers and tol is >, <, >= or <= then value is compared with expected using the operator given by tol
-
-
-If status is specified its value overrides the above calculations.
-
-All keys must be specified and the runname is the name of the run that will be created. All paths are kept original inside the database. When -remove-runs is used to delete runs the data is not deleted if there are rollups that refer to the data.
-
-Pushing one of the buttons on the main dashboard will bring up the test specific dashboard. Values are updated in semi-real time as the test runs.
-
-
-
-
-
-
-9 Generating an OpenDocument Spreadsheet from the Database
-
-
-And OpenDocument multi-paned spreadsheet can be generated from the megatest.db file by running -extract-ods
-
-
-
-
megatest -extract-ods results.ods :runname %
-
-
-
-
-
-You can optionally specify the keys for your database to limit further the runs to extract into the spreadsheet. The first sheet contains all the run data and subsequent sheets contain data rolled up for the individual tests.
-
# Flow: <flowname>
-[flowconfig]
-# turn on item level dependencies
-itemdeps on
-
-[flowsteps]
-# <testname>[,<predecessor>]
-
-# Run the test "copydata"
-copydata
-
-# Run the test "setup" after copydata completes with PASS, WARN or WAIVE
-setup,copydata
-
-# once the test "setup" completes successfully run sim1, sim2 and sim3
-sim1,setup
-sim2,setup
-sim3,setup
-
-Note: The monitor is usable but incomplete as of Megatest v1.31. Click on the “Monitor” button on the dashboard to start the monitor and give it a try.
-
-Note: whitespace is preserved including at the end of line. Ensure your entries only have whitespace at the end of line when needed to avoid problems.
-
-The file named “filename” will be included as if part of the calling file. NOTE: This means no section can be named “include “ (with the whitespace).
-
-Use only if necessary, megatest will extract the location from where it used to launch and add append that to the PATH for test runs.
-
-
-
-
-
-
-
-
-runsdir
-
-
-full path to where the link tree to all runs will be created
-
-
-no
-
-
-Because your runs may be spread out over several disk partitions a central link tree is created to make finding all the runs easy.
-
-
-
-
-
-[fields]
-
-
-string of letters, numbers and underscore
-
-
-string of letters, numbers and underscore
-
-
-at least one
-
-
-
-
-
-
-
-
-[jobtools]
-
-
-launcher
-
-
-command line used to launch jobs - the job command (megatest -execute) will be appended to this
-
-
-no
-
-
-
-
-
-
-
-
-
-
-
-workhosts
-
-
-list of hostnames to run jobs on NOT SUPPORTED RIGHT NOW
-
-
-n/a
-
-
-
-
-
-
-
-
-[jobgroups]
-
-
-string of letters, numbers and underscore
-
-
-number
-
-
-no
-
-
-Control number of jobs allowed to concurrently run in categories. See [jobgroup] in testconfig
-
-
-
-
-
-[env-override]
-
-
-string of letters, numbers and underscore
-
-
-any string
-
-
-no
-
-
-These are set on the test launching machine, not the test running machine. Typical usage is to control the host or run queue for launching tests. These values will not be seen by the test when it runs.
-
-
-
-
-
-[disks]
-
-
-string of letters, numbers and underscore
-
-
-a valid path writable by the test launching process and by the test process
-
-
-yes
-
-
-The disk usage balancing algorithm is to choose the disk with the least space for each test run.
-
-variables set in this section will be available for all runs, defining the same variable in another section will override the value from the default section
-
-
-
-
-
-[field1value/field2value...]
-
-
-string of letters, numbers and underscore
-
-
-any
-
-
-no
-
-
-the values in this section will be set for any run where field1 is field1value, field2 is field2value and fieldN is fieldNvalue.
-
-
-
-
-
-
-
-
-Example: a test suite that checks that a piece of software works correctly for different customer configurations and locations each of which is done as a separate release regression run. The fields, CUSTOMER and LOCATION were chosen. The following runconfigs.config file would set some variables specific to runs for megacorp in India and femtocorp in the Cook Islands and New Zealand:
-
-The script must be executable and either provide the full path or put a copy at the top of your test directory
-
-
-
-
-
-[requirements]
-
-
-waiton
-
-
-list of valid test names
-
-
-no
-
-
-This test will not run until the named tests are state completed and status PASS
-
-
-
-
-
-
-
-
-jobgroup
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-[items]
-
-
-any valid
-
-
-list of values
-
-
-no
-
-
-The test will be repeated once for each item with the variable name set to the value. If there is more than one variable then the test will be run against all unique combinations of the values
-
-
-
-
-
-[eztests]
-
-
-any valid
-
-
-stepname command
-
-
-no
-
-
-Use in addition to or instead of runscript for easy implementation of steps. If <stepname>.logpro exists it will be applied to the <stepname>.log and resulting exit code will be used to determine PASS/FAIL/WARN
-
-
-
DELETED docs/html/monitor-state-diagram.png
Index: docs/html/monitor-state-diagram.png
==================================================================
--- docs/html/monitor-state-diagram.png
+++ /dev/null
cannot compute difference between binary files
Index: docs/inprogress/graph-draw-arch.fig
==================================================================
--- docs/inprogress/graph-draw-arch.fig
+++ docs/inprogress/graph-draw-arch.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest-architecture-2.fig
==================================================================
--- docs/inprogress/megatest-architecture-2.fig
+++ docs/inprogress/megatest-architecture-2.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest-architecture-proposed-2.fig
==================================================================
--- docs/inprogress/megatest-architecture-proposed-2.fig
+++ docs/inprogress/megatest-architecture-proposed-2.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest-architecture-proposed.fig
==================================================================
--- docs/inprogress/megatest-architecture-proposed.fig
+++ docs/inprogress/megatest-architecture-proposed.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest-architecture.fig
==================================================================
--- docs/inprogress/megatest-architecture.fig
+++ docs/inprogress/megatest-architecture.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest-query-view.fig
==================================================================
--- docs/inprogress/megatest-query-view.fig
+++ docs/inprogress/megatest-query-view.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/inprogress/megatest_qa.fig
==================================================================
--- docs/inprogress/megatest_qa.fig
+++ docs/inprogress/megatest_qa.fig
@@ -5,10 +5,12 @@
Letter
100.00
Single
-2
1200 2
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/Makefile
==================================================================
--- docs/manual/Makefile
+++ docs/manual/Makefile
@@ -1,5 +1,7 @@
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/client.dot
==================================================================
--- docs/manual/client.dot
+++ docs/manual/client.dot
@@ -1,5 +1,7 @@
+// Copyright 2006-2017, Matthew Welland.
+//
// This file is part of Megatest.
//
// Megatest is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/complex-itemmap.dot
==================================================================
--- docs/manual/complex-itemmap.dot
+++ docs/manual/complex-itemmap.dot
@@ -1,5 +1,7 @@
+// Copyright 2006-2017, Matthew Welland.
+//
// This file is part of Megatest.
//
// Megatest is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/getting_started.in
==================================================================
--- docs/manual/getting_started.in
+++ docs/manual/getting_started.in
@@ -10,10 +10,12 @@
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Megatest. If not, see .
+//
+// Copyright 2006-2012, Matthew Welland.
Getting Started
---------------
[partintro]
Index: docs/manual/howto.in
==================================================================
--- docs/manual/howto.in
+++ docs/manual/howto.in
@@ -10,10 +10,12 @@
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Megatest. If not, see .
+//
+// Copyright 2006-2012, Matthew Welland.
How To Do Things
----------------
Process Runs
Index: docs/manual/installation.txt
==================================================================
--- docs/manual/installation.txt
+++ docs/manual/installation.txt
@@ -1,5 +1,7 @@
+// Copyright 2006-2017, Matthew Welland.
+//
// This file is part of Megatest.
//
// Megatest is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/itemmap.fig
==================================================================
--- docs/manual/itemmap.fig
+++ docs/manual/itemmap.fig
@@ -38,10 +38,12 @@
0 60 #000049
0 61 #797979
0 62 #303430
0 63 #414141
0 64 #c7b696
+# Copyright 2006-2017, Matthew Welland.
+#
# This file is part of Megatest.
#
# Megatest is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
Index: docs/manual/megatest_manual.html
==================================================================
--- docs/manual/megatest_manual.html
+++ docs/manual/megatest_manual.html
@@ -786,11 +786,13 @@
This book is organised as three sub-books; getting started, writing tests and reference.
License
-
This document is part of Megatest.
+
Copyright 2006-2017, Matthew Welland.
+
+ This document is part of Megatest.
Megatest is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
@@ -884,11 +886,96 @@
Road Map
-
Note 1: This road-map is still evolving and subject to change without notice.
+
Note 1: This road-map continues to evolve and subject to change without notice.
+One big lesson from the 1.63-1.65 generation was that the main.db, 1.db … model was really good at scaling. I’d like to combine that model with the current also-very-good model. Obviously this is a disruptive change. I think making the old model the default and the new model an option for at least one generation would be fair.
+
+
+
+
+Rigorous megatest.config and runconfig.config caching.
+
+
+
+
+Cache the configs in $MT_RUNPATH
+
+
+
+
+Following invocations of –run, -rerun* will calculate the new config but only overwrite the cached file IF changed
+
+
+
+
+
+
+If the cached file changes ALL existing tests go from COMPLETED → STALE, I’m not sure what to do about RUNNING tests
+
+
+
+
+!VARS in runconfigs are not exported to the environment. They are accessed via rget as if the ! was not there.
+
+
+
+
+Per test copy commands (crude example below is not correct).
+
+
+
+
+
+
[testcopy]
+%/iind% unison SRC DEST
+% cp –r SRC DEST
Purpose: allow shrinking megatest.db data by moving runs to an alternate
Megatest area with same keys.
Method: extend db sync to take a different megatest area as a destination.
@@ -1496,18 +1583,79 @@
Reference
+
+
Megatest Use Modes
+
+
Table 2. Base commands
+
+
+
+
+
+
Use case
+
Megatest command
+
mtutil
+
+
+
+
+
Start from scratch
+
-rerun-all
+
restart
+
+
+
Rerun non-good completed
+
-rerun-clean
+
rerunclean
+
+
+
Rerun all non-good and not completed yet
+
-set-state-status KILLREQ; -rerun-
+
clean
+
+
+
killrerun
+
Continue run
+
-run
+
+
+
resume
+
Remove run
+
-remove-runs
+
+
+
clean
+
Lock run
+
-lock
+
+
+
lock
+
Unlock run
+
-unlock
+
+
+
unlock
+
killrun
+
-set-state-status KILLREQ; -kill-run
+
+
+
+
Config File Helpers
Various helpers for more advanced config files.
-
Table 2. Helpers
+
Table 3. Helpers
@@ -1776,11 +1924,11 @@
Database settings
-
Table 3. Database config settings in [setup] section of megatest.config
+
Table 4. Database config settings in [setup] section of megatest.config
@@ -2074,10 +2222,14 @@
Test A has no waitons. All waitons of all tests in full list have been processed. Full list is finalized.
+
+
itemstable
+
An alternative to defining items is the itemstable section. This lets you define the itempath in a table format rather than specifying components and relying on getting all permutations of those components.
+
Dynamic Flow Dependency Tree
Autogeneration waiton list for dynamic flow dependency trees
@@ -2225,11 +2377,11 @@
fail gracefully if it doesn’t exist.
-
Table 4. Environment variables visible to the trigger script
+
Table 5. Environment variables visible to the trigger script
Variable
@@ -2423,11 +2575,11 @@
passfail logpro
# Optional:
logpro ;; if this section exists then logpro is used to determine pass/fail
(expect:required in "LogFileBody" >= 1 "At least one pass" #/PASS/)
- (expect:fail in "LogFileBody" = 0 "No FAILs allowed" #/FAIL/)
+ (expect:error in "LogFileBody" = 0 "No FAILs allowed" #/FAIL/)
# Optional: target translator, default is to use the parent target
target #{shell somescript.sh}
# Optional: runname translator/generator, default is to use the parent runname
@@ -2458,11 +2610,11 @@
These routines can be called from the megatest repl.