Megatest

Check-in [b0a0d0377c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Unknown work
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sqlite3-logging
Files: files | file ages | folders
SHA1: b0a0d0377c858d7979cd6648a9a2578a8deb8a54
User & Date: matt on 2013-01-20 00:02:15
Other Links: branch diff | manifest | tags
Context
2013-01-27
13:11
merged trunk into sqlite3-logging Closed-Leaf check-in: 7bd6b6dae6 user: matt tags: sqlite3-logging
2013-01-20
00:02
Unknown work check-in: b0a0d0377c user: matt tags: sqlite3-logging
2012-10-11
18:28
Added more tests. More conversion to glob + like check-in: dfc0e2341c user: mrwellan tags: trunk
01:06
Propagated -logging to tests (note: this doesn't help with sub-invocations) check-in: fc03199f62 user: matt tags: sqlite3-logging
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified configf.scm from [2510b90f57] to [79841cd745].

︙
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65

51
52
53
54
55
56
57

58
59
60
61
62
63
64
65








-
+








;; Make the regexp's needed globally available
;;======================================================================

(define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
(define configf:blank-l-rx (regexp "^\\s*$"))
(define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$"))
(define configf:key-val-pr (regexp "^(\\S+)\\s+(.*)$"))
(define configf:key-val-pr (regexp "^(\\S+)(\\s+(.*)|())$"))
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))

;; read a line and process any #{ ... } constructs

(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:process-line l ht)
︙
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193

179
180
181
182
183
184
185

186
187
188
189
190
191
192
193








-
+








												    key 
												    (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 '()))
	       (configf:key-val-pr ( x key unk1 val unk2 ) (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
︙

Modified db.scm from [1bca4e3583] to [4b08c5b9f7].

︙
473
474
475
476
477
478
479

480

481
482
483
484
485
486
487

473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
488








+
-
+









;; make a query (fieldname like 'patt1' OR fieldname 
(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
  (let ((patts (if (string? pattstr)
		   (string-split pattstr ",")
		   '("%"))))
    (string-intersperse (map (lambda (patt)
			       (let ((wildtype (if (substring-index "%" patt) "LIKE" "GLOB")))
			       (conc fieldname " LIKE '" patt "'"))
				 (conc fieldname " " wildtype " '" patt "'")))
			     (if (null? patts)
				 '("")
				 patts))
			comparator)))

;; replace header and keystr with a call to runs:get-std-run-fields
;;
︙

Modified runs.scm from [83c48ed884] to [431f11e2ab].

︙
30
31
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

30
31
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








-
+





-
+
+



-
+
+

-
+








-
+








;; runs:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
;;  to extract info from the structure returned
;;
(define (runs:get-runs-by-patt db keys runnamepatt . params) ;; test-name)
(define (runs:get-runs-by-patt db keys runnamepatt) ;; test-name)
  (let* ((keyvallst (keys->vallist keys))
	 (tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt ""))
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob")))
    (for-each (lambda (keyval)
		(let* ((key    (vector-ref keyval 0))
		       (fulkey (conc ":" key))
		       (patt   (args:get-arg fulkey)))
		       (patt   (args:get-arg fulkey))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " like '" patt "'"))
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
		      (begin
			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
			(exit 6)))))
	      keys)
    (sqlite3:for-each-row 
     (lambda (a . r)
       (set! res (cons (list->vector (cons a r)) res)))
     db 
     (conc "SELECT " keystr " FROM runs WHERE runname like ? " key-patt ";")
     (conc "SELECT " keystr " FROM runs WHERE runname " runwildtype " ? " key-patt ";")
     runnamepatt)
    (vector header res)))

(define (runs:test-get-full-path test)
  (let* ((testname (db:test-get-testname   test))
	 (itempath (db:test-get-item-path test)))
    (conc testname (if (equal? itempath "") "" (conc "(" itempath ")")))))
︙
732
733
734
735
736
737
738
739

740
741
742
743
744
745
746


747
748
749
750
751
752
753

734
735
736
737
738
739
740

741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757








-
+







+
+








						      testpatt itempatt states statuses
						      not-in:  #f
						      sort-by: (case action
								 ((remove-runs) 'rundir)
								 (else          'event_time)))
			       '()))
		(lasttpath "/does/not/exist/I/hope"))

	   (debug:print 4 "INFO: runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
		   ((remove-runs)
		    (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((set-state-status)
		    (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((print-run)
		    (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header))
		   (else
		    (print "INFO: action not recognised " action)))
		 (for-each
		  (lambda (test)
		    (let* ((item-path (db:test-get-item-path test))
			   (test-name (db:test-get-testname test))
			   (run-dir   (db:test-get-rundir test))
︙

Modified tests/Makefile from [e537ad06a8] to [9ff5be9492].

︙
25
26
27
28
29
30
31


32
33
34
35
36
37
38

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40








+
+








	rm -rf simplelinks/ simpleruns/
	mkdir -p simplelinks simpleruns
	cd simplerun;cp ../../*_records.scm .;perl -pi.bak -e 's/define-inline/define/' *_records.scm
	cd simplerun;echo '(load "../tests.scm")' | $(MEGATEST) -repl -debug $(DEBUG)

test2 : fullprep
	cd fullrun;$(MEGATEST) -runtests ez_pass,runfirst -reqtarg ubuntu/nfs/none -itempatt a/1 :runname $(RUNNAME)_a $(SERVER)
	cd fullrun;sleep 20;megatest -target ubuntu/nfs/none :runname $(RUNNAME) -set-state-status :state COMPLETED :status FORCED -testpatt runfirst -itempatt ''


test3 : fullprep
	cd fullrun;$(MEGATEST) -runtests runfirst -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b  $(SERVER) -debug 10

test4 : fullprep
	cd fullrun;$(MEGATEST) $(SERVER) &
	cd fullrun;sleep 5;$(MEGATEST) -debug $(DEBUG) -runall -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(LOGGING)
︙

Modified tests/fullrun/megatest.config from [dbf357b9a9] to [359ec4dac2].

︙
34
35
36
37
38
39
40


41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49








+
+








WACKYVAR2 #{get validvalues state}
WACKYVAR3 #{getenv USER}
WACKYVAR4 #{scheme (+ 5 6 7)}
WACKYVAR5 #{getenv sysname}/#{getenv fsname}/#{getenv datapath}
WACKYVAR6 #{scheme (args:get-arg "-target")}
PREDICTABLE the_ans
MRAH MT_RUN_AREA_HOME=#{getenv MT_RUN_AREA_HOME}
# The empty var should have a definition with null string
EMPTY_VAR

# XTERM   [system xterm]
# RUNDEAD [system exit 56]

## disks are:
## name host:/path/to/area
## -or-
︙

Added tests/fullrun/tests/test_mt_vars/empty_var.sh version [df128ce23e]. 








1
2
3
4
5
6

+
+
+
+
+
+

#!/usr/bin/env bash

if [ x$EMPTY_VAR != "x" ];then
  echo BAD EMPTY VAR!
  exit 1
fi








Modified tests/fullrun/tests/test_mt_vars/testconfig
from [601765abe8]
to [0bc69a6c64].



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



14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23














+
+
+








[setup]

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

# $BOGOUS should NOT be set
bogousnotset bogousnotset.sh

# ALT_VAR should NOT be set
altvarnotset altvarnotset.sh

# EMPTY_VAR should be an empty string
empty_var empty_var.sh

[requirements]
waiton runfirst
priority 0

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




︙







Modified tests/tests.scm
from [6debbc62bb]
to [2e981fdc13].




︙


98
99
100
101
102
103
104







105
106
107
108
109
110
111

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118








+
+
+
+
+
+
+








						    (db:get-keys *db*)
						    '(("SYSTEM" "key1")("OS" "key2"))
						    "myrun" 
						    "new"
						    "n/a" 
						    "bob")))
(define keys (db:get-keys *db*))

;;======================================================================
;; D B
;;======================================================================
(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))))
(test #f #t (list? (runs:operate-on 'print "%" "%" "%")))

;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" 
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
				       (result   (get-environment-variable "NADAFOO")))
				    (alist->env-vars prevvals)




︙












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