Overview
Context
Changes
Modified launch.scm
from [116fbde43b]
to [8d485e0358].
︙ | | |
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
-
+
|
runscript))))) ;; assume it is on the path
;; (rollup-status 0)
)
;; NFS might not have propagated the directory meta data to the run host - give it time if needed
(let loop ((count 0))
(if (or (file-exists? top-path)
(< count 10))
(> count 10))
(change-directory top-path)
(begin
(debug:print 0 "INFO: Not starting job yet - directory " top-path " not found")
(thread-sleep! 10)
(loop (+ count 1)))))
(let ((sighand (lambda (signum)
|
︙ | | |
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
|
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
|
-
+
-
+
|
(debug:print 0 "ERROR: bad variable spec, " var "=" val))))
(configf:get-section rconfig section)))
(list "default" target)))
;; NFS might not have propagated the directory meta data to the run host - give it time if needed
(let loop ((count 0))
(if (or (file-exists? work-area)
(< count 10))
(> count 10))
(change-directory work-area)
(begin
(debug:print 0 "INFO: Not starting job yet - directory " work-area " not found")
(thread-sleep! 10)
(loop (+ count 1)))))
(change-directory work-area)
;; (change-directory work-area)
(set! keyvals (keys:target->keyval keys target))
;; apply pre-overrides before other variables. The pre-override vars must not
;; clobbers things from the official sources such as megatest.config and runconfigs.config
(if (string? set-vars)
(let ((varpairs (string-split set-vars ",")))
(debug:print 4 "varpairs: " varpairs)
(map (lambda (varpair)
|
︙ | | |
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
+
+
-
+
|
(thread-sleep! 2)
(loop (+ i 1)))
)))))
;; then, if runscript ran ok (or did not get called)
;; do all the ezsteps (if any)
(if ezsteps
(let* ((testconfig ;; (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
;; NOTE: it is tempting to turn off force-create of testconfig but dynamic
;; ezstep names need a full re-eval here.
(tests:get-testconfig test-name tconfigreg #t)) ;; 'return-procs)))
(tests:get-testconfig test-name tconfigreg #t force-create: #t)) ;; 'return-procs)))
(ezstepslst (hash-table-ref/default testconfig "ezsteps" '())))
(hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
(if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps"))
;; if ezsteps was defined then we are sure to have at least one step but check anyway
(if (not (> (length ezstepslst) 0))
(debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length")
(let loop ((ezstep (car ezstepslst))
|
︙ | | |
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
|
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
|
-
+
|
(list "MT_RUNNAME" runname)
;; (list "MT_TARGET" mt_target)
))
(let* ((tregistry (tests:get-all))
(item-path (let ((ip (item-list->path itemdat)))
(alist->env-vars (list (list "MT_ITEMPATH" ip)))
ip))
(tconfig (or (tests:get-testconfig test-name tregistry #t)
(tconfig (or (tests:get-testconfig test-name tregistry #t force-create: #t)
test-conf)) ;; force re-read now that all vars are set
(useshell (let ((ush (config-lookup *configdat* "jobtools" "useshell")))
(if ush
(if (equal? ush "no") ;; must use "no" to NOT use shell
#f
ush)
#t))) ;; default is yes
|
︙ | | |
Modified tests.scm
from [e3bfdc8511]
to [74bec393f0].
︙ | | |
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
|
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
|
-
+
-
+
+
+
|
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME") "/"
(if (or (getenv "MT_ITEMPATH")
(not (string=? "" (getenv "MT_ITEMPATH"))))
(conc "/" (getenv "MT_ITEMPATH"))))))
(define (tests:get-testconfig test-name test-registry system-allowed)
(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
(let* ((test-path (hash-table-ref/default
test-registry test-name
(conc *toppath* "/tests/" test-name)))
(test-configf (conc test-path "/testconfig"))
(testexists (and (file-exists? test-configf)(file-read-access? test-configf)))
(cache-path (tests:get-test-path-from-environment))
(cache-exists (and cache-path (file-exists? (conc cache-path "/.testconfig"))))
(cache-exists (and cache-path
(not force-create) ;; if force-create then pretend there is no cache to read
(file-exists? (conc cache-path "/.testconfig"))))
(cache-file (conc cache-path "/.testconfig"))
(tcfg (if testexists
(or (and cache-exists
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to read " cache-file)
|
︙ | | |
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
|
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
|
-
-
-
-
-
-
-
+
+
+
+
+
+
+
|
(sort-fn2
(lambda (a b)
(> (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records a)))
(mungepriority (tests:testqueue-get-priority (hash-table-ref test-records b)))))))
;; (let ((dot-res (tests:run-dot (tests:tests->dot test-records) "plain")))
;; (debug:print "dot-res=" dot-res))
(let ((data (map cdr (filter
(lambda (x)(equal? "node" (car x)))
(map string-split (tests:easy-dot test-records "plain"))))))
(map car (sort data (lambda (a b)
(> (string->number (caddr a))(string->number (caddr b)))))))
))
;; (sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table
;; (let ((data (map cdr (filter
;; (lambda (x)(equal? "node" (car x)))
;; (map string-split (tests:easy-dot test-records "plain"))))))
;; (map car (sort data (lambda (a b)
;; (> (string->number (caddr a))(string->number (caddr b)))))))
;; ))
(sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table
(define (tests:easy-dot test-records outtype)
(let-values (((fd temp-path) (file-mkstemp (conc "/tmp/" (current-user-name) ".XXXXXX"))))
(let ((all-testnames (hash-table-keys test-records))
(temp-port (open-output-file* fd)))
;; (format temp-port "This file is ~A.~%" temp-path)
(format temp-port "digraph tests {\n")
|
︙ | | |