Overview
Context
Changes
Modified configf.scm
from [39c9b380ea]
to [dae73e7b9f].
︙ | | |
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
+
+
|
((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
;; (print "fullcmd=" fullcmd)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: failed to process config input \"" l "\"")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
;; (print "exn=" (condition->list exn))
(set! result (conc "#{( " cmdtype ") " cmd"}")))
(if (or allow-system
(not (member cmdtype '("system" "shell"))))
(with-input-from-string fullcmd
(lambda ()
(set! result ((eval (read)) ht))))
(set! result (conc "#{(" cmdtype ") " cmd "}"))))
|
︙ | | |
Modified launch.scm
from [a29cc8fd49]
to [efae46c199].
︙ | | |
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
|
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
|
-
-
+
-
-
-
-
+
|
(tests:get-testconfig test-name tconfigreg #t force-create: #t)) ;; 'return-procs)))
(ezstepslst (if (hash-table? testconfig)
(hash-table-ref/default testconfig "ezsteps" '())
#f)))
(if testconfig
(hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
(begin
;; got here but there are race condiitions - re-do all setup and try one more time
(if (launch:setup)
(launch:setup)
(begin
(launch:cache-config)
(set! testconfig (full-runconfigs-read))) ;; redunantly redundant, but does it resolve the race?
(debug:print 0 "WARNING: no testconfig found for " test-name " in search path:\n "
(string-intersperse (tests:get-tests-search-path *configdat*) "\n ")))))
(string-intersperse (tests:get-tests-search-path *configdat*) "\n "))))
;; after all that, still no testconfig? Time to abort
(if (not testconfig)
(begin
(debug:print 0 "ERROR: Failed to resolve megatest.config, runconfigs.config and testconfig issues. Giving up now")
(exit 1)))
(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
|
︙ | | |
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
|
+
-
+
+
|
;; *toppath*
;; side effects:
;; sets; *configdat* (megatest.config info)
;; *runconfigdat* (runconfigs.config info)
;; *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force #f))
(let* ((toppath (or *toppath* (getenv "MT_RUN_AREA_HOME")))
(let* ((runname (common:args-get-runname))
(runname (common:args-get-runname))
(target (common:args-get-target))
(linktree (common:get-linktree))
(rundir (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
(mtcachef (and rundir (conc rundir "/" ".megatest.cfg-" megatest-version "-" megatest-fossil-hash)))
(rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-" megatest-version "-" megatest-fossil-hash)))
(cancreate (and rundir (file-exists? rundir)(file-write-access? rundir))))
;; (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef)
(if (not *toppath*)(set! *toppath* toppath)) ;; this probably is not needed?
(cond
;; data was read and cached and available in *configstatus*
((eq? *configstatus* 'fulldata)
*toppath*)
;; if mtcachef exists just read it
((and mtcachef (file-exists? mtcachef))
(set! *configdat* (configf:read-alist mtcachef))
|
︙ | | |
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
|
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
|
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
+
+
-
+
-
-
-
-
+
|
environ-patt: "env-override"
given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
pathenvvar: "MT_RUN_AREA_HOME")))
(if first-pass
(begin
(set! *configdat* (car first-pass))
(set! *configinfo* first-pass)
(set! *toppath* (cadr first-pass))
(set! *toppath* (or toppath (cadr first-pass))) ;; use the gathered data unless already have it
(set! toppath *toppath*)
;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it
(let* ((keys (rmt:get-keys))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
(runconfigdat (begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(if key-vals
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
key-vals))
(read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections))))
(if cancreate (configf:write-alist runconfigdat rccachef))
(set! *runconfigdat* runconfigdat)
(if cancreate (configf:write-alist *configdat* mtcachef))
(if cancreate (set! *configstatus* 'fulldata))))
(let ((second-pass (find-and-read-config
(or (args:get-arg "-config") "megatest.config")
environ-patt: "env-override"
given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
pathenvvar: "MT_RUN_AREA_HOME")))
(if cancreate (configf:write-alist (car second-pass) mtcachef))
(set! *configdat* (car second-pass))
(set! *toppath* (cadr second-pass))
(if cancreate (set! *configstatus* 'fulldata)))))
;; (let ((second-pass (find-and-read-config
;; (or (args:get-arg "-config") "megatest.config")
;; environ-patt: "env-override"
;; given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
;; pathenvvar: "MT_RUN_AREA_HOME")))
;; (if cancreate (configf:write-alist (car second-pass) mtcachef))
;; (set! *configdat* (car second-pass))
;; (set! *toppath* (or toppath (cadr second-pass))) ;; this should be a no-op, remove it later
;; (if cancreate (set! *configstatus* 'fulldata)))))
;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table
(set! *configdat* (make-hash-table))
)))
;; else read what you can and set the flag accordingly
(else
(let* ((cfgdat (find-and-read-config
(or (args:get-arg "-config") "megatest.config")
environ-patt: "env-override"
given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
pathenvvar: "MT_RUN_AREA_HOME"))
(sections (if target (list "default" target) #f))
(rdat (read-config (conc (or *toppath* (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat))
"/runconfigs.config") #f #t sections: sections)))
(set! *configinfo* cfgdat)
(set! *configdat* (car cfgdat))
(set! *runconfigdat* rdat)
(set! *toppath* (cadr cfgdat))
(set! *toppath* (or toppath (cadr cfgdat)))
(set! toppath *toppath*) ;; remove this sillyness later
(set! *configstatus* 'partial))))
;; final house keeping
;; additional house keeping
(let* ((keys (rmt:get-keys))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(linktree (or (getenv "MT_LINKTREE")
(let* ((linktree (or (getenv "MT_LINKTREE")
(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))))
(if linktree
(if (not (file-exists? linktree))
(begin
(handle-exceptions
exn
(begin
|
︙ | | |