Megatest

Check-in [e84ced5564]
Login
Overview
Comment:Preserve vars and reset them when doing items manipulations.:
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70-defunct-try
Files: files | file ages | folders
SHA1: e84ced5564ec29b53a791c8a8c0bc81e8ee2b6a0
User & Date: mrwellan on 2019-12-11 16:57:44
Other Links: branch diff | manifest | tags
Context
2019-12-11
20:20
Moved couple procs from runs-inc into runsmod. check-in: e6296edad4 user: matt tags: v1.70-defunct-try
16:57
Preserve vars and reset them when doing items manipulations.: check-in: e84ced5564 user: mrwellan tags: v1.70-defunct-try
11:43
Baby steps, moved couple defstructs into runsmod. check-in: 3c181b6745 user: mrwellan tags: v1.70-defunct-try
Changes

Modified commonmod.scm from [f35a4b6429] to [1a18aaecd2].

572
573
574
575
576
577
578












579
580


581
582
583
584
585
586
587
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590


591
592
593
594
595
596
597
598
599







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







	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
	    (setenv key val))
	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))

(define home (getenv "HOME"))
(define user (getenv "USER"))

;; put any changed environment variables back to how they were - TODO - turn this into some sort of with-
(define (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))

;; returns list of fd count, socket count
  
  ;; returns list of fd count, socket count
(define (get-file-descriptor-count #!key  (pid (current-process-id )))
  (list
    (length (glob (conc "/proc/" pid "/fd/*")))
    (length  (filter identity (map socket? (glob (conc "/proc/" pid "/fd/*")))))
  )
)

Modified runs-inc.scm from [90e532b08a] to [3ca2461ce8].

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