Index: NOTES ================================================================== --- NOTES +++ NOTES @@ -158,5 +158,9 @@ INFO: (0) Server shutdown complete. Exiting Start: 0 at Sun Apr 28 22:18:25 MST 2013 Max: 52 at Sun Apr 28 23:06:59 MST 2013 End: 6 at Sun Apr 28 23:47:51 MST 2013 + +======================================================================== + + Index: docs/manual/megatest_manual.html ================================================================== --- docs/manual/megatest_manual.html +++ docs/manual/megatest_manual.html @@ -769,13 +769,13 @@

The Megatest Users Manual

Matt Welland
<matt@kiatoa.com>
version 1.5, June 2020 -
-
Table of Contents
- +
+
Table of Contents
+

Preface

@@ -2588,10 +2588,32 @@ A x y B 1 2 # Yields x/1 y/2
+
+
Or use files
+
+
[itemopts]
+slash path/to/file/with/items
+# or
+space path/to/file/with/items
+
+
+
File format for / delimited
+
+
key1/key2/key3
+val1/val2/val2
+...
+
+
+
File format for space delimited
+
+
key1 key2 key3
+val1 val2 val2
+...
+

Requirements section

Header
@@ -3412,11 +3434,11 @@
Index: docs/manual/reference.txt ================================================================== --- docs/manual/reference.txt +++ docs/manual/reference.txt @@ -324,10 +324,31 @@ B 1 2 # Yields x/1 y/2 ------------------ +.Or use files +------------------ +[itemopts] +slash path/to/file/with/items +# or +space path/to/file/with/items +------------------ + +.File format for / delimited +------------------ +key1/key2/key3 +val1/val2/val2 +... +------------------ + +.File format for space delimited +------------------ +key1 key2 key3 +val1 val2 val2 +... +------------------ Requirements section ~~~~~~~~~~~~~~~~~~~~ .Header Index: items.scm ================================================================== --- items.scm +++ items.scm @@ -123,13 +123,63 @@ (if s (string-split s) #f)))) (if valid-values (if (member item valid-values) item #f) item))) + +;; '(("k1" "k2" "k3") +;; ("a" "b" "c") +;; ("d" "e" "f")) +;; +;; => '((("k1" "a")("k2" "b")("k3" "c")) +;; (("k1" "d")("k2" "e")("k3" "f"))) +;; +(define (items:first-row-intersperse data) + (if (< (length data) 2) + '() + (let ((header (car data)) + (rows (cdr data))) + (map (lambda (row) + (map list header row)) + rows)))) + +;; k1/k2/k3 +;; a/b/c +;; d/e/f +;; => '(("k1" "k2" "k3") +;; ("a" "b" "c") +;; ("d" "e" "f")) +;; +;; => '((("k1" "a")("k2" "b")("k3" "c")) +;; (("k1" "d")("k2" "e")("k3" "f"))) +;; +(define (items:read-items-file fname ftype) ;; 'sxml 'slash 'space + (if (and fname (file-exists? fname)) + (items:first-row-intersperse (case ftype + ((slash space) + (let ((splitter (case ftype + ((slash) (lambda (x)(string-split x "/"))) + (else string-split)))) + (debug:print 0 *default-log-port* "Reading " fname " of type " ftype) + (with-input-from-file fname + (lambda () + (let loop ((inl (read-line)) + (res '())) + (if (eof-object? inl) + res + (loop (read-line)(cons (splitter inl) res)))))))) + ((sxml)(with-input-from-file fname read)) + (else (debug:print 0 *default-log-port* "items file type " ftype " not recognised")))) + (begin + (if fname (debug:print 0 *default-log-port* "no items file " fname " found")) + '()))) (define (items:get-items-from-config tconfig) - (let* ((have-items (hash-table-ref/default tconfig "items" #f)) + (let* ((slashf (configf:lookup tconfig "itemopts" "slash")) ;; a/b/c\nd/e/f\n ... + (sxmlf (configf:lookup tconfig "itemopts" "sxml")) ;; '(("a" "b" "c")("d" "e" "f") ...) + (spacef (configf:lookup tconfig "itemopts" "space")) ;; a b c\nd e f\n ... + (have-items (hash-table-ref/default tconfig "items" #f)) (have-itable (hash-table-ref/default tconfig "itemstable" #f)) (items (hash-table-ref/default tconfig "items" '())) (itemstable (hash-table-ref/default tconfig "itemstable" '()))) (debug:print 5 *default-log-port* "items: " items " itemstable: " itemstable) (set! items (map (lambda (item) @@ -142,14 +192,21 @@ (list (car item)((cadr item))) ;; evaluate the proc item)) itemstable)) (if (and have-items (null? items)) (debug:print 0 *default-log-port* "WARNING:[items] section in testconfig but no entries defined")) (if (and have-itable (null? itemstable))(debug:print 0 *default-log-port* "WARNNG:[itemstable] section in testconfig but no entries defined")) - (if (or (not (null? items))(not (null? itemstable))) + (if (or (not (null? items)) + (not (null? itemstable)) + slashf + sxmlf + spacef) (append (item-assoc->item-list items) - (item-table->item-list itemstable)) + (item-table->item-list itemstable) + (items:read-items-file slashf 'slash) + (items:read-items-file sxmlf 'sxml) + (items:read-items-file spacef 'space)) '(())))) ;; (pp (item-assoc->item-list itemdat)) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -1228,29 +1228,29 @@ (let ((iterated-parent (pathname-directory (conc lnkpath "/" item-path)))) (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", exiting") - (exit 1)) + (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted") + #;(exit 1)) (create-directory iterated-parent #t)))) (if (symbolic-link? lnkpath) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting") - (exit 1)) + (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.") + #;(exit 1)) (delete-file lnkpath))) (if (not (or (common:file-exists? lnkpath) (symbolic-link? lnkpath))) (handle-exceptions exn (begin - (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting") - (exit 1)) + (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.") + #;(exit 1)) (create-symbolic-link toptest-path lnkpath))) ;; NB - This was not working right - some top tests are not getting the path set!!! ;; ;; Do the setting of this record after the paths are created so that the shortdir can Index: utils/mtrunner ================================================================== --- utils/mtrunner +++ utils/mtrunner @@ -26,6 +26,6 @@ cd $1 shift export PATH="$1:$PATH" shift -"$@" +exec "$@"