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: |
8b8b1f63e751a8e106b70975aea874b0 |
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 | ;; 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*))) (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 | > | 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 | #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 | | | 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 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 | ;;====================================================================== ;; 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) | > | | | > > > > > > > > > > > > | | | 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)) (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-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! ;; "")))))) (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 | (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 ))) | | | | > > > > > > > | 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 (lambda (waiton) (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))))))) (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 |
︙ | ︙ |