Megatest

Check-in [b71bf64192]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:envvar handling is not reentrant. Need a better solution. Putting this stuff on a branch for now
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | envhandling
Files: files | file ages | folders
SHA1: b71bf641927970bac3c5636c895fad9bdfbb4336
User & Date: mrwellan on 2011-11-02 18:09:28
Other Links: branch diff | manifest | tags
Context
2011-11-02
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
15:32
Checking in partial fix for envvar handling check-in: ff05a10939 user: mrwellan tags: trunk, v1.31
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified configf.scm from [4a3f07b3f3] to [4590f7c875].

︙
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50

51
52
53
54
55
56
57

36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58








-
+







+








(define (config:assoc-safe-add alist key val)
  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
    (append newalist (list (list key val)))))

(define (config:eval-string-in-environment str)
  (let ((cmdres (cmd-run->list (conc "echo " str))))
    (if (null? cmdres) ""
	(car cmdres))))
	(caar cmdres))))

;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly

(define (read-config path ht allow-system #!key (environ-patt #f))
  (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt)
  (if (not (file-exists? path))
      (if (not ht)(make-hash-table) ht)
      (let ((inp        (open-input-file path))
	    (res        (if (not ht)(make-hash-table) ht))
	    (include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
	    (section-rx (regexp "^\\[(.*)\\]\\s*$"))
	    (blank-l-rx (regexp "^\\s*$"))
︙
91
92
93
94
95
96
97

98
99
100
101
102
103
104

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106








+








								     (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))
								 (config:eval-string-in-environment val)
								 val)))
						(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 [ce1a0162c8] to [7996f32f59].

︙
285
286
287
288
289
290
291

292
293

294
295
296
297
298
299
300

285
286
287
288
289
290
291
292
293

294
295
296
297
298
299
300
301








+

-
+








	    ;; (success      exec-results)) ;; (eq? (cadr exec-results) 0)))
	    (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
			 work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
	    (sqlite3:finalize! db)
	    (if (not (vector-ref exit-info 1))
		(exit 4)))))))

;; set up the very basics needed for doing anything here.
(define (setup-for-run)
  (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config")))
  (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override"))
  (set! *configdat*  (if (car *configinfo*)(car *configinfo*) #f))
  (set! *toppath*    (if (car *configinfo*)(cadr *configinfo*) #f))
  (if *toppath*
      (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
      (debug:print 0 "ERROR: failed to find the top path to your run setup."))
  *toppath*)
︙

Modified megatest-version.scm from [826d6a379e] to [b46b5a7d77]. 

1
2
3
4
5
6

7

1
2
3
4
5

6
7






-
+


;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.31)
(define megatest-version 1.32)

Modified runconfig.scm from [d7b27c058f] to [ddff02cb0f]. 

1
2
3
4
5
6
7
8
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
34
35
36
37
38
39
40
41
42
43
44

45
46

1
2
3
4
5
6
7
8
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
34
35
36
37
38
39
40
41
42
43
44

45
46
47













-
+


+

-
+



+










-
-
+











-
+



;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format)

(declare (unit runconfig))
(declare (uses common))

(include "common_records.scm")

(define (setup-env-defaults db fname run-id . already-seen)
(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))
	 (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 (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))
		(setenv envvar (cadr (assoc envvar section-dat))))
	      (map car section-dat)))))
     sections)
    (if (and (not (null? already-seen))
	     (not (car already-seen)))
    (if already-seen
	(begin
	  (debug:print 2 "Key settings found in runconfig.config:")
	  (for-each (lambda (fullkey)
		      (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
		    sections)
	  (debug:print 2 "---")
	  (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)
	(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 [b12c8bbbfa] to [cf599e0423].

︙
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563

549
550
551
552
553
554
555

556
557
558
559
560
561
562
563








-
+








	 (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

    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
	(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
	  ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to 
	  ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends
︙
830
831
832
833
834
835
836
837

838
839
840
841
842
843
844

830
831
832
833
834
835
836

837
838
839
840
841
842
843
844








-
+








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

    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
	(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)
    (for-each 
     (lambda (patt)
       (let ((tests (glob (conc *toppath* "/tests/" (string-translate patt "%" "*")))))
︙
1193
1194
1195
1196
1197
1198
1199
1200
1201


1202
1203
1204
1205
1206
1207
1208

1193
1194
1195
1196
1197
1198
1199


1200
1201
1202
1203
1204
1205
1206
1207
1208








-
-
+
+








	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(set! db   (open-db))
	(set! keys (db-get-keys db))
	;; have enough to process -target or -reqtarg here
	(if (args:get-arg "-reqtarg")
	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; evaluate all 
		   (runconfig  (read-config runconfigf #f #f environ-patt: ".*"))) 
	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL 
		   (runconfig  (read-config runconfigf #f #f environ-patt: #f))) 
	      (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
		  (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
		  (begin
		    (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
		    (sqlite3:finalize! db)
		    (exit 1))))
	    (if (args:get-arg "-target")
︙

Modified tests/runconfigs.config from [bf935869e9] to [5386d0e9a5]. 

1
2
3
4
5
6
7
8
9
10
11
12
13




1
2
3
4
5
6
7
8
9
10
11
12

13
14
15













-
+
+
+

[/tmp/mrwellan/env/ubuntu/afs]
BOGOUS Bob

[default/ubuntu/nfs]
CURRENT     /blah

[ubuntu/nfs/none]
CURRENT     /tmp/nada


[default]
FOOBARBAZZZZ not a useful value
BIGBOB $BOGOUS/bobby
BIGBOB $FOOBARBAZZZZ/bobby
FREDDY $sysname/$fsname
TOMMY  [system pwd]

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