Megatest

Diff
Login

Differences From Artifact [90e532b08a]:

To Artifact [3ca2461ce8]:


1713
1714
1715
1716
1717
1718
1719
1720

1721
1722
1723
1724
1725
1726
1727
(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))

    ;; 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))







|
>







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)
	 (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
		     (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")))
			     (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)







|







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" "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
	  ;;      (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)))))))))














;;======================================================================
;; END OF NEW STUFF
;;======================================================================

(define (get-dir-up-n dir . params) 
  (let ((dparts  (string-split dir "/"))







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







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)))))))
    ;; 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 "/"))