Megatest

Check-in [8b8b1f63e7]
Login
Overview
Comment:made missing waiton detection messages more useful
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 8b8b1f63e751a8e106b70975aea874b099e62941
User & Date: mmgraham on 2022-01-07 12:10:34
Other Links: branch diff | manifest | tags
Context
2022-02-04
15:58
added setting of MT_CMDINFO in launch-test check-in: 8fb8c24288 user: mmgraham tags: v1.65
2022-01-07
12:10
made missing waiton detection messages more useful check-in: 8b8b1f63e7 user: mmgraham tags: v1.65
2021-10-21
13:15
Updated megatest version to 1.6588 check-in: a853e6c483 user: mmgraham tags: v1.65, v1.6588
Changes

Modified tests.scm from [58a365a2ab] to [718cc2994f].

51
52
53
54
55
56
57

58
59
60
61
62
63
64
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65







+








;; Call this one to do all the work and get a standardized list of tests
;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
    (debug:print 8 *default-log-port* "test-search-path: " test-search-path)
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat)
  (let ((paths (let ((section (if cfgdat
				  (configf:get-section cfgdat "tests-paths")
				  #f)))
		 (if section
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1620







-
+







                                       #f)
                                      (
                                       (and wait-a-minute (> tries-left 0))
                                       (thread-sleep! 10)
                                       (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf" will retry in 10 seconds.  Tries left: "tries-left) ;; BB: this fires
                                       (loopa (sub1 tries-left)))
                                      (else
                                       (debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
                                       (debug:print 2 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
                                       #f))))
		     (tcfg         (if testexists
				       (read-config test-configf #f system-allowed
						    environ-patt: (if system-allowed
								      "pre-launch-env-vars"
								      #f))
				       #f)))
1840
1841
1842
1843
1844
1845
1846

1847

1848
1849
1850
1851
1852
1853
1854
1855
1856
1857















1858
1859
1860
1861
1862
1863
1864
1865
1866

1867
1868
1869
1870
1871
1872
1873
1841
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
1856



1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879

1880
1881
1882
1883
1884
1885
1886
1887







+
-
+







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








-
+








;;======================================================================
;; refactoring this block into tests:get-full-data from line 263 of runs.scm
;;======================================================================
;; hed is the test name
;; test-records is a hash of test-name => test record
(define (tests:get-full-data test-names test-records required-tests all-tests-registry)
  (let ((missing-waitons (make-hash-table)))
  (if (not (null? test-names))
    (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 *default-log-port* "hed=" hed " at top of loop")
        ;; don't know item-path at this time, let the testconfig get the top level testconfig
	(let* ((config  (tests:get-testconfig hed #f all-tests-registry 'return-procs))
	       (waitons (let ((instr (if config 
					 (configf:lookup config "requirements" "waiton")
					 (begin ;; No config means this is a non-existant test
					   (debug:print-error 0 *default-log-port* "non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.")
					     ""))))
					 (begin ;; No config means this is a non-existent test
                                           (let ((waiters '()))
                                             ;; find the waiter(s) for this waiton.
                                             (for-each 
                                               (lambda(waiter)
                                                 ;; (print "test-record = " (hash-table-ref test-records waiter))
                                                 ;; (print "waitons = " (vector-ref (hash-table-ref test-records waiter) 2))
                                                 (if (member hed (vector-ref (hash-table-ref test-records waiter) 2))
                                                    (set! waiters (cons waiter waiters))
                                                 )
                                               )
                                             (hash-table-keys test-records))
                                             (hash-table-set! missing-waitons hed waiters)
                                           )
					   ""))))
			  (debug:print-info 8 *default-log-port* "waitons string is " instr)
			  (string-split (cond
					 ((procedure? instr)
					  (let ((res (instr)))
					    (debug:print-info 8 *default-log-port* "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-error 0 *default-log-port* "something went wrong in processing waitons for test " hed)
					  ;; NOTE: This is actually the case of *no* waitons! ;; 
					  ""))))))
	  (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 *default-log-port* "waitons: " waitons)
1908
1909
1910
1911
1912
1913
1914
1915

1916
1917

1918
1919
1920
1921
1922
1923
1924
1925








1926
1927
1928
1929
1930
1931
1932
1922
1923
1924
1925
1926
1927
1928

1929
1930

1931
1932
1933
1934
1935
1936
1937
1938

1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953







-
+

-
+







-
+
+
+
+
+
+
+
+







						     (debug:print-info 4 *default-log-port* "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 
                (for-each 
		 (lambda (waiton)
		   (if (and waiton (not (member waiton test-names)))
		   (if (and waiton (not (string= "#f" 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-records)))))))
      (for-each
         (lambda (missing-waiton)
            (debug:print-error 0 *default-log-port* "non-existent test \"" missing-waiton "\" is a waiton for tests " (hash-table-ref missing-waitons missing-waiton))
         )
         (hash-table-keys missing-waitons)
      )
))

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

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