1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
|
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
|
-
+
+
|
(define (run:test run-id run-info keyvals runname test-record flags parent-test test-registry all-tests-registry)
;; All these vars might be referenced by the testconfig file reader
(let* ((test-name (tests:testqueue-get-testname test-record))
(test-waitons (tests:testqueue-get-waitons test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(item-path "")
(db #f)
(full-test-name #f))
(full-test-name #f)
(all-vars (get-environment-variables)))
;; setting itemdat to a list if it is #f
(if (not itemdat)(set! itemdat '()))
(set! item-path (item-list->path itemdat))
(set! full-test-name (db:test-make-full-name test-name item-path))
(runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) ;; these may be needed by the launching process
(let* ((test-conf ;; re-instate the tests:get-testconfig once the kinks are worked out. FIXME!!!
;; (tests:get-testconfig test-name item-path all-tests-registry #t force-create: #t))
|
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
|
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
|
-
+
|
(let* ((files (string-split (configf:lookup test-conf "skip" "fileexists")))
(existing (filter common:file-exists? files)))
(if (not (null? existing)) ;; (common:file-exists? (configf:lookup test-conf "skip" "fileexists"))
(set! skip-test (conc "Skipping due to existance of file(s) " (string-intersperse existing ", ")))))) ;; (configf:lookup test-conf "skip" "fileexists")))))
((and skip-check
(configf:lookup test-conf "skip" "filenotexists"))
(let* ((files (string-split (configf:lookup test-conf "skip" "fileexists")))
(let* ((files (string-split (configf:lookup test-conf "skip" "filenotexists")))
(existing (filter common:file-exists? files)))
(if (null? existing) ;; (common:file-exists? (configf:lookup test-conf "skip" "filenotexists")))
(set! skip-test (conc "Skipping due to non existance of files " (string-intersperse files ", ")))))) ;; (configf:lookup test-conf "skip" "filenotexists")))))
((and skip-check
(configf:lookup test-conf "skip" "script"))
(if (= (system (configf:lookup test-conf "skip" "script")) 0)
|
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
|
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (debug:print 2 *default-log-port* "NOTE: " test-name " is already running")))
(else
(debug:print-error 0 *default-log-port* "Failed to launch test " full-test-name ". Unrecognised state " (test:get-state testdat))
(case (string->symbol (test:get-state testdat))
((COMPLETED INCOMPLETE)
(hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN))
(else
(hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)))))))))
(hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)))))))
;; put any changed environment variables back to how they were - TODO - turn this into some sort of with-
(common:set-vars-back all-vars)
#;(for-each
(lambda (vardat)
(let ((var (car vardat))
(val (cdr vardat)))
(if (not (equal? (get-environment-variable var) val))
(handle-exceptions
exn
(debug:print-error 0 *default-log-port* "Failed to set " var " to " val)
(setenv var val)))))
all-vars)
))
;;======================================================================
;; END OF NEW STUFF
;;======================================================================
(define (get-dir-up-n dir . params)
(let ((dparts (string-split dir "/"))
|