Megatest

Check-in [c65398ee68]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed reading of runconfigs; chdir to location of .config before reading sub-files; added pattern matching on sections to target; added tests, removed some redundant db accesses
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c65398ee68529799bbd691f3c4aa5f2b683a1d36
User & Date: matt on 2012-03-30 00:07:12
Other Links: manifest | tags
Context
2012-04-04
18:07
Added ability to remove tests based on :state and :status Closed-Leaf check-in: 3ae695ed4b user: mrwellan tags: remove-given-state-status
2012-03-31
18:38
Cleaned up ignores and added minimal example to docs check-in: ca3478ee5c user: matt tags: trunk
18:26
Experimentally cutting back the open-db/finalize cycle NOTE: This made contention on the db worse and causes failures Closed-Leaf check-in: e01e81f554 user: matt tags: experimental-streamlining
2012-03-30
00:07
Fixed reading of runconfigs; chdir to location of .config before reading sub-files; added pattern matching on sections to target; added tests, removed some redundant db accesses check-in: c65398ee68 user: matt tags: trunk
2012-03-28
20:16
Removed debug statement check-in: aea23d28f1 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified Makefile from [76b5c2ca20] to [adce6c50e5]. 

1
2
3
4
5
6
7
8
9
10
11


PREFIX=.
CSCOPTS= 

SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm tasks.scm tests.scm 

GUISRCF  = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm dashboard-main.scm





|








1
2
3
4
5
6
7
8
9
10
11


PREFIX=.
CSCOPTS= 
INSTALL=install
SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm tasks.scm tests.scm 

GUISRCF  = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm dashboard-main.scm
︙︙
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

$(OFILES) $(GOFILES) : common_records.scm 

%.o : %.scm
	csc $(CSCOPTS) -c $<

$(PREFIX)/bin/megatest : megatest
	@echo Installing to PREFIX=$(PREFIX)
	cp megatest $(PREFIX)/bin/megatest

$(HELPERS) : utils/mt_* 
	cp $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfake : utils/nbfake
	cp $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	cp $< $@
	chmod a+x $@

# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dboard $(FILES)
	cp dboard $(PREFIX)/bin/dboard
	utils/mk_dashboard_wrapper $(PREFIX) > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : bin $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake $(PREFIX)/bin/nbfind

bin : 
	mkdir -p $(PREFIX)/bin

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

clean : 
	rm -f $(OFILES) $(GOFILES) megatest dboard dboard.o megatest.o








|


|



|



|




|














32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

$(OFILES) $(GOFILES) : common_records.scm 

%.o : %.scm
	csc $(CSCOPTS) -c $<

$(PREFIX)/bin/megatest : megatest
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) megatest $(PREFIX)/bin/megatest

$(HELPERS) : utils/mt_* 
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@

# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dboard $(FILES)
	$(INSTALL) dboard $(PREFIX)/bin/dboard
	utils/mk_dashboard_wrapper $(PREFIX) > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : bin $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake $(PREFIX)/bin/nbfind

bin : 
	mkdir -p $(PREFIX)/bin

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

clean : 
	rm -f $(OFILES) $(GOFILES) megatest dboard dboard.o megatest.o

Modified common.scm from [62c7112aab] to [4d86105e95].

︙︙
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51

(define user (getenv "USER"))

;; global gletches
(define *configinfo* #f)
(define *configdat*  #f)
(define *toppath*    #f)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue* (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus* 0) ;; attempt to work around possible thread issues
(define *passnum*     0) ;; when running track calls to run-tests or similar
(define *verbosity*   1)
(define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port
(define *runremote*    #f) ;; if set up for server communication this will hold <host port>
(define *last-db-access* 0) ;; update when db is accessed via server


(define (get-with-default val default)
  (let ((val (args:get-arg val)))
    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))








|

|
|
|
|
|
|
>








30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

(define user (getenv "USER"))

;; global gletches
(define *configinfo* #f)
(define *configdat*  #f)
(define *toppath*    #f)
(define *already-seen-runconfig-info* #f)
(define *waiting-queue*     (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar
(define *verbosity*         1)
(define *rpc:listener*      #f) ;; if set up for server communication this will hold the tcp port
(define *runremote*         #f) ;; if set up for server communication this will hold <host port>
(define *last-db-access*    0)  ;; update when db is accessed via server
(define *target*            #f) ;; cache the target here; target is keyval1/keyval2/.../keyvalN

(define (get-with-default val default)
  (let ((val (args:get-arg val)))
    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
︙︙

Modified configf.scm from [879a86d233] to [385303fb46].

︙︙
114
115
116
117
118
119
120
121
122
123


124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

140

141
142
143
144
145
146
147
148

;; read a config file, returns hash table of alists

;; 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)))
	(let loop ((inl               (configf:read-line inp res)) ;; (read-line inp))
		   (curr-section-name "default")
		   (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere
		   (lead     #f))
	  (if (eof-object? inl) 
	      (begin
		(close-input-port inp)
		res)
	      (regex-case 
	       inl 
	       (configf:comment-rx _                  (loop (configf:read-line inp res) curr-section-name #f #f))
	       (configf:blank-l-rx _                  (loop (configf:read-line inp res) curr-section-name #f #f))
	       (configf:include-rx ( x include-file ) (begin

						(read-config include-file res allow-system environ-patt: environ-patt)

						(loop (configf:read-line inp res) curr-section-name #f #f)))
	       (configf:section-rx ( x section-name ) (loop (configf:read-line inp res) section-name #f #f))
	       (configf:key-sys-pr ( x key cmd      ) (if allow-system
							  (let ((alist (hash-table-ref/default res curr-section-name '()))
								(val-proc (lambda ()
									    (let* ((cmdres  (cmd-run->list cmd))
										   (status  (cadr cmdres))
										   (res     (car  cmdres)))








|
|

>
>
|



|










|
>
|
>
|








114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

;; read a config file, returns hash table of alists

;; 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)(curr-section #f))
  (debug:print 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section)
  (if (not (file-exists? path))
      (begin 
	(debug:print 4 "INFO: read-config - file not found " path " current path: " (current-directory))
	(if (not ht)(make-hash-table) ht))
      (let ((inp        (open-input-file path))
	    (res        (if (not ht)(make-hash-table) ht)))
	(let loop ((inl               (configf:read-line inp res)) ;; (read-line inp))
		   (curr-section-name (if curr-section curr-section "default"))
		   (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere
		   (lead     #f))
	  (if (eof-object? inl) 
	      (begin
		(close-input-port inp)
		res)
	      (regex-case 
	       inl 
	       (configf:comment-rx _                  (loop (configf:read-line inp res) curr-section-name #f #f))
	       (configf:blank-l-rx _                  (loop (configf:read-line inp res) curr-section-name #f #f))
	       (configf:include-rx ( x include-file ) (let ((curr-dir (current-directory)))
							(change-directory (pathname-directory path))
							(read-config include-file res allow-system environ-patt: environ-patt curr-section: curr-section-name)
							(change-directory curr-dir)
							(loop (configf:read-line inp res) curr-section-name #f #f)))
	       (configf:section-rx ( x section-name ) (loop (configf:read-line inp res) section-name #f #f))
	       (configf:key-sys-pr ( x key cmd      ) (if allow-system
							  (let ((alist (hash-table-ref/default res curr-section-name '()))
								(val-proc (lambda ()
									    (let* ((cmdres  (cmd-run->list cmd))
										   (status  (cadr cmdres))
										   (res     (car  cmdres)))
︙︙
159
160
161
162
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178
179
180
181
182
183

												    (case allow-system
												      ((return-procs) val-proc)
												      ((return-string) cmd)
												      (else (val-proc)))))
							    (loop (configf:read-line inp res) curr-section-name #f #f))
							  (loop (configf:read-line inp res) curr-section-name #f #f)))
	       (configf: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)))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key realval))
						(loop (configf:read-line inp res) curr-section-name key #f)))
	       ;; if a continued line
	       (configf: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 
								   (config-lookup res curr-section-name var-flag) "\n"
								   ;; trim lead from the incoming whsp to support some indenting.
								   (if lead








|
|
|
|
>
|
|
|
|
|
|
|








163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

												    (case allow-system
												      ((return-procs) val-proc)
												      ((return-string) cmd)
												      (else (val-proc)))))
							    (loop (configf:read-line inp res) curr-section-name #f #f))
							  (loop (configf:read-line inp res) curr-section-name #f #f)))
	       (configf:key-val-pr ( x key val      ) (let* ((alist   (hash-table-ref/default res curr-section-name '()))
							     (envar   (and environ-patt (string-search (regexp environ-patt) curr-section-name)))
							     (realval (if envar
									  (config:eval-string-in-environment val)
									  val)))
							(debug:print 6 "INFO: read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
							(if envar
							    (begin
							      ;; (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval)
							      (setenv key realval)))
							(hash-table-set! res curr-section-name 
									 (config:assoc-safe-add alist key realval))
							(loop (configf:read-line inp res) curr-section-name key #f)))
	       ;; if a continued line
	       (configf: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 
								   (config-lookup res curr-section-name var-flag) "\n"
								   ;; trim lead from the incoming whsp to support some indenting.
								   (if lead
︙︙

Modified db.scm from [d9dab9adc2] to [1ae5c33688].

︙︙
405
406
407
408
409
410
411









412
413
414
415
416
417
418

	 ;; (debug:print 0 "qry: " qry)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons key-val res)))
	  db qry run-id)))
     keys)
    (reverse res)))










;;======================================================================
;;  T E S T S
;;======================================================================

;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.








>
>
>
>
>
>
>
>
>








405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427

	 ;; (debug:print 0 "qry: " qry)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons key-val res)))
	  db qry run-id)))
     keys)
    (reverse res)))

;; The target is keyval1/keyval2..., cached in *target* as it is used often
(define (db:get-target db run-id)
  (if *target*
      *target*
      (let* ((keyvals (rdb:get-key-vals db run-id))
	     (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
	(set! *target* thekey)
	thekey)))

;;======================================================================
;;  T E S T S
;;======================================================================

;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
︙︙

Modified runconfig.scm from [107346ffc1] to [ae261d7ff6]. 

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

;;======================================================================
;; 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 #!key (environ-patt #f))
  (let* ((keys    (rdb:get-keys db))
	 (keyvals (rdb:get-key-vals db run-id))
	 (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)













>
>





>
>
|


>








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

;;======================================================================
;; 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 #!key (environ-patt #f))
  (let* ((keys    (rdb:get-keys db))
	 (keyvals (rdb:get-key-vals db run-id))
	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/"))
	 ;; Why was system disallowed in the reading of the runconfigs file?
	 ;; NOTE: Should be setting env vars based on (target|default)
	 (confdat (read-config fname #f #t environ-patt: environ-patt))
	 (whatfound (make-hash-table))
	 (sections (list "default" thekey)))
    (if (not *target*)(set! *target* thekey)) ;; may save a db access or two but repeats db:get-target code
    (debug:print 4 "Using key=\"" thekey "\"")

    (for-each
     (lambda (key val)
       (setenv (vector-ref key 0) val))
     keys keyvals)
︙︙
40
41
42
43
44
45
46
47



48
49



50
51

	  (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 #f environ-patt: ".*")



	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))
 








|
>
>
>

|
>
>
>



45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

	  (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"))
	(targ       (or (args:get-arg "-target")
			(args:get-arg "-reqtarg")
			(db:get-target db run-id))))
    (if (file-exists? runconfigf)
	(setup-env-defaults db runconfigf run-id #t environ-patt: (conc "(default"
									(if targ
									    (conc "|" targ ")")
									    ")")))
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))

Modified tests/runconfigs.config from [1d6f530c0f] to [92c9180758]. 

1
2
3
4
5
6
7
8
9
10
11

12


13
14

[include common_runconfigs.config]

# Can do: 
#   get section var
#   scheme expr
#   shell  cmd
#   system cmd
#   getenv var
#   runconfigs-get var

WACKYVAR0 #{get ubuntu/nfs/none CURRENT}

WACKYVAR1 #{scheme (args:get-arg "-target")}


WACKYVAR2 #{runconfigs-get CURRENT}




<
<
<
<
<
<
<


>

>
>



1
2







3
4
5
6
7
8
9
10

[include common_runconfigs.config]









WACKYVAR0 #{get ubuntu/nfs/none CURRENT}

WACKYVAR1 #{scheme (args:get-arg "-target")}

[default/ubuntu/nfs]
WACKYVAR2 #{runconfigs-get CURRENT}

Added tests/tests/test_mt_vars/bogousnotset.sh version [25167b86d9]. 









>
>
>

1
2
3

#!/usr/bin/env bash

! grep BOGOUS megatest.sh

Added tests/tests/test_mt_vars/currentisblah.sh version [38498b5b33]. 









>
>
>

1
2
3

#!/usr/bin/env bash

grep CURRENT megatest.sh | grep /tmp/nada

Modified tests/tests/test_mt_vars/testconfig from [3b27a4617c] to [565fa166b2]. 

1
2
3
4
5





6
7
8
9
10
11
12

[setup]

[ezsteps]
lookittmp   ls /tmp
lookithome  ls /home






[requirements]
waiton runfirst
priority 0

[items]
NUMNUM [system cat $MT_RUN_AREA_HOME/tmp/$USER/$sysname/$fsname/$datapath/$MT_RUNNAME/the_ans]






>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

[setup]

[ezsteps]
lookittmp   ls /tmp
lookithome  ls /home
# $CURRENT should be /tmp/nada
currentisblah currentisblah.sh

# $BOGOUS should NOT be set
bogousnotset bogousnotset.sh

[requirements]
waiton runfirst
priority 0

[items]
NUMNUM [system cat $MT_RUN_AREA_HOME/tmp/$USER/$sysname/$fsname/$datapath/$MT_RUNNAME/the_ans]
︙︙

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