Megatest

Check-in [50ea23ff37]
Login
Overview
Comment:Added intra-test item waitons.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-intra-waiton
Files: files | file ages | folders
SHA1: 50ea23ff376618ba330117cf27c0d105f4e4e35b
User & Date: matt on 2019-01-27 00:15:37
Other Links: branch diff | manifest | tags
Context
2019-01-27
13:02
Some fixes for intra item waiton check-in: 542b913375 user: matt tags: v1.65-intra-waiton
00:15
Added intra-test item waitons. check-in: 50ea23ff37 user: matt tags: v1.65-intra-waiton
2019-01-25
13:28
changed prints to debug:print-info check-in: d26d705d6d user: pjhatwal tags: v1.65
Changes

Modified runs.scm from [18e897116f] to [2d1473d94b].

1
2
3
4
5
6
7
8

1
2
3
4
5
6
7
-








;; Copyright 2006-2016, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
528
529
530
531
532
533
534



535
536
537
538
539
540
541
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543







+
+
+







    (if (not (null? test-names)) ;; BEGIN test-names loop
	(let loop ((hed (car test-names))   ;; NOTE: This is the main loop that iterates over the test-names
		   (tal (cdr test-names)))         ;; 'return-procs tells the config reader to prep running system but return a proc
          (debug:print-info 4 *default-log-port* "\n\ntestpatt elaboration loop => hed="hed " tal="tal" test-patts="test-patts" test-names="test-names)
	  (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))

			;; NOTE: Have the config - can extract [waitons] section
			
                        ((hed-mode)
                         (let ((m (config-lookup config "requirements" "mode")))
                           (if m (map string->symbol (string-split m)) '(normal))))
                        ((hed-itemized-waiton) ;; are items in hed waiting on items of waiton?
                         (not (null? (lset-intersection eq? hed-mode '(itemmatch itemwait)))))
                        )
	    (debug:print-info 8 *default-log-port* "waitons: " waitons)
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406









1407
1408
1409
1410
1411
1412
1413
1396
1397
1398
1399
1400
1401
1402

1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423







-





+
+
+
+
+
+
+
+
+







      (let* ((test-record (hash-table-ref test-records hed))
	     (test-name   (tests:testqueue-get-testname test-record))
	     (tconfig     (tests:testqueue-get-testconfig test-record))
	     (jobgroup    (config-lookup tconfig "test_meta" "jobgroup"))
	     (testmode    (let ((m (config-lookup tconfig "requirements" "mode")))
			    (if m (map string->symbol (string-split m)) '(normal))))
	     (itemmaps    (tests:get-itemmaps tconfig)) ;;  (configf:lookup tconfig "requirements" "itemmap"))
	     (waitons     (tests:testqueue-get-waitons    test-record))
	     (priority    (tests:testqueue-get-priority   test-record))
	     (itemdat     (tests:testqueue-get-itemdat    test-record)) ;; itemdat can be a string, list or #f
	     (items       (tests:testqueue-get-items      test-record))
	     (item-path   (item-list->path itemdat))
	     (tfullname   (db:test-make-full-name test-name item-path))
	      ;; these are hard coded item-item waits test/item-path => test/item-path2 ...
	     (extra-waits (let* ((section (configf:get-section (tests:testqueue-get-testconfig test-record) "waitons"))
				 (myextra (alist-ref tfullname section equal?)))
			    (if myextra
				(begin
				  (debug:print 0 *default-log-port* "HAVE EXTRA WAITONS: " myextra)
				  (string-split (car myextra)))
				'())))
	     (waitons     (append (tests:testqueue-get-waitons    test-record) extra-waits))
	     (newtal      (append tal (list hed)))
	     (regfull     (>= (length reg) reglen))
	     (num-running (rmt:get-count-tests-running-for-run-id run-id))
	     (testdat     (make-runs:testdat
			   hed: hed
			   tal: tal
			   reg: reg