Megatest

Check-in [0f355e8087]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Hacked to get vars working ok. NOT REENTRANT. Must rework :(
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | envhandling
Files: files | file ages | folders
SHA1: 0f355e808706759e60353e7505a815d33f3a5fe6
User & Date: matt on 2011-11-02 21:58:28
Other Links: branch diff | manifest | tags
Context
2011-11-02
21:59
Merged from envhandling branch check-in: da715ac6ab user: matt tags: trunk, v1.32
21:58
Hacked to get vars working ok. NOT REENTRANT. Must rework :( Closed-Leaf check-in: 0f355e8087 user: matt tags: envhandling
18:09
envvar handling is not reentrant. Need a better solution. Putting this stuff on a branch for now check-in: b71bf64192 user: mrwellan tags: envhandling
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified configf.scm from [4590f7c875] to [ef264b880e].

︙
88
89
90
91
92
93
94
95
96



97
98



99

100
101
102
103
104
105
106

88
89
90
91
92
93
94


95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110








-
-
+
+
+


+
+
+
-
+








								 (if (null? res)
								     ""
								     (string-intersperse res " ")))))
						    (hash-table-set! res curr-section-name 
								     (config:assoc-safe-add alist key val))
						    (loop (read-line inp) curr-section-name #f #f))
						  (loop (read-line inp) curr-section-name #f #f)))
	       (key-val-pr ( x key val      ) (let ((alist   (hash-table-ref/default res curr-section-name '()))
						    (realval (if (and environ-patt (string-match (regexp environ-patt) curr-section-name))
	       (key-val-pr ( x key val      ) (let* ((alist   (hash-table-ref/default res curr-section-name '()))
						     (envar   (and environ-patt (string-match (regexp environ-patt) curr-section-name)))
						     (realval (if envar
								 (config:eval-string-in-environment val)
								 val)))
						(if envar
						    (begin
						      (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval)
						(setenv key realval)
						      (setenv key realval)))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key realval))
						(loop (read-line inp) curr-section-name key #f)))
	       ;; if a continued line
	       (cont-ln-rx ( x whsp val     ) (let ((alist (hash-table-ref/default res curr-section-name '())))
						(if var-flag             ;; if set to a string then we have a continued var
						    (let ((newval (conc
︙

Modified launch.scm from [7996f32f59] to [b3346272f9].

︙
58
59
60
61
62
63
64

65
66
67
68
69
70
71

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72








+








	       (env-ovrd  (assoc/default 'env-ovrd  cmdinfo))
	       (set-vars  (assoc/default 'set-vars  cmdinfo)) ;; pre-overrides from -setvar
	       (runname   (assoc/default 'runname   cmdinfo))
	       (megatest  (assoc/default 'megatest  cmdinfo))
	       (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
	       (fullrunscript (if runscript (conc testpath "/" runscript) #f))
	       (db        #f))
	  
	  (debug:print 2 "Exectuing " test-name " on " (get-host-name))
	  (change-directory testpath)
	  ;; 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)
︙
86
87
88
89
90
91
92

93
94
95
96
97
98
99

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101








+








	  
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, exiting") 
		(exit 1)))
	  ;; now can find our db
	  (set! db (open-db))
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 
	  (set-run-config-vars db run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars db run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")
︙

Modified runconfig.scm from [ddff02cb0f] to [12d1c1602d].

︙
9
10
11
12
13
14
15
16
17
18
19
20
21
22






23
24
25
26
27
28
29

9
10
11
12
13
14
15

16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
33








-





-
+
+
+
+
+
+








(declare (uses common))

(include "common_records.scm")

(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f))
  (let* ((keys    (get-keys db))
	 (keyvals (get-key-vals db run-id))
	 (keyval
	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/"))
	 (confdat (read-config fname #f #f environ-patt: environ-patt))
	 (whatfound (make-hash-table))
	 (sections (list "default" thekey)))
    (debug:print 4 "Using key=\"" thekey "\"")
    

    (for-each
     (lambda (key val)
       (setenv (vector-ref key 0) val))
     keys keyvals)

    (for-each 
     (lambda (section)
       (let ((section-dat (hash-table-ref/default confdat section #f)))
	 (if section-dat
	     (for-each 
	      (lambda (envvar)
		(hash-table-set! whatfound section (+ (hash-table-ref/default whatfound section 0) 1))
︙
40
41
42
43
44
45
46
47


44
45
46
47
48
49
50

51








-
+

	  (set! *already-seen-runconfig-info* #t)))))

(define (set-run-config-vars db run-id)
  (let ((runconfigf (conc  *toppath* "/runconfigs.config")))
    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id #f environ-patt: ".*")
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))

Modified runs.scm from [cf599e0423] to [5e902b8e73].

︙
548
549
550
551
552
553
554


555
556
557
558
559
560
561

548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563








+
+








	 (keyvallst   (keys->vallist keys #t))
	 (run-id      (register-run db keys))  ;;  test-name)))
	 (deferred    '()) ;; delay running these since they have a waiton clause
	 (runconfigf   (conc  *toppath* "/runconfigs.config")))
    ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
    ;; -keepgoing is specified

    (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
    
    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* environ-patt: ".*")
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))

    (if (and (eq? *passnum* 0)
	     (args:get-arg "-keepgoing"))
	(begin
︙
588
589
590
591
592
593
594

595


596
597
598
599
600
601
602

590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606








+
-
+
+








	  
;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
(define (run-one-test db run-id test-name keyvallst)
  (debug:print 1 "Launching test " test-name)
  ;; All these vars might be referenced by the testconfig file reader
  (setenv "MT_TEST_NAME" test-name) ;; 
  (setenv "MT_RUNNAME"   (args:get-arg ":runname"))

  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
  ;; (set-megatest-env-vars db run-id) ;; these may be needed by the launching process

  (change-directory *toppath*)
  (let* ((test-path    (conc *toppath* "/tests/" test-name)) ;; could use test:get-testconfig here ...
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (test-conf    (if testexists (read-config test-configf #f #t) (make-hash-table)))
	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))
			 (if (string? w)(string-split w)'())))
︙
828
829
830
831
832
833
834


835
836
837
838
839
840
841

832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847








+
+








	 (keyvallst   (keys:target->keyval keys target))
	 (run-id      (runs:register-run db keys keyvallst runname "new" "n/a" user))  ;;  test-name)))
	 (deferred    '()) ;; delay running these since they have a waiton clause
	 (keepgoing   (hash-table-ref/default flags "-keepgoing" #f))
	 (test-names  '())
	 (runconfigf   (conc  *toppath* "/runconfigs.config"))
	 (required-tests '()))

    (set-megatest-env-vars db run-id) ;; these may be needed by the launching process

    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "pre-launch-env-vars")
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)
︙

This page was generated in about 0.112s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00