Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -211,10 +211,14 @@
csc $(CSCOPTS) -c common.scm mofiles/commonmod.o
configf.o : configf.scm mofiles/commonmod.o
csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o
+$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest
+
+$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper
+
$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest
@echo Installing to PREFIX=$(PREFIX)
$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest
$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper
@@ -343,11 +347,14 @@
clean :
rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) \
$(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut \
tcmt readline-fix.scm serialize-env dboard *.o \
- megatest-fossil-hash.* altdb.scm mofiles/*.o
+ megatest-fossil-hash.* altdb.scm mofiles/*.o \
+ mofiles/*.o vg.o cookie.o dashboard-main.o \
+ ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o \
+ tcmt.o
rm -rf share
#======================================================================
# Deploy section (not complete yet)
#======================================================================
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 @@
Preface
@@ -2587,10 +2587,32 @@
[itemstable]
A x y
B 1 2
# Yields x/1 y/2
+
+
Requirements section
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
@@ -1229,29 +1229,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 "$@"