Megatest

Check-in [b961607e79]
Login
Overview
Comment:Merged in v1.60 and rebuilt manual
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b961607e7914ae19cf8a6f5f3f9891757a12271f
User & Date: matt on 2015-09-14 23:43:30
Other Links: manifest | tags
Context
2015-09-15
21:59
Merged v1.6024 to trunk check-in: 88c003ef10 user: matt tags: trunk
2015-09-14
23:43
Merged in v1.60 and rebuilt manual check-in: b961607e79 user: matt tags: trunk
23:34
Merged dashboard-test panel fix check-in: ddb66ac0f9 user: matt tags: v1.60
2015-09-12
00:31
Updated trunk for docs check-in: d0d5324095 user: matt tags: trunk
Changes

Modified Makefile from [1d989205bc] to [0976c16632].

154
155
156
157
158
159
160







161
162
163
164
165
166
167

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm








clean : 
	rm -f $(OFILES) $(GOFILES) megatest dboard dboard.o megatest.o dashboard.o

# Deploy section (not complete yet)
#
$(DEPLOYHELPERS) : utils/mt_*
	$(INSTALL) $< $@







>
>
>
>
>
>
>







154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

ext-tests/.fslckout : $(MTQA_FOSSIL)
	mkdir -p ext-tests
	cd ext-tests;fossil open --nested $(MTQA_FOSSIL)

$(MTQA_FOSSIL) :
	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)

clean : 
	rm -f $(OFILES) $(GOFILES) megatest dboard dboard.o megatest.o dashboard.o

# Deploy section (not complete yet)
#
$(DEPLOYHELPERS) : utils/mt_*
	$(INSTALL) $< $@

Modified common.scm from [ed7431fe23] to [9eb6e93365].

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
	best
	#f))) ;; #f means no disk candidate found

;;======================================================================
;; E N V I R O N M E N T   V A R S
;;======================================================================
	      
(define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR" "MAKEFLAGS" "MAKEF")))
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:,.\\/%$]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()
          (for-each (lambda (keyval)
		      (let* ((key   (car keyval))
			     (val   (cdr keyval))







|







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
	best
	#f))) ;; #f means no disk candidate found

;;======================================================================
;; E N V I R O N M E N T   V A R S
;;======================================================================
	      
(define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR" "MAKEFLAGS" "MAKEF" "MAKEOVERRIDES")))
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:,.\\/%$]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()
          (for-each (lambda (keyval)
		      (let* ((key   (car keyval))
			     (val   (cdr keyval))
709
710
711
712
713
714
715


























716
717
718
719
720
721
722
		      (set! res (cons (list var prv) res))
		      (if val 
			  (setenv var (->string val))
			  (unsetenv var))))
		  lst)
	res)
      '()))


























		  
;;======================================================================
;; time and date nice to have stuff
;;======================================================================

(define (seconds->hr-min-sec secs)
  (let* ((hrs (quotient secs 3600))







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
		      (set! res (cons (list var prv) res))
		      (if val 
			  (setenv var (->string val))
			  (unsetenv var))))
		  lst)
	res)
      '()))

;; clear vars matching pattern, run proc, set vars back
;; if proc is a string run that string as a command with
;; system.
;;
(define (common:without-vars proc . var-patts)
  (let ((vars (make-hash-table)))
    (for-each
     (lambda (vardat) ;; each env var
       (for-each
	(lambda (var-patt)
	  (if (string-match var-patt (car vardat))
	      (let ((var (car vardat))
		    (val (cdr vardat)))
		(hash-table-set! vars var val)
		(unsetenv var))))
	var-patts))
     (get-environment-variables))
    (cond
     ((string? proc)(system proc))
     (proc          (proc)))
    (hash-table-for-each
     vars
     (lambda (var val)
       (setenv var val)))
    vars))
		  
;;======================================================================
;; time and date nice to have stuff
;;======================================================================

(define (seconds->hr-min-sec secs)
  (let* ((hrs (quotient secs 3600))

Modified dashboard-tests.scm from [9666ae3621] to [c3aeea831f].

488
489
490
491
492
493
494

495
496

497
498
499
500
501
502
503
				   (dashboard-tests:run-html-viewer lfilename)
				   (message-window (conc "File " lfilename " not found"))))))
	       (xterm      (lambda (x)
			     (if (directory-exists? rundir)
				 (let ((shell (if (get-environment-variable "SHELL") 
						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))

				   (system (conc "cd " rundir 
						 ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))

				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (file-modification-time db-path))
				                   ;;     (max ..... (if (file-exists? testdat-path)
						   ;;      	      (file-modification-time testdat-path)
						   ;;      	      (begin







>
|
|
>







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
				   (dashboard-tests:run-html-viewer lfilename)
				   (message-window (conc "File " lfilename " not found"))))))
	       (xterm      (lambda (x)
			     (if (directory-exists? rundir)
				 (let ((shell (if (get-environment-variable "SHELL") 
						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))
				   (common:without-vars
				    (conc "cd " rundir 
					  ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")
				    "MT_.*"))
				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (file-modification-time db-path))
				                   ;;     (max ..... (if (file-exists? testdat-path)
						   ;;      	      (file-modification-time testdat-path)
						   ;;      	      (begin
570
571
572
573
574
575
576







577







578


579
580
581
582
583
584
585
586
587
588
589
590
591
						       (begin
					;(mutex-lock! mx1)
							 (iup:attribute-set! lbl "TITLE" newval)
					;(mutex-unlock! mx1)
							 )))))
			      lbl))
	       (store-button store-label)







	       (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10"))







	       (command-launch-button (iup:button "Execute!" #:action (lambda (x)


									(let* ((cmd     (iup:attribute command-text-box "VALUE"))
									       (fullcmd (conc (dtests:get-pre-command)
											      cmd 
											      (dtests:get-post-command))))
									  (debug:print-info 02 "Running command: " fullcmd)
									  (system fullcmd)))))
	       (kill-jobs (lambda (x)
			    (iup:attribute-set! 
			     command-text-box "VALUE"
			     (conc "megatest -target " keystring " -runname "  runname 
				   " -set-state-status KILLREQ,n/a -testpatt %/% "
				   " -state RUNNING"))))
	       (run-test  (lambda (x)







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

>
>
|
|
|
|
|
|







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
						       (begin
					;(mutex-lock! mx1)
							 (iup:attribute-set! lbl "TITLE" newval)
					;(mutex-unlock! mx1)
							 )))))
			      lbl))
	       (store-button store-label)
	       (command-proc (lambda (command-text-box)
			       (let* ((cmd     (iup:attribute command-text-box "VALUE"))
				      (fullcmd (conc (dtests:get-pre-command)
						     cmd 
						     (dtests:get-post-command))))
				 (debug:print-info 02 "Running command: " fullcmd)
				 (common:without-vars fullcmd "MT_.*"))))
	       (command-text-box (iup:textbox
				  #:expand "HORIZONTAL"
				  #:font "Courier New, -10"
				  #:action (lambda (obj cnum val)
					     ;; (print "cnum=" cnum)
					     (if (eq? cnum 13)
						 (command-prox obj)))
				  ))
	       (command-launch-button (iup:button "Execute!" #:action (lambda (x)
									(command-proc command-text-box))))
	;; (lambda (x)
	;; 								(let* ((cmd     (iup:attribute command-text-box "VALUE"))
	;; 								       (fullcmd (conc (dtests:get-pre-command)
	;; 										      cmd 
	;; 										      (dtests:get-post-command))))
	;; 								  (debug:print-info 02 "Running command: " fullcmd)
	;; 								  (common:without-vars fullcmd "MT_.*")))))
	       (kill-jobs (lambda (x)
			    (iup:attribute-set! 
			     command-text-box "VALUE"
			     (conc "megatest -target " keystring " -runname "  runname 
				   " -set-state-status KILLREQ,n/a -testpatt %/% "
				   " -state RUNNING"))))
	       (run-test  (lambda (x)
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

617
618
619

620
621
622
623
624
625
626
			       command-text-box "VALUE"
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v"))))
	       (clean-run-execute  (lambda (x)
				     (let ((cmd (conc "bmegatest -remove-runs -target " keystring " -runname " runname
						      " -testpatt " (conc testname "/" (if (equal? item-path "")
											   "%"
											   item-path))
						      ";megatest -target " keystring " -runname " runname 
						      " -runtests " (conc testname "/" (if (equal? item-path "")
											   "%" 
											   item-path))
						      )))

				       (system (conc (dtests:get-pre-command)
						     cmd 
						     (dtests:get-post-command))))))

	       (remove-test (lambda (x)
			      (iup:attribute-set!
			       command-text-box "VALUE"
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))







|

|
|

|



>
|
|
|
>







619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
			       command-text-box "VALUE"
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v"))))
	       (clean-run-execute  (lambda (x)
				     (let ((cmd (conc "megatest -remove-runs -target " keystring " -runname " runname
						      " -testpatt " (conc testname "/" (if (equal? item-path "")
						       					   "%"
						       					   item-path))
						      ";megatest -target " keystring " -runname " runname 
						      " -run -preclean -testpatt " (conc testname "/" (if (equal? item-path "")
											   "%" 
											   item-path))
						      )))
				       (common:without-vars
					(conc (dtests:get-pre-command)
					      cmd 
					      (dtests:get-post-command))
					"MT_.*"))))
	       (remove-test (lambda (x)
			      (iup:attribute-set!
			       command-text-box "VALUE"
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))

Modified db.scm from [5bb794bf74] to [eb4ce6c48f].

3266
3267
3268
3269
3270
3271
3272


3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
;;======================================================================
;; M I S C   M A N A G E M E N T   I T E M S 
;;======================================================================

;; A routine to map itempaths using a itemmap
;; patha and pathb must be strings or this will fail
;;


(define (db:compare-itempaths patha pathb itemmaps)
  (debug:print-info 6 "ITEMMAPS: " itemmaps)
  (let* ((testname-a (car (string-split patha "/")))
	 (itemmap    (tests:lookup-itemmap itemmaps testname-a)))
    (if itemmap
	(let ((pathb-mapped (db:multi-pattern-apply pathb itemmap)))
	  (debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " pathb-mapped)
	  (equal? patha pathb-mapped))
	(equal? patha pathb))))

;; A routine to convert test/itempath using a itemmap
;; NOTE: to process only an itempath (i.e. no prepended testname)
;;       just call db:multi-pattern-apply
;;
(define (db:convert-test-itempath path-in itemmap)
  (debug:print-info 6 "ITEMMAP is " itemmap)







>
>
|

<
|

|
|
|
|







3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
;;======================================================================
;; M I S C   M A N A G E M E N T   I T E M S 
;;======================================================================

;; A routine to map itempaths using a itemmap
;; patha and pathb must be strings or this will fail
;;
;; path-b is waiting on path-a
;;
(define (db:compare-itempaths test-b-name path-a path-b itemmaps )
  (debug:print-info 6 "ITEMMAPS: " itemmaps)

  (let* ((itemmap    (tests:lookup-itemmap itemmaps test-b-name)))
    (if itemmap
	(let ((path-b-mapped (db:multi-pattern-apply path-b itemmap)))
	  (debug:print-info 6 "ITEMMAP is " itemmap ", path: " path-b ", mapped path: " path-b-mapped)
	  (equal? path-a path-b-mapped))
	(equal? path-b path-a))))

;; A routine to convert test/itempath using a itemmap
;; NOTE: to process only an itempath (i.e. no prepended testname)
;;       just call db:multi-pattern-apply
;;
(define (db:convert-test-itempath path-in itemmap)
  (debug:print-info 6 "ITEMMAP is " itemmap)
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)







|







3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-test-name ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)
3347
3348
3349
3350
3351
3352
3353

3354
3355
3356
3357
3358
3359
3360
3361
		(let* ((state             (db:test-get-state test))
		       (status            (db:test-get-status test))
		       (item-path         (db:test-get-item-path test))
		       (is-completed      (equal? state "COMPLETED"))
		       (is-running        (equal? state "RUNNING"))
		       (is-killed         (equal? state "KILLED"))
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))

		       (same-itempath     (db:compare-itempaths item-path ref-item-path itemmaps))) ;; (equal? ref-item-path item-path)))
		  (set! ever-seen #t)
		  (cond
		   ;; case 1, non-item (parent test) is 
		   ((and (equal? item-path "") ;; this is the parent test of the waiton being examined
			 is-completed
			 (or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;;  itemmatch itemwait))))))
		    (set! parent-waiton-met #t))







>
|







3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
		(let* ((state             (db:test-get-state test))
		       (status            (db:test-get-status test))
		       (item-path         (db:test-get-item-path test))
		       (is-completed      (equal? state "COMPLETED"))
		       (is-running        (equal? state "RUNNING"))
		       (is-killed         (equal? state "KILLED"))
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
		       ;;                                       testname-b    path-a    path-b
		       (same-itempath     (db:compare-itempaths ref-test-name item-path ref-item-path itemmaps))) ;; (equal? ref-item-path item-path)))
		  (set! ever-seen #t)
		  (cond
		   ;; case 1, non-item (parent test) is 
		   ((and (equal? item-path "") ;; this is the parent test of the waiton being examined
			 is-completed
			 (or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;;  itemmatch itemwait))))))
		    (set! parent-waiton-met #t))

Modified docs/manual/megatest_manual.html from [56893fab94] to [0577937b3e].

1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317


1318


1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329


1330
1331
1332
1333
1334
1335
1336
1337
1338

1339

1340

1341
1342
1343
1344

1345
1346



1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369

1370

1371



1372
1373
1374
1375
1376
1377
1378
<div class="title">Testconfig for Test C</div>
<div class="content monospaced">
<pre>[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb bb/\1</pre>
</div></div>
<div class="listingblock">
<div class="title">Testconfig for Test D</div>
<div class="content monospaced">
<pre>[requirements]
waiton C
itemmap (\d+)/res \1/aa</pre>
</div></div>
<div class="listingblock">
<div class="title">Testconfig for Test E</div>
<div class="content monospaced">
<pre>[requirements]
waiton C
itemmap (\d+)/res \1/bb</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_dynamic_flow_dependency_tree">Dynamic Flow Dependency Tree</h4>

<div class="listingblock">
<div class="title">Autogeneration waiton list for dynamic flow dependency trees</div>
<div class="content monospaced">


<pre>[requirements]


# With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
# waiton #{shell get-valid-tests-to-run.sh}</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_run_time_limit_2">Run time limit</h4>
<div class="listingblock">
<div class="content monospaced">
<pre>runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s</pre>


</div></div>
</div>
<div class="sect3">
<h4 id="_skip">Skip</h4>
<div class="paragraph"><p>A test with a skip section will conditional skip running.</p></div>
<div class="listingblock">
<div class="title">Skip section example</div>
<div class="content monospaced">
<pre>[skip]

prevrunning x

# rundelay 30m 15s</pre>

</div></div>
</div>
<div class="sect3">
<h4 id="_skip_on_still_running_tests">Skip on Still-running Tests</h4>

<div class="listingblock">
<div class="content monospaced">



<pre># NB// If the prevrunning line exists with *any* value the test will
# automatically SKIP if the same-named test is currently RUNNING. The
# "x" can be any string. Comment out the prevrunning line to turn off
# skip.

[skip]
prevrunning x</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_skip_if_a_file_exists">Skip if a File Exists</h4>
<div class="listingblock">
<div class="content monospaced">
<pre>[skip]
fileexists /path/to/a/file # skip if /path/to/a/file exists</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_skip_if_test_ran_more_recently_than_specified_time">Skip if test ran more recently than specified time</h4>
<div class="listingblock">
<div class="title">Skip if this test has been run in the past fifteen minutes and 15 seconds.</div>
<div class="content monospaced">
<pre>[skip]

rundelay 15m 15s</pre>

</div></div>



</div>
<div class="sect3">
<h4 id="_disks">Disks</h4>
<div class="paragraph"><p>A disks section in testconfig will override the disks section in
megatest.config. This can be used to allocate disks on a per-test or per item
basis.</p></div>
</div>







|
|
<
|
|
<
|
|
<

<

|
<
<

<
|
<
>

<

>
>
|
>
>
|


|
<
<
<
<


<
>
>

<
|
<
<

<

|
>
|
>
|
>

<
|
<
>


>
>
>
|


|
<
<
<
<
<
|
<


|
|

<
|
<

<

|
>
|
>

>
>
>







1289
1290
1291
1292
1293
1294
1295
1296
1297

1298
1299

1300
1301

1302

1303
1304


1305

1306

1307
1308

1309
1310
1311
1312
1313
1314
1315
1316
1317
1318




1319
1320

1321
1322
1323

1324


1325

1326
1327
1328
1329
1330
1331
1332
1333

1334

1335
1336
1337
1338
1339
1340
1341
1342
1343
1344





1345

1346
1347
1348
1349
1350

1351

1352

1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
<div class="title">Testconfig for Test C</div>
<div class="content monospaced">
<pre>[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb --------------------


.Testconfig for Test D</pre>
</div></div>

<div class="paragraph"><p>waiton C
itemmap (\d+)/res \1/aa</p></div>

<div class="listingblock">

<div class="content monospaced">
<pre>.Testconfig for Test E</pre>


</div></div>

<div class="paragraph"><p>waiton C

itemmap (\d+)/res \1/bb</p></div>
<div class="listingblock">

<div class="content monospaced">
<pre>Dynamic Flow Dependency Tree
^^^^^^^^^^^^^^^^^^^^^^^^^^^^

.Autogeneration waiton list for dynamic flow dependency trees</pre>
</div></div>
<div class="paragraph"><p># With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
waiton #{shell get-valid-tests-to-run.sh}</p></div>




<div class="listingblock">
<div class="content monospaced">

<pre>Run time limit
^^^^^^^^^^^^^^</pre>
</div></div>

<div class="paragraph"><p>runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s</p></div>


<div class="listingblock">

<div class="content monospaced">
<pre>Skip
^^^^

A test with a skip section will conditional skip running.

.Skip section example</pre>
</div></div>

<div class="paragraph"><p>prevrunning x

# rundelay 30m 15s</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>Skip on Still-running Tests
^^^^^^^^^^^^^^^^^^^^^^^^^^^</pre>
</div></div>
<div class="paragraph"><p># NB// If the prevrunning line exists with <strong>any</strong> value the test will
# automatically SKIP if the same-named test is currently RUNNING. The
# "x" can be any string. Comment out the prevrunning line to turn off
# skip.</p></div>





<div class="paragraph"><p>prevrunning x</p></div>

<div class="listingblock">
<div class="content monospaced">
<pre>Skip if a File Exists
^^^^^^^^^^^^^^^^^^^^^</pre>
</div></div>

<div class="paragraph"><p>fileexists /path/to/a/file # skip if /path/to/a/file exists</p></div>

<div class="listingblock">

<div class="content monospaced">
<pre>Skip if test ran more recently than specified time
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

.Skip if this test has been run in the past fifteen minutes and 15 seconds.</pre>
</div></div>
</div>
</div>
</div>
</div>
<div class="sect3">
<h4 id="_disks">Disks</h4>
<div class="paragraph"><p>A disks section in testconfig will override the disks section in
megatest.config. This can be used to allocate disks on a per-test or per item
basis.</p></div>
</div>
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409

# This builtin rule is the default if there is no &lt;waivername&gt;.logpro file
# diff   diff %file1% %file2%

# This builtin rule is applied if a &lt;waivername&gt;.logpro file exists
# logpro diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html</pre>
</div></div>
</div>
</div>
<div class="sect2">
<h3 id="_ezsteps">Ezsteps</h3>
<div class="listingblock">
<div class="title">Example ezsteps with logpro rules</div>
<div class="content monospaced">
<pre>[ezsteps]







<







1385
1386
1387
1388
1389
1390
1391

1392
1393
1394
1395
1396
1397
1398

# This builtin rule is the default if there is no &lt;waivername&gt;.logpro file
# diff   diff %file1% %file2%

# This builtin rule is applied if a &lt;waivername&gt;.logpro file exists
# logpro diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html</pre>
</div></div>

</div>
<div class="sect2">
<h3 id="_ezsteps">Ezsteps</h3>
<div class="listingblock">
<div class="title">Example ezsteps with logpro rules</div>
<div class="content monospaced">
<pre>[ezsteps]
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
<div class="listingblock">
<div class="title">For test "runfirst" override the toplevel generation with a script "mysummary.sh"</div>
<div class="content monospaced">
<pre># Override the rollup for specific tests
[testrollup]
runfirst mysummary.sh</pre>
</div></div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_archiving_setup">Archiving Setup</h2>
<div class="sectionbody">
<div class="paragraph"><p>In megatest.config add the following sections:</p></div>
<div class="listingblock">
<div class="title">megatest.config</div>







<
<







1450
1451
1452
1453
1454
1455
1456


1457
1458
1459
1460
1461
1462
1463
<div class="listingblock">
<div class="title">For test "runfirst" override the toplevel generation with a script "mysummary.sh"</div>
<div class="content monospaced">
<pre># Override the rollup for specific tests
[testrollup]
runfirst mysummary.sh</pre>
</div></div>


</div>
<div class="sect1">
<h2 id="_archiving_setup">Archiving Setup</h2>
<div class="sectionbody">
<div class="paragraph"><p>In megatest.config add the following sections:</p></div>
<div class="listingblock">
<div class="title">megatest.config</div>

Modified docs/manual/reference.txt from [ae56b797b4] to [88bde1cc13].

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
.Testconfig for Test C
----------------------
[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb bb/\1
----------------------

.Testconfig for Test D
----------------------
[requirements]
waiton C
itemmap (\d+)/res \1/aa
----------------------







<
|







184
185
186
187
188
189
190

191
192
193
194
195
196
197
198
.Testconfig for Test C
----------------------
[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1

B (\d+)/bb --------------------

.Testconfig for Test D
----------------------
[requirements]
waiton C
itemmap (\d+)/res \1/aa
----------------------
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230

.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]
# With a toplevel test you may wish to generate your list 
# of tests to run dynamically
#
# waiton #{shell get-valid-tests-to-run.sh}
-------------------

Run time limit
^^^^^^^^^^^^^^

-----------------

runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s
-----------------

Skip
^^^^

A test with a skip section will conditional skip running.







|






>







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]
# With a toplevel test you may wish to generate your list 
# of tests to run dynamically
#
waiton #{shell get-valid-tests-to-run.sh}
-------------------

Run time limit
^^^^^^^^^^^^^^

-----------------
[requirements]
runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s
-----------------

Skip
^^^^

A test with a skip section will conditional skip running.

Modified rmt.scm from [7c256785ed] to [58033889c8].

502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname)))
	   run-ids))))

;; (define (rmt:get-run-ids-matching keynames target res)
;;   (rmt:send-receive #f 'get-run-ids-matching (list keynames target res)))

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmaps #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmaps)))

(define (rmt:get-count-tests-running-for-run-id run-id)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id)))

;; Statistical queries

(define (rmt:get-count-tests-running run-id)







|
|







502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname)))
	   run-ids))))

;; (define (rmt:get-run-ids-matching keynames target res)
;;   (rmt:send-receive #f 'get-run-ids-matching (list keynames target res)))

(define (rmt:get-prereqs-not-met run-id waitons ref-test-name ref-item-path #!key (mode '(normal))(itemmaps #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-test-name ref-item-path mode itemmaps)))

(define (rmt:get-count-tests-running-for-run-id run-id)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id)))

;; Statistical queries

(define (rmt:get-count-tests-running run-id)

Modified runs.scm from [e714363b54] to [93791638c8].

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380

381
382
383
384

385
386
387
388
389
390
391
    ;;======================================================================
    
    (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
	  (change-directory *toppath*) ;; PLEASE OPTIMIZE ME!!! I think this should be a no-op but there are several places where change-directories could be happening.
	  (setenv "MT_TEST_NAME" hed) ;; 
	  (let* ((config  (tests:get-testconfig hed all-tests-registry '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 "\"")
					     (exit 1)))))
			    (debug:print-info 8 "waitons string is " instr)
			    (let ((newwaitons
				   (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)
						   "")))))
			      (filter (lambda (x)
					(if (hash-table-ref/default all-tests-registry x #f)
					    #t
					    (begin
					      (debug:print 0 "ERROR: test " hed " has unrecognised waiton testname " x)
					      #f)))
				      newwaitons)))))
	    (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







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<



>
|

|
|
>







347
348
349
350
351
352
353
354























355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
    ;;======================================================================
    
    (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
	  (change-directory *toppath*) ;; PLEASE OPTIMIZE ME!!! I think this should be a no-op but there are several places where change-directories could be happening.
	  (setenv "MT_TEST_NAME" hed) ;; 
	  (let*-values (((waitons waitors config)(tests:get-waitons hed all-tests-registry)))























	    (debug:print-info 8 "waitons: " waitons)
	    ;; check for hed in waitons => this would be circular, remove it and issue an
	    ;; error
	    (if (or (member hed waitons)
		    (member hed waitors))
		(begin
		  (debug:print 0 "ERROR: test " hed " has listed itself as a waiton or waitor, please correct this!")
		  (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))
		  (set! waitors (filter (lambda (x)(not (equal? x hed))) waitors))))
	    
	    ;; (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
412
413
414
415
416
417
418

419
420
421
422
423
424
425
						((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)))
		   (let* ((waiton-record   (hash-table-ref/default test-records waiton #f))
			  (waiton-tconfig  (if waiton-record (vector-ref waiton-record 1) #f))
			  (waiton-itemized (and waiton-tconfig







>







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
						((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
					     waitors ;; 
					     )))
	    (for-each 
	     (lambda (waiton)
	       (if (and waiton (not (member waiton test-names)))
		   (let* ((waiton-record   (hash-table-ref/default test-records waiton #f))
			  (waiton-tconfig  (if waiton-record (vector-ref waiton-record 1) #f))
			  (waiton-itemized (and waiton-tconfig
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
			 
		     ;; NOPE: didn't work. required needs to be plain test names. Try tacking on to test-patts
		     ;;  - doesn't work
		     ;; (set! test-patts (conc test-patts "," waiton "/"))
		     
		     ;; (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))
		  (begin
		    ;; (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
		    (loop (car remtests)(cdr remtests))))))))

    (if (not (null? required-tests))







|







437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
			 
		     ;; NOPE: didn't work. required needs to be plain test names. Try tacking on to test-patts
		     ;;  - doesn't work
		     ;; (set! test-patts (conc test-patts "," waiton "/"))
		     
		     ;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
		     )))
	     (delete-duplicates (append waitons waitors)))
	    (let ((remtests (delete-duplicates (append waitons tal))))
	      (if (not (null? remtests))
		  (begin
		    ;; (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
		    (loop (car remtests)(cdr remtests))))))))

    (if (not (null? required-tests))
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
	  '()
	  reg)))

(define runs:nothing-left-in-queue-count 0)

(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps)
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmaps: itemmaps))
	 ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more







|







539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
	  '()
	  reg)))

(define runs:nothing-left-in-queue-count 0)

(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps)
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))
	 ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmaps)
  (let* ((run-limits-info         (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2)) 
	 (max-concurrent-jobs     (list-ref run-limits-info 3))
	 (job-group-limit         (list-ref run-limits-info 4))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmaps: itemmaps))
	 ;; (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails                   (runs:calc-fails prereqs-not-met))
	 (non-completed           (filter (lambda (x)             ;; remove hed from not completed list, duh, of course it is not completed!
					    (not (equal? x hed)))
					  (runs:calc-not-completed prereqs-not-met)))
	 (loop-list               (list hed tal reg reruns))
	 ;; configure the load runner







|







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmaps)
  (let* ((run-limits-info         (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2)) 
	 (max-concurrent-jobs     (list-ref run-limits-info 3))
	 (job-group-limit         (list-ref run-limits-info 4))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))
	 ;; (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails                   (runs:calc-fails prereqs-not-met))
	 (non-completed           (filter (lambda (x)             ;; remove hed from not completed list, duh, of course it is not completed!
					    (not (equal? x hed)))
					  (runs:calc-not-completed prereqs-not-met)))
	 (loop-list               (list hed tal reg reruns))
	 ;; configure the load runner

Added supplemental.megatest.config version [5180103602].







>
>
>
1
2
3
[tests-paths]
nada #{getenv MT_RUN_AREA_HOME}/moretests

Modified tests.scm from [4e99e09e2a] to [d77069491a].

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103







104



















































105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
;; #       itemmap entry in requirements (legacy). The itemmap
;; #       requirements entry is deprecated
;;
(define (tests:get-itemmaps tconfig)
  (let ((base-itemmap  (configf:lookup tconfig "requirements" "itemmap"))
	(itemmap-table (configf:get-section tconfig "itemmap")))
    (append (if base-itemmap
		(list (cons "%" base-itemmap))
		'())
	    (if itemmap-table
		itemmap-table
		'()))))

;; given a list of itemmaps (testname . map), return the first match
;;
(define (tests:lookup-itemmap itemmaps testname)
  (let ((best-matches (filter (lambda (itemmap)
				(tests:match (car itemmap) testname))
			      itemmaps)))
    (if (null? best-matches)
	#f
	(car best-matches))))







					     



















































;; given test-b that is waiting on test-a extend test-patt appropriately
;;
;;  genlib/testconfig               sim/testconfig
;;  genlib/sch                      sim/sch/cell1
;;
;;  [requirements]                  [requirements]
;;                                  mode itemwait
;;                                  # trim off the cell to determine what to run for genlib
;;                                  itemmap /.*
;;
;;                                  test-a is waiting on test-b so we need to create a pattern for test-b given test-a and itemmap
(define (tests:extend-test-patts test-patt test-b test-a itemmaps)
  (let* ((itemmap    (tests:lookup-itemmap itemmaps test-b))
	 (patts      (string-split test-patt ","))
	 (test-b-len (+ (string-length test-b) 1))
	 (patts-b    (map (lambda (x)
			    (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
				   (newpatt (conc test-a "/" (substring modpatt test-b-len (string-length modpatt)))))
				         ;; (conc test-a "/," test-a "/" (substring modpatt test-b-len (string-length modpatt)))))
			      ;; (print "in map, x=" x ", newpatt=" newpatt)
			      newpatt))
			  (filter (lambda (x)
				    (eq? (substring-index (conc test-b "/") x) 0))
				  patts))))
    (string-intersperse (delete-duplicates (append patts (if (null? patts-b)
							     (list (conc test-a "/%"))
							     patts-b)))
			",")))
  
;; tests:glob-like-match 
(define (tests:glob-like-match patt str) 
  (let ((like (substring-index "%" patt)))
    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
	   (newpatt  (if notpatt (substring patt 1) patt))







|









|



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









|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
;; #       itemmap entry in requirements (legacy). The itemmap
;; #       requirements entry is deprecated
;;
(define (tests:get-itemmaps tconfig)
  (let ((base-itemmap  (configf:lookup tconfig "requirements" "itemmap"))
	(itemmap-table (configf:get-section tconfig "itemmap")))
    (append (if base-itemmap
		(list (list "%" base-itemmap))
		'())
	    (if itemmap-table
		itemmap-table
		'()))))

;; given a list of itemmaps (testname . map), return the first match
;;
(define (tests:lookup-itemmap itemmaps testname)
  (let ((best-matches (filter (lambda (itemmap)
				(tests:match (car itemmap) testname #f))
			      itemmaps)))
    (if (null? best-matches)
	#f
	(let ((res (car best-matches)))
	  (debug:print 0 "res=" res)
	  (cond
	   ((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
	   ((null? res)   #f)
	   ((string? (cdr res)) (cdr res))  ;; it is a pair
	   ((string? (cadr res))(cadr res)) ;; it is a list
	   (else cadr res))))))

;; returns waitons waitors tconfigdat
;;
(define (tests:get-waitons test-name all-tests-registry)
   (let* ((config  (tests:get-testconfig test-name all-tests-registry 'return-procs)))
     (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 \"" test-name "\"")
			(exit 1))))
	   (instr2 (if config
		       (config-lookup config "requirements" "waitor")
		       "")))
       (debug:print-info 8 "waitons string is " instr ", waitors string is " instr2)
       (let ((newwaitons
	      (string-split (cond
			     ((procedure? instr)
			      (let ((res (instr)))
				(debug:print-info 8 "waiton procedure results in string " res " for test " test-name)
				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 " test-name)
			      ""))))
	     (newwaitors
	      (string-split (cond
			     ((procedure? instr2)
			      (let ((res (instr2)))
				(debug:print-info 8 "waitor procedure results in string " res " for test " test-name)
				res))
			     ((string? instr2)     instr2)
			     (else 
			      ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " test-name)
			      "")))))
	 (values
	  ;; the waitons
	  (filter (lambda (x)
		    (if (hash-table-ref/default all-tests-registry x #f)
			#t
			(begin
			  (debug:print 0 "ERROR: test " test-name " has unrecognised waiton testname " x)
			  #f)))
		  newwaitons)
	  (filter (lambda (x)
		    (if (hash-table-ref/default all-tests-registry x #f)
			#t
			(begin
			  (debug:print 0 "ERROR: test " test-name " has unrecognised waiton testname " x)
			  #f)))
		  newwaitors)
	  config)))))
					     
;; given waiting-test that is waiting on waiton-test extend test-patt appropriately
;;
;;  genlib/testconfig               sim/testconfig
;;  genlib/sch                      sim/sch/cell1
;;
;;  [requirements]                  [requirements]
;;                                  mode itemwait
;;                                  # trim off the cell to determine what to run for genlib
;;                                  itemmap /.*
;;
;;                                  waiting-test is waiting on waiton-test so we need to create a pattern for waiton-test given waiting-test and itemmap
(define (tests:extend-test-patts test-patt waiting-test waiton-test itemmaps)
  (let* ((itemmap          (tests:lookup-itemmap itemmaps waiton-test))
	 (patts            (string-split test-patt ","))
	 (waiting-test-len (+ (string-length waiting-test) 1))
	 (patts-waiton     (map (lambda (x)  ;; for each incoming patt that matches the waiting test
				  (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
					 (newpatt (conc waiton-test "/" (substring modpatt waiting-test-len (string-length modpatt)))))
				    ;; (conc waiting-test "/," waiting-test "/" (substring modpatt waiton-test-len (string-length modpatt)))))
				    ;; (print "in map, x=" x ", newpatt=" newpatt)
				    newpatt))
				(filter (lambda (x)
					  (eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
					patts))))
    (string-intersperse (delete-duplicates (append patts (if (null? patts-waiton)
							     (list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
							     patts-waiton)))
			",")))
  
;; tests:glob-like-match 
(define (tests:glob-like-match patt str) 
  (let ((like (substring-index "%" patt)))
    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
	   (newpatt  (if notpatt (substring patt 1) patt))

Modified tests/tests.scm from [9d9074d93d] to [8b81d25a98].

8
9
10
11
12
13
14


15
16
17
18
19
20
21
;;  PURPOSE.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(require-extension test)
(require-extension regex)
(require-extension srfi-18)


(import srfi-18)
;; (require-extension zmq)
;; (import zmq)

(define test-work-dir (current-directory))

;; read in all the _record files







>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
;;  PURPOSE.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(require-extension test)
(require-extension regex)
(require-extension srfi-18)
(require-extension posix)
(import posix)
(import srfi-18)
;; (require-extension zmq)
;; (import zmq)

(define test-work-dir (current-directory))

;; read in all the _record files