Megatest

Check-in [7cbeb443c9]
Login
Overview
Comment:Refactoring, little bit of run control work
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | runcontrol
Files: files | file ages | folders
SHA1: 7cbeb443c9c11d4fd16e12f61a6c4efd72695830
User & Date: mrwellan on 2013-04-23 09:44:55
Other Links: branch diff | manifest | tags
Context
2013-04-23
22:12
Merging dev into runcontrol check-in: 7d7f76d4b1 user: matt tags: runcontrol
09:44
Refactoring, little bit of run control work check-in: 7cbeb443c9 user: mrwellan tags: runcontrol
2013-04-22
23:38
Trying fork instead of system for launching server, added better guesser for ip address to bind to (should bind to all?) check-in: 1b71a45029 user: matt tags: development
19:47
Merged dev into runcontrol check-in: df98c96bb1 user: matt tags: runcontrol
Changes

Modified dashboard.scm from [f334b951f8] to [7d3ee2c235].

483
484
485
486
487
488
489
490
491
492
493
494
495
496







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533


534
535
536
537
538
539
540
541
542
543
544
545
546
547
548




549
550
551
552
553
554
555
483
484
485
486
487
488
489







490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

517
518
519
520
521
522
523
524
525
526
527
528
529
530
531


532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
556
557
558







-
-
-
-
-
-
-
+
+
+
+
+
+
+




















-
+














-
-
+
+














-
+
+
+
+







	       (refvals '())
	       (indx    0)
	       (lbs     '()))
      (let* ((lb (let ((lb (list-ref key-listboxes indx)))
		   (if lb
		       lb
		       (iup:listbox 
			#:size "x15" 
				    #:fontsize "10"
				    #:expand "YES"
				    ;; #:dropdown "YES"
				    #:editbox "YES"
				    #:action action-proc
				    ))))
			#:size "x10" 
			#:fontsize "10"
			#:expand "VERTICAL"
			;; #:dropdown "YES"
			#:editbox "YES"
			#:action action-proc
			))))
	     ;; loop though all the targets and build the list for this dropdown
	     (selected-value (dashboard:populate-target-dropdown lb refvals db-targets)))
	(if (null? remkeys)
	    ;; return a list of the listbox items and an iup:hbox with the labels and listboxes
	    (let ((listboxes (append lbs (list lb))))
	      (list listboxes
		    (map (lambda (htxt lb)
			   (iup:vbox
			    (iup:label htxt)
			    lb))
			 header
			 listboxes)))
	    (loop (car remkeys)
		  (cdr remkeys)
		  (append refvals (list selected-value))
		  (+ indx 1)
		  (append lbs (list lb))))))))

(define (dashboard:draw-tests cnv xadj yadj test-draw-state sorted-testnames)
  (canvas-clear! cnv)
  (canvas-font-set! cnv "Courier New, -8")
  (canvas-font-set! cnv "Courier New, -10")
  (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
	       ((originx originy)             (canvas-origin cnv)))
      (if (hash-table-ref/default test-draw-state 'first-time #t)
	  (begin
	    (hash-table-set! test-draw-state 'first-time #f)
	    (hash-table-set! test-draw-state 'scalef 8)
	    ;; set these 
	    (hash-table-set! test-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj))))
	    (hash-table-set! test-draw-state 'test-browse-yoffset 20))) ;; (- 0 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
      (let* ((scalef (hash-table-ref/default test-draw-state 'scalef 8))
	     (test-browse-xoffset (hash-table-ref test-draw-state 'test-browse-xoffset))
	     (test-browse-yoffset (hash-table-ref test-draw-state 'test-browse-yoffset))
	     (xtorig (+ test-browse-xoffset (* (/ sizex 2) scalef (- 0.5 xadj)))) ;;  (- xadj 1))))
	     (ytorig (+ test-browse-yoffset (* (/ sizey 2) scalef (- yadj 0.5))))
	     (boxw   80)
	     (boxh   30)
	     (boxw   90)
	     (boxh   25)
	     (gapx   20)
	     (gapy   30))
	(print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv) " originx: " originx " originy: " originy " xtorig: " xtorig " ytorig: " ytorig " xadj: " xadj " yadj: " yadj)
	(let loop ((hed (car (reverse sorted-testnames)))
		   (tal (cdr (reverse sorted-testnames)))
		   (llx xtorig)
		   (lly ytorig)
		   (urx (+ xtorig boxw))
		   (ury (+ ytorig boxh)))
	  ; (print "hed " hed " llx " llx " lly " lly " urx " urx " ury " ury)
	  (canvas-text! cnv (+ llx 5)(+ lly 5) hed) ;; (conc testname " (" xtorig "," ytorig ")"))
	  (canvas-rectangle! cnv llx urx lly ury)
	  (if (not (null? tal))
	      ;; leave a column of space to the right to list items
	      (let ((have-room (< urx (- sizex boxw gapx boxw))))  ;; is there room for another column?
	      (let ((have-room 
		     (if #t ;; put "auto" here where some form of auto rearanging can be done
			 (> (* 3 (+ boxw gapx)) (- urx xtorig))
			 (< urx (- sizex boxw gapx boxw)))))  ;; is there room for another column?
		(loop (car tal)
		      (cdr tal)
		      (if have-room (+ llx boxw gapx) xtorig) ;; have room, 
		      (if have-room lly (+ lly boxh gapy))
		      (if have-room (+ urx boxw gapx) (+ xtorig boxw))
		      (if have-room ury (+ ury boxh gapy)))))))))

590
591
592
593
594
595
596
597


598
599
600
601
602
603
604
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607
608







-
+
+







      (iup:frame
       #:title "Tests and Tasks"
       (iup:vbox
	(iup:canvas #:action (make-canvas-action
			      (lambda (cnv xadj yadj)
				;; (print "cnv: " cnv " x: " x " y: " y)
				(dashboard:draw-tests cnv xadj yadj tests-draw-state sorted-testnames)))
		    #:size "150x200"
		    #:size "150x150"
		    #:expand "YES"
		    #:scrollbar "YES"
		    #:posx "0.5"
		    #:posy "0.5")))))))


(trace dashboard:populate-target-dropdown
       common:list-is-sublist)

Modified http-transport.scm from [c1f69a9798] to [73851c241d].

20
21
22
23
24
25
26

27
28
29
30
31
32
33
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34







+







(declare (unit http-transport))

(declare (uses common))
(declare (uses db))
(declare (uses tests))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses server))
(declare (uses daemon))

(include "common_records.scm")
(include "db_records.scm")

(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
41
42
43
44
45
46
47












48
49
50
51
52
53
54
55
56
57
58
59
60
61


62
63
64
65
66
67
68
42
43
44
45
46
47
48
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







+
+
+
+
+
+
+
+
+
+
+
+













-
+
+







;;======================================================================

;; Call this to start the actual server
;;

(define *db:process-queue-mutex* (make-mutex))

(define (server:get-best-guess-address hostname)
  (let ((res #f))
    (for-each 
     (lambda (adr)
       (if (not (eq? (u8vector-ref adr 0) 127))
	   (set! res adr)))
     (vector->list (hostinfo-addresses (hostname->hostinfo hostname))))
    (string-intersperse 
     (map number->string
	  (u8vector->list
	   (if res res (hostname->ip hostname)))) ".")))

(define (http-transport:run hostn)
  (debug:print 2 "Attempting to start the server ...")
  (if (not *toppath*)
      (if (not (setup-for-run))
	  (begin
	    (debug:print 0 "ERROR: cannot find megatest.config, cannot start server, exiting")
	    (exit))))
  (let* (;; (iface           (if (string=? "-" hostn)
	 ;;        	      #f ;; (get-host-name) 
	 ;;        	      hostn))
	 (db              #f) ;;        (open-db)) ;; we don't want the server to be opening and closing the db unnecesarily
	 (hostname        (get-host-name))
	 (ipaddrstr       (let ((ipstr (if (string=? "-" hostn)
					   (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
					   (server:get-best-guess-address hostname)
					   #f)))
			    (if ipstr ipstr hostn))) ;; hostname)))
	 (start-port    (if (and (args:get-arg "-port")
				 (string->number (args:get-arg "-port")))
			    (string->number (args:get-arg "-port"))
			    (if (and (config-lookup  *configdat* "server" "port")
				     (string->number (config-lookup  *configdat* "server" "port")))
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137

138

139
140
141
142
143
144
145
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160







-
+














+
-
+







(define (http-transport:try-start-server ipaddrstr portnum)
  (handle-exceptions
   exn
   (begin
     (print-error-message exn)
     (if (< portnum 9000)
	 (begin 
	   (print "WARNING: failed to start on portnum: " portnum ", trying next port")
	   (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port")
	   (thread-sleep! 0.1)
	   ;; (open-run-close tasks:remove-server-records tasks:open-db)
	   (open-run-close tasks:server-delete tasks:open-db ipaddrstr portnum)
	   (http-transport:try-start-server ipaddrstr (+ portnum 1)))
	 (print "ERROR: Tried and tried but could not start the server")))
   ;; any error in following steps will result in a retry
   (set! *runremote* (list ipaddrstr portnum))
   ;; (open-run-close tasks:remove-server-records tasks:open-db)
   (open-run-close tasks:server-register 
		   tasks:open-db 
		   (current-process-id)
		   ipaddrstr portnum 0 'live 'http)
   (print "INFO: Trying to start server on " ipaddrstr ":" portnum)
   ;; This starts the spiffy server
   ;; NEED WAY TO SET IP TO #f TO BIND ALL
   (start-server port: portnum)
   (start-server bind-address: ipaddrstr port: portnum)
   (open-run-close tasks:server-delete tasks:open-db ipaddrstr portnum)
   (print "INFO: server has been stopped")))

;;======================================================================
;; S E R V E R   U T I L I T I E S 
;;======================================================================

310
311
312
313
314
315
316















317
318
319
320
321
322
323
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	      (thread-start! th3)
	      (thread-start! th1)
	      (set! *didsomething* #t)
	      (thread-join! th2))
	    (debug:print 0 "ERROR: Failed to setup for megatest")))
    (exit)))

;; (use trace)
;; (trace http-transport:keep-running 
;;        tasks:get-best-server
;;        http-transport:run
;;        http-transport:launch
;;        http-transport:try-start-server
;;        http-transport:client-send-receive
;;        http-transport:make-server-url
;;        tasks:server-register
;;        tasks:server-delete
;;        start-server
;;        hostname->ip
;;        with-input-from-request
;;        tasks:server-deregister-self)

(define (http-transport:server-signal-handler signum)
  (handle-exceptions
   exn
   (debug:print " ... exiting ...")
   (let ((th1 (make-thread (lambda ()
			     (thread-sleep! 1))
			     ;; (if (not *received-response*)

Modified megatest.scm from [2419ab740a] to [a3997eb6d8].

21
22
23
24
25
26
27

28
29
30
31
32
33
34
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35







+







(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
(declare (uses daemon))

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
311
312
313
314
315
316
317
318


319
320
321


322
323
324
325
326











327
328
329
330
331
332
333
334
335
312
313
314
315
316
317
318

319
320
321
322
323
324
325





326
327
328
329
330
331
332
333
334
335
336
337

338
339
340
341
342
343
344







-
+
+



+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-







    (if (not (null? (lset-intersection 
		     equal?
		     (hash-table-keys args:arg-hash)
		     '("-runtests"    "-list-runs"   "-rollup"
		       "-remove-runs" "-lock"        "-unlock"
		       "-update-meta" "-extract-ods"))))
	(if (setup-for-run)
	    (let ((servers (open-run-close tasks:get-best-server tasks:open-db)))
	    (let loop ((servers  (open-run-close tasks:get-best-server tasks:open-db))
		       (trycount 0))
	      (if (or (not servers)
		      (null? servers))
		  (begin
		    (if (eq? trycount 0) ;; just do the server start once
			(begin
		    (debug:print 0 "INFO: Starting server as none running ...")
		    ;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
		    (system (conc (car (argv)) " -server - -daemonize -transport " (args:get-arg "-transport" "http")))
		    (thread-sleep! 3)) ;; give the server a few seconds to start
		  (debug:print 0 "INFO: Servers already running " servers)
			  (debug:print 0 "INFO: Starting server as none running ...")
			  ;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
			  ;; (process-run (car (argv)) (list "-server" "-" "-daemonize" "-transport" (args:get-arg "-transport" "http")))
			  (process-fork (lambda ()
					  (daemon:ize)
					  (server:launch (string->symbol (args:get-arg "-transport" "http")))))
			  (thread-sleep! 3))
			(debug:print-info 0 "Waiting for server to start"))
		    (loop (open-run-close tasks:get-best-server tasks:open-db) 
			  (+ trycount 1)))
		  (debug:print 0 "INFO: Server(s) running " servers)
		  )))))
	

(if (or (args:get-arg "-list-servers")
	(args:get-arg "-stop-server"))
    (let ((tl (setup-for-run)))
      (if tl 
	  (let* ((servers (open-run-close tasks:get-all-servers tasks:open-db))
		 (fmtstr  "~5a~8a~8a~20a~20a~10a~10a~10a~10a~10a\n")
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383
377
378
379
380
381
382
383

384

385
386
387
388
389
390
391







-
+
-







		 (if (equal? id sid)
		     (begin
		       (debug:print-info 0 "Attempting to stop server with pid " pid)
		       (tasks:kill-server status hostname pullport pid transport)))))
	     servers)
	    (debug:print-info 1 "Done with listservers")
	    (set! *didsomething* #t)
	    (exit) ;; must do, would have to add checks to many/all calls below
	    (exit)) ;; must do, would have to add checks to many/all calls below
	    )
	  (exit)))
    ;; if not list or kill then start a client (if appropriate)
    (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
	    (eq? (length (hash-table-keys args:arg-hash)) 0))
	(debug:print-info 1 "Server connection not needed")
	;; ok, so lets connect to the server
	(client:launch)))

Modified runs.scm from [6964d1aab5] to [8073ac3586].

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
252
253
254
255
256
257
258





























259












































260
261
262
263
264
265
266







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    ;; from here on out the db will be opened and closed on every call runs:run-tests-queue
    ;; (sqlite3:finalize! db) 
    ;; now add non-directly referenced dependencies (i.e. waiton)
    ;;======================================================================
    ;; refactoring this block into tests:get-full-data
    ;;======================================================================
    (if (not (null? test-names))
	(let loop ((hed (car test-names))
		   (tal (cdr test-names)))         ;; 'return-procs tells the config reader to prep running system but return a proc
	  (debug:print-info 4 "hed=" hed " at top of loop")
	  (let* ((config  (tests:get-testconfig hed 'return-procs))
		 (waitons (let ((instr (if config 
					   (config-lookup config "requirements" "waiton")
					   (begin ;; No config means this is a non-existant test
					     (debug:print 0 "ERROR: non-existent required test \"" hed "\"")
					     (if db (sqlite3:finalize! db))
					     (exit 1)))))
			    (debug:print-info 8 "waitons string is " instr)
			    (string-split (cond
					   ((procedure? instr)
					    (let ((res (instr)))
					      (debug:print-info 8 "waiton procedure results in string " res " for test " hed)
					      res))
					   ((string? instr)     instr)
					   (else 
					    ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " hed)
					    ""))))))
	    (debug:print-info 8 "waitons: " waitons)
	    ;; check for hed in waitons => this would be circular, remove it and issue an
	    ;; error
	    (if (member hed waitons)
		(begin
		  (debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!")
		  (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))))
	    
    (tests:get-full-data test-names test-records required-tests)
	    ;; (items   (items:get-items-from-config config)))
	    (if (not (hash-table-ref/default test-records hed #f))
		(hash-table-set! test-records
				 hed (vector hed     ;; 0
					     config  ;; 1
					     waitons ;; 2
					     (config-lookup config "requirements" "priority")     ;; priority 3
					     (let ((items      (hash-table-ref/default config "items" #f)) ;; items 4
						   (itemstable (hash-table-ref/default config "itemstable" #f))) 
					       ;; if either items or items table is a proc return it so test running
					       ;; process can know to call items:get-items-from-config
					       ;; if either is a list and none is a proc go ahead and call get-items
					       ;; otherwise return #f - this is not an iterated test
					       (cond
						((procedure? items)      
						 (debug:print-info 4 "items is a procedure, will calc later")
						 items)            ;; calc later
						((procedure? itemstable)
						 (debug:print-info 4 "itemstable is a procedure, will calc later")
						 itemstable)       ;; calc later
						((filter (lambda (x)
							   (let ((val (car x)))
							     (if (procedure? val) val #f)))
							 (append (if (list? items) items '())
								 (if (list? itemstable) itemstable '())))
						 'have-procedure)
						((or (list? items)(list? itemstable)) ;; calc now
						 (debug:print-info 4 "items and itemstable are lists, calc now\n"
							      "    items: " items " itemstable: " itemstable)
						 (items:get-items-from-config config))
						(else #f)))                           ;; not iterated
					     #f      ;; itemsdat 5
					     #f      ;; spare - used for item-path
					     )))
	    (for-each 
	     (lambda (waiton)
	       (if (and waiton (not (member waiton test-names)))
		   (begin
		     (set! required-tests (cons waiton required-tests))
		     (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
	     waitons)
	    (let ((remtests (delete-duplicates (append waitons tal))))
	      (if (not (null? remtests))
		  (loop (car remtests)(cdr remtests)))))))

    (if (not (null? required-tests))
	(debug:print-info 1 "Adding " required-tests " to the run queue"))
    ;; NOTE: these are all parent tests, items are not expanded yet.
    (debug:print-info 4 "test-records=" (hash-table->alist test-records))
    (runs:run-tests-queue run-id runname test-records keyvallst flags test-patts)
    (debug:print-info 4 "All done by here")))

Modified tests.scm from [628e641bd0] to [5623f426f2].

537
538
539
540
541
542
543
544

545
546

547
548
549
550
551
552
553
554
555
556





557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608





















































609
610
611
612
613
614
615
537
538
539
540
541
542
543

544


545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560




















































561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620







-
+
-
-
+










+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







      (let loop ((hed (car test-names))
		 (tal (cdr test-names)))         ;; 'return-procs tells the config reader to prep running system but return a proc
	(debug:print-info 4 "hed=" hed " at top of loop")
	(let* ((config  (tests:get-testconfig hed 'return-procs))
	       (waitons (let ((instr (if config 
					 (config-lookup config "requirements" "waiton")
					 (begin ;; No config means this is a non-existant test
					   (debug:print 0 "ERROR: non-existent required test \"" hed "\"")
					   (debug:print 0 "ERROR: non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.")
					   (if db (sqlite3:finalize! db))
					   (exit 1)))))
					     ""))))
			  (debug:print-info 8 "waitons string is " instr)
			  (string-split (cond
					 ((procedure? instr)
					  (let ((res (instr)))
					    (debug:print-info 8 "waiton procedure results in string " res " for test " hed)
					    res))
					 ((string? instr)     instr)
					 (else 
					  ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " hed)
					  ""))))))
	  (if (not config) ;; this is a non-existant test called in a waiton. 
	      (if (null? tal)
		  test-records
		  (loop (car tal)(cdr tal)))
	      (begin
	  (debug:print-info 8 "waitons: " waitons)
	  ;; check for hed in waitons => this would be circular, remove it and issue an
	  ;; error
	  (if (member hed waitons)
	      (begin
		(debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!")
		(set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))))
	  
	  ;; (items   (items:get-items-from-config config)))
	  (if (not (hash-table-ref/default test-records hed #f))
	      (hash-table-set! test-records
			       hed (vector hed     ;; 0
					   config  ;; 1
					   waitons ;; 2
					   (config-lookup config "requirements" "priority")     ;; priority 3
					   (let ((items      (hash-table-ref/default config "items" #f)) ;; items 4
						 (itemstable (hash-table-ref/default config "itemstable" #f))) 
					     ;; if either items or items table is a proc return it so test running
					     ;; process can know to call items:get-items-from-config
					     ;; if either is a list and none is a proc go ahead and call get-items
					     ;; otherwise return #f - this is not an iterated test
					     (cond
					      ((procedure? items)      
					       (debug:print-info 4 "items is a procedure, will calc later")
					       items)            ;; calc later
					      ((procedure? itemstable)
					       (debug:print-info 4 "itemstable is a procedure, will calc later")
					       itemstable)       ;; calc later
					      ((filter (lambda (x)
							 (let ((val (car x)))
							   (if (procedure? val) val #f)))
						       (append (if (list? items) items '())
							       (if (list? itemstable) itemstable '())))
					       'have-procedure)
					      ((or (list? items)(list? itemstable)) ;; calc now
					       (debug:print-info 4 "items and itemstable are lists, calc now\n"
								 "    items: " items " itemstable: " itemstable)
					       (items:get-items-from-config config))
					      (else #f)))                           ;; not iterated
					   #f      ;; itemsdat 5
					   #f      ;; spare - used for item-path
					   )))
	  (for-each 
	   (lambda (waiton)
	     (if (and waiton (not (member waiton test-names)))
		 (begin
		   (set! required-tests (cons waiton required-tests))
		   (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
	   waitons)
	  (let ((remtests (delete-duplicates (append waitons tal))))
	    (if (not (null? remtests))
		(loop (car remtests)(cdr remtests))))))))
		(debug:print-info 8 "waitons: " waitons)
		;; check for hed in waitons => this would be circular, remove it and issue an
		;; error
		(if (member hed waitons)
		    (begin
		      (debug:print 0 "ERROR: test " hed " has listed itself as a waiton, please correct this!")
		      (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))))
		
		;; (items   (items:get-items-from-config config)))
		(if (not (hash-table-ref/default test-records hed #f))
		    (hash-table-set! test-records
				     hed (vector hed     ;; 0
						 config  ;; 1
						 waitons ;; 2
						 (config-lookup config "requirements" "priority")     ;; priority 3
						 (let ((items      (hash-table-ref/default config "items" #f)) ;; items 4
						       (itemstable (hash-table-ref/default config "itemstable" #f))) 
						   ;; if either items or items table is a proc return it so test running
						   ;; process can know to call items:get-items-from-config
						   ;; if either is a list and none is a proc go ahead and call get-items
						   ;; otherwise return #f - this is not an iterated test
						   (cond
						    ((procedure? items)      
						     (debug:print-info 4 "items is a procedure, will calc later")
						     items)            ;; calc later
						    ((procedure? itemstable)
						     (debug:print-info 4 "itemstable is a procedure, will calc later")
						     itemstable)       ;; calc later
						    ((filter (lambda (x)
							       (let ((val (car x)))
								 (if (procedure? val) val #f)))
							     (append (if (list? items) items '())
								     (if (list? itemstable) itemstable '())))
						     'have-procedure)
						    ((or (list? items)(list? itemstable)) ;; calc now
						     (debug:print-info 4 "items and itemstable are lists, calc now\n"
								       "    items: " items " itemstable: " itemstable)
						     (items:get-items-from-config config))
						    (else #f)))                           ;; not iterated
						 #f      ;; itemsdat 5
						 #f      ;; spare - used for item-path
						 )))
		(for-each 
		 (lambda (waiton)
		   (if (and waiton (not (member waiton test-names)))
		       (begin
			 (set! required-tests (cons waiton required-tests))
			 (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
		 waitons)
		(let ((remtests (delete-duplicates (append waitons tal))))
		  (if (not (null? remtests))
		      (loop (car remtests)(cdr remtests))
		      test-records))))))))

;;======================================================================
;; test steps
;;======================================================================

;; teststep-set-status! used to be here