Megatest

Check-in [b2dff05073]
Login
Overview
Comment:Fixed mishandling of an items list with no items, cleaned up tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | debug-printing
Files: files | file ages | folders
SHA1: b2dff0507339bb8126b2207aa643ec45a4d36394
User & Date: mrwellan on 2011-06-29 15:31:09
Other Links: branch diff | manifest | tags
Context
2011-06-29
20:56
Cleaned up remove runs check-in: 1b6a0ceec8 user: mrwellan tags: debug-printing
15:31
Fixed mishandling of an items list with no items, cleaned up tests check-in: b2dff05073 user: mrwellan tags: debug-printing
2011-06-27
23:08
Added debug printing check-in: 8800c042e5 user: mrwellan tags: debug-printing
Changes

Modified common.scm from [54f3047eca] to [0c60122ca7].

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(define *configinfo* #f)
(define *configdat*  #f)
(define *toppath*    #f)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue* (make-hash-table))
(define *globalexitstatus* 0) ;; attempt to work around possible thread issues
(define *passnum*     0) ;; when running track calls to run-tests or similar


(define-inline (get-with-default val default)
  (let ((val (args:get-arg val)))
    (if val val default)))

(define-inline (assoc/default key lst . default)
  (let ((res (assoc key lst)))







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(define *configinfo* #f)
(define *configdat*  #f)
(define *toppath*    #f)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue* (make-hash-table))
(define *globalexitstatus* 0) ;; attempt to work around possible thread issues
(define *passnum*     0) ;; when running track calls to run-tests or similar
(define *verbosity*   1)

(define-inline (get-with-default val default)
  (let ((val (args:get-arg val)))
    (if val val default)))

(define-inline (assoc/default key lst . default)
  (let ((res (assoc key lst)))
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "'" val "'") val)))
                        (debug:print 2 "setenv " (car key) " " sval)))
                     envvars)))
     (with-output-to-file (conc fname ".sh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "'" val "'") val)))
                         (debug:print 2 "export " (car key) "=" sval)))
                    envvars)))))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))







|






|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "'" val "'") val)))
                        (print "setenv " (car key) " " sval)))
                     envvars)))
     (with-output-to-file (conc fname ".sh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "'" val "'") val)))
                         (print "export " (car key) "=" sval)))
                    envvars)))))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))

Modified configf.scm from [abd6461d4c] to [0a1046a4bf].

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
	       (section-rx ( x section-name ) (loop (read-line inp) section-name))
	       (key-sys-pr ( x key cmd      ) (let ((alist (hash-table-ref/default res curr-section-name '()))
						    (val   (let* ((cmdres  (cmd-run->list cmd))
								  (status  (cadr cmdres))
								  (res     (car  cmdres)))
							     (if (not (eq? status 0))
								 (begin
								   (debug:print 0 "ERROR: problem with " inl ", return code not 0")
								   (exit 1)))
							     (if (null? res)
								 ""
								 (string-intersperse res " ")))))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))







|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
	       (section-rx ( x section-name ) (loop (read-line inp) section-name))
	       (key-sys-pr ( x key cmd      ) (let ((alist (hash-table-ref/default res curr-section-name '()))
						    (val   (let* ((cmdres  (cmd-run->list cmd))
								  (status  (cadr cmdres))
								  (res     (car  cmdres)))
							     (if (not (eq? status 0))
								 (begin
								   (debug:print 0 "ERROR: problem with " inl ", return code " status)
								   (exit 1)))
							     (if (null? res)
								 ""
								 (string-intersperse res " ")))))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))

Modified dashboard.scm from [cb6f6bf128] to [30a26490d6].

138
139
140
141
142
143
144






145
146
147
148
149
150
151
		      (set! maxtests (length tests)))
		  (set! result (cons (vector run tests key-vals) result))))
	      runs)
    (set! *header*  header)
    (set! *allruns* result)
    maxtests))







(define (update-labels uidat)
  (let* ((rown    0)
	 (lftcol  (vector-ref uidat 0))
	 (numcols (vector-length lftcol))
	 (maxn    (- numcols 1))
	 (allvals (make-vector numcols "")))
    (for-each (lambda (name)







>
>
>
>
>
>







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
		      (set! maxtests (length tests)))
		  (set! result (cons (vector run tests key-vals) result))))
	      runs)
    (set! *header*  header)
    (set! *allruns* result)
    maxtests))

(define *collapsed* (make-hash-table))
(define (toggle-hide testname)
  (if (hash-table-ref/default *collapsed* testname #f)
      (hash-table-delete! *collapsed* testname)
      (hash-table-set! *collapsed* testname #t)))

(define (update-labels uidat)
  (let* ((rown    0)
	 (lftcol  (vector-ref uidat 0))
	 (numcols (vector-length lftcol))
	 (maxn    (- numcols 1))
	 (allvals (make-vector numcols "")))
    (for-each (lambda (name)
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
			  (take-right *allruns* numruns)
			  (pad-list *allruns* numruns)))
	 (lftcol      (vector-ref uidat 0))
	 (tableheader (vector-ref uidat 1))
	 (table       (vector-ref uidat 2))
	 (coln        0))
    (update-labels uidat)
    (for-each 
     (lambda (popup)
       (let* ((test-id  (car popup))
	      (widgets  (hash-table-ref *examine-test-dat* popup))
	      (stepslbl (hash-table-ref/default widgets "Test Steps" #f)))
	 (if stepslbl
	     (let* ((fmtstr  "~15a~8a~8a~20a")
		    (newtxt  (string-intersperse 
			      (append
			       (list 
				(format #f fmtstr "Stepname" "State" "Status" "Event Time")
				(format #f fmtstr "========" "=====" "======" "=========="))
			       (map (lambda (x)
				      ;; take advantage of the \n on time->string
				      (format #f fmtstr
					      (db:step-get-stepname x)
					      (db:step-get-state    x)
					      (db:step-get-status   x)
					      (time->string 
					       (seconds->local-time 
						(db:step-get-event_time x)))))
				    (db-get-test-steps-for-run *db* test-id)))
			     "\n")))
	       (iup:attribute-set! stepslbl "TITLE" newtxt)))))
     (hash-table-keys *examine-test-dat*))
    (set! *alltestnamelst* '())
    (for-each
     (lambda (rundat)
       (if (not rundat) ;; handle padded runs
	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
       (let* ((run      (vector-ref rundat 0))







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







194
195
196
197
198
199
200

























201
202
203
204
205
206
207
			  (take-right *allruns* numruns)
			  (pad-list *allruns* numruns)))
	 (lftcol      (vector-ref uidat 0))
	 (tableheader (vector-ref uidat 1))
	 (table       (vector-ref uidat 2))
	 (coln        0))
    (update-labels uidat)

























    (set! *alltestnamelst* '())
    (for-each
     (lambda (rundat)
       (if (not rundat) ;; handle padded runs
	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
       (let* ((run      (vector-ref rundat 0))
348
349
350
351
352
353
354


355
356
357
358
359
360
361
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
       (else
	(let ((labl  (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))


	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; 
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))







>
>







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
       (else
	(let ((labl  (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))
	  (iup:attribute-set! labl "ACTION" (lambda (obj)
					      (toggle-hide (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; 
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))

Modified items.scm from [111ff4f852] to [4226f1b6bb].

49
50
51
52
53
54
55
56







57
58
59
60








61

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
;; (item-assoc->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Fall")))
;;   => ((("ANIMAL" "Elephant") ("SEASON" "Spring")) 
;;       (("ANIMAL" "Elephant") ("SEASON" "Fall")) 
;;       (("ANIMAL" "Lion")     ("SEASON" "Spring"))
;;       (("ANIMAL" "Lion")     ("SEASON" "Fall")))
(define (item-assoc->item-list itemsdat)
  (if (and itemsdat (not (null? itemsdat)))
      (let ((itemlst (map (lambda (x)







			    (let ((name (car x))
				  (items (cadr x)))
			      (list name (string-split items))))
			  itemsdat)))








	(process-itemlist #f '() itemlst))

      '())) ;; return a list consisting on a single null list for non-item runs
            ;; Nope, not now, return null as of 6/6/2011

;; (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))
;;   => ((("ANIMAL" "Elephant")("SEASON" "Spring"))
;;       (("ANIMAL" "Lion")    ("SEASON" "Winter")))
(define (item-table->item-list itemtable)
  (let ((newlst (map (lambda (x)
		       (if (> (length x) 1)
			   (list (car x)
				 (string-split (cadr x)))
			   x))
		     itemtable))
	(res     '())) ;; a list of items
    (let loop ((indx    0)
	       (item   '()) ;; an item will be ((KEYNAME1 VAL1)(KEYNAME2 VAL2) ...)
	       (elflag  #f))
      (for-each (lambda (row)
		  (let ((rowname (car row))







|
>
>
>
>
>
>
>
|
|
|
|
>
>
>
>
>
>
>
>
|
>











|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
;; (item-assoc->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Fall")))
;;   => ((("ANIMAL" "Elephant") ("SEASON" "Spring")) 
;;       (("ANIMAL" "Elephant") ("SEASON" "Fall")) 
;;       (("ANIMAL" "Lion")     ("SEASON" "Spring"))
;;       (("ANIMAL" "Lion")     ("SEASON" "Fall")))
(define (item-assoc->item-list itemsdat)
  (if (and itemsdat (not (null? itemsdat)))
      (let ((itemlst (filter (lambda (x)
			       (list? x))
			     (map (lambda (x)
				    (debug:print 6 "item-assoc->item-list x: " x)
				    (if (< (length x) 2)
					(begin
					  (debug:print 0 "ERROR: malformed items spec " (string-intersperse x " "))
					  (list (car x)'()))
					(let ((name (car x))
					      (items (cadr x)))
					  (list name (string-split items)))))
				  itemsdat))))
	(let ((debuglevel 5))
	  (debug:print 5 "item-assoc->item-list: itemsdat => itemlst ")
	  (if (>= *verbosity* 5)
	      (begin
		(pp itemsdat)
		(print " => ")
		(pp itemlst))))
	(if (> (length itemlst) 0)
	    (process-itemlist #f '() itemlst)
	    '()))
      '())) ;; return a list consisting on a single null list for non-item runs
            ;; Nope, not now, return null as of 6/6/2011

;; (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))
;;   => ((("ANIMAL" "Elephant")("SEASON" "Spring"))
;;       (("ANIMAL" "Lion")    ("SEASON" "Winter")))
(define (item-table->item-list itemtable)
  (let ((newlst (map (lambda (x)
		       (if (> (length x) 1)
			   (list (car x)
				 (string-split (cadr x)))
			   (list x '())))
		     itemtable))
	(res     '())) ;; a list of items
    (let loop ((indx    0)
	       (item   '()) ;; an item will be ((KEYNAME1 VAL1)(KEYNAME2 VAL2) ...)
	       (elflag  #f))
      (for-each (lambda (row)
		  (let ((rowname (car row))

Modified launch.scm from [1ed151ecf7] to [4996324b33].

95
96
97
98
99
100
101
102



103
104
105
106
107
108
109
    (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
    (system  (conc "mkdir -p " lnkpath))
    (if (file-exists? (conc lnkpath "/" testname))
	(system (conc "rm -f " lnkpath "/" testname)))
    (system  (conc "ln -sf " dfullp " " lnkpath "/" testname))
    (if (directory? dfullp)
	(begin
	  (system  (conc "rsync -av " test-path "/ " dfullp "/"))



	  (list dfullp toptest-path))
	(list #f #f))))

;; 1. look though disks list for disk with most space
;; 2. create run dir on disk, path name is meaningful
;; 3. create link from run dir to megatest runs area 
;; 4. remotely run the test on allocated host







|
>
>
>







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
    (system  (conc "mkdir -p " lnkpath))
    (if (file-exists? (conc lnkpath "/" testname))
	(system (conc "rm -f " lnkpath "/" testname)))
    (system  (conc "ln -sf " dfullp " " lnkpath "/" testname))
    (if (directory? dfullp)
	(begin
	  (let* ((cmd    (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/"))
		 (status (system cmd)))
	    (if (not (eq? status 0))
		(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
	  (list dfullp toptest-path))
	(list #f #f))))

;; 1. look though disks list for disk with most space
;; 2. create run dir on disk, path name is meaningful
;; 3. create link from run dir to megatest runs area 
;; 4. remotely run the test on allocated host

Modified megatest.scm from [3c2150da95] to [cbc2bba983].

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

(define *didsomething* #f)

;;======================================================================
;; Misc setup stuff
;;======================================================================

(define *verbosity* (cond
		     ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
		     ((args:get-arg "-v")    2)
		     ((args:get-arg "-q")    0)
		     (else                   1)))

;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first







|
|
|
|
|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

(define *didsomething* #f)

;;======================================================================
;; Misc setup stuff
;;======================================================================

(set! *verbosity* (cond
		   ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
		   ((args:get-arg "-v")    2)
		   ((args:get-arg "-q")    0)
		   (else                   1)))

;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first

Modified runs.scm from [bfe43f14b2] to [1c23033086].

313
314
315
316
317
318
319
320





321
322


323
324
325
326
327
328
329
	       (items       (hash-table-ref/default test-conf "items" '()))
	       (itemstable  (hash-table-ref/default test-conf "itemstable" '()))
	       (allitems    (if (or (not (null? items))(not (null? itemstable)))
				(append (item-assoc->item-list items)
					(item-table->item-list itemstable))
				'(()))) ;; a list with one null list is a test with no items
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  (debug:print 1 "items: ")(pp allitems)





	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))


	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    ;; Handle lists of items
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
		   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique







|
>
>
>
>
>


>
>







313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
	       (items       (hash-table-ref/default test-conf "items" '()))
	       (itemstable  (hash-table-ref/default test-conf "itemstable" '()))
	       (allitems    (if (or (not (null? items))(not (null? itemstable)))
				(append (item-assoc->item-list items)
					(item-table->item-list itemstable))
				'(()))) ;; a list with one null list is a test with no items
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  (debug:print 1 "items: ")
	  (if (>= *verbosity* 1)(pp allitems))
	  (if (>= *verbosity* 5)
	      (begin
		(print "items: ")(pp (item-assoc->item-list items))
		(print "itestable: ")(pp (item-table->item-list itemstable))))
	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  ;; braindead work-around for poorly specified allitems list BUG!!! FIXME
	  (if (null? allitems)(set! allitems '(())))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    ;; Handle lists of items
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
		   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique

Modified tests/Makefile from [0b961aa417] to [75ccc3e45d].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# run some tests

MEGATEST=$(shell realpath ../megatest)

runall :
	cd ../;make 
	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run"

test :
	cd ../;make test
	make runall

dashboard :
	cd ../;make dashboard






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# run some tests

MEGATEST=$(shell realpath ../megatest)

runall :
	cd ../;make 
	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run" -v

test :
	cd ../;make test
	make runall

dashboard :
	cd ../;make dashboard

Modified tests/megatest.config from [78f30a1554] to [814128c313].

25
26
27
28
29
30
31


32
33
34
35
36
37
38

# These are set before all tests, override them 
# in the testconfig [pre-launch-env-overrides] section
[env-override]
SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs
TESTVAR [system realpath .]
DEADVAR [system ls]



## disks are:
## name host:/path/to/area
## -or-
## name /path/to/area
[disks]
1 /tmp







>
>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

# These are set before all tests, override them 
# in the testconfig [pre-launch-env-overrides] section
[env-override]
SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs
TESTVAR [system realpath .]
DEADVAR [system ls]
# XTERM   [system xterm]
# RUNDEAD [system exit 56]

## disks are:
## name host:/path/to/area
## -or-
## name /path/to/area
[disks]
1 /tmp

Modified tests/tests.scm from [0b7d0d8b1e] to [6fc7061e87].

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(test "Get best dir" #t (let ((bestdir (get-best-disk conffile)))
			      (or (equal? "./"   bestdir)
				  (equal? "/tmp" bestdir))))

;; db
(define row    (vector "a" "b" "c" "blah"))
(define header (list "col1" "col2" "col3" "col4"))
(test "Get row by header" "blah" (db-get-value-by-header row header "col4"))

;; (define *toppath* "tests")
(define *db* #f)
(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))
(test "open-db" #t (begin
		     (set! *db* (open-db))







|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(test "Get best dir" #t (let ((bestdir (get-best-disk conffile)))
			      (or (equal? "./"   bestdir)
				  (equal? "/tmp" bestdir))))

;; db
(define row    (vector "a" "b" "c" "blah"))
(define header (list "col1" "col2" "col3" "col4"))
(test "Get row by header" "blah" (db:get-value-by-header row header "col4"))

;; (define *toppath* "tests")
(define *db* #f)
(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))
(test "open-db" #t (begin
		     (set! *db* (open-db))
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
	  (list "pass" "fail" "n/a"))

(test "write env files" "nada.csh" (begin
                                      (save-environment-as-files "nada")
                                      (and (file-exists? "nada.sh")
    			                 (file-exists? "nada.csh"))))

(test "get all legal tests" (list "runfirst" "sqlitespeed") (sort (get-all-legal-tests) string<=?))

(test "register-test, test info" "NOT_STARTED"
      (begin
	(register-test *db* 1 "nada" "")
	(test:get-state (runs:get-test-info *db* 1 "nada" ""))))

(test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0)))))))

(define remargs (args:get-args
		 '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
		 (list ":runname" ":state" ":status")
		 (list "-h")







|




|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
	  (list "pass" "fail" "n/a"))

(test "write env files" "nada.csh" (begin
                                      (save-environment-as-files "nada")
                                      (and (file-exists? "nada.sh")
    			                 (file-exists? "nada.csh"))))

(test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?))

(test "register-test, test info" "NOT_STARTED"
      (begin
	(register-test *db* 1 "nada" "")
	(test:get-state (db:get-test-info *db* 1 "nada" ""))))

(test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0)))))))

(define remargs (args:get-args
		 '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
		 (list ":runname" ":state" ":status")
		 (list "-h")
78
79
80
81
82
83
84
85









(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
				       (result   (get-environment-variable "NADAFOO")))
				    (alist->env-vars prevvals)
				    result))

(test "env restored" "1234" (get-environment-variable "BLAHFOO"))

				    
















|
>
>
>
>
>
>
>
>
>
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
				       (result   (get-environment-variable "NADAFOO")))
				    (alist->env-vars prevvals)
				    result))

(test "env restored" "1234" (get-environment-variable "BLAHFOO"))


(test "Items assoc" "Elephant" (cadar (cadr (item-assoc->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Fall"))))))
(set! *verbosity* 6)
(test "Items assoc" '()(item-assoc->item-list '(("a" "a b c d")("b" "c d e")("c" "")("d"))))
(set! *verbosity* -1)
(test "Items assoc empty items" '()   (item-assoc->item-list '(("A"))))
(set! *verbosity* 1)
(test "Items table" "SEASON" (caadar (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))))
(test "Items table empty items I" '() (item-table->item-list '(("A"))))
(test "Items table empty items II" '() (item-table->item-list '(("A" ""))))

Modified tests/tests/sqlitespeed/testconfig from [b027393339] to [89f0ed3696].

1
2
3
4
5
6
7
8

9
[setup]
runscript runscript.rb

[requirements]
waiton    runfirst

[items]
MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)]










>

1
2
3
4
5
6
7
8
9
10
[setup]
runscript runscript.rb

[requirements]
waiton    runfirst

[items]
MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)]
# BORKED