Megatest

Check-in [dd5766961c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Partial implementation of loading arbitrary test data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: dd5766961ce96109590a97c4046ae82af5e239cb
User & Date: matt on 2011-09-05 22:34:14
Other Links: manifest | tags
Context
2011-09-05
22:49
Completed loading arbitrary test data check-in: 9bc4b32214 user: matt tags: trunk
22:34
Partial implementation of loading arbitrary test data check-in: dd5766961c user: matt tags: trunk
17:11
completed rollup and updated remove-runs to preserve test runs where there are still references in the db check-in: 94a65715c9 user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [361ea4a752] to [3897afab0f]. 

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

13
14
15
16
17
18
19

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19












-
+








;;======================================================================
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use sqlite3 srfi-1 posix regex-case base64 format dot-locking)
(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml)
(require-extension sqlite3 regex posix)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

;; (require-library margs)
(include "margs.scm")
︙

Modified db.scm from [8d79c7b2db] to [8af0a21b47].

︙
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

48
49
50
51
52
53
54

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
48
49
50
51
52
53
54








-
+




-
+












-
+








    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)
	(let* ((keys     (config-get-fields configdat))
	       (havekeys (> (length keys) 0))
	       (keystr   (keys->keystr keys))
	       (fieldstr (keys->key/field keys)))
	  ;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
	  (sqlite3:execute db "CREATE TABLE keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
	  (for-each (lambda (key)
		      (sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" (key:get-fieldname key)(key:get-fieldtype key)))
		    keys)
	  (sqlite3:execute db (conc 
			    "CREATE TABLE runs (id INTEGER PRIMARY KEY, " 
			    "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, " 
			    fieldstr (if havekeys "," "")
			    "runname TEXT,"
			    "state TEXT DEFAULT '',"
			    "status TEXT DEFAULT '',"
			    "owner TEXT DEFAULT '',"
			    "event_time TIMESTAMP,"
			    "comment TEXT DEFAULT '',"
			    "fail_count INTEGER DEFAULT 0,"
			    "pass_count INTEGER DEFAULT 0,"
			    "CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
	  (sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
	  (sqlite3:execute db 
			"CREATE TABLE tests 
			"CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id     INTEGER,
                     testname   TEXT,
                     host       TEXT DEFAULT 'n/a',
                     cpuload    REAL DEFAULT -1,
                     diskfree   INTEGER DEFAULT -1,
                     uname      TEXT DEFAULT 'n/a',
︙
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
79
80
81



82
83

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99


100
101
102












103
104
105
106
107
108
109
110
111
112
113
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
153
154
155
156






157

158
159
160
161
162
163
164

64
65
66
67
68
69
70

71
72
73
74
75
76
77
78



79
80
81
82

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97


98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182








-
+







-
-
-
+
+
+

-
+














-
-
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+











-
+
-
-
-
-
-
-
-
-
-
-












+
+
+
+
+
+
+
+
+
+
+




















+
+
+
+
+
+
-
+








                     event_time TIMESTAMP,
                     fail_count INTEGER DEFAULT 0,
                     pass_count INTEGER DEFAULT 0,
                     CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)
          );")
	  (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname);")
	  (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;")
	  (sqlite3:execute db "CREATE TABLE test_steps 
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps 
                              (id INTEGER PRIMARY KEY,
                               test_id INTEGER, 
                               stepname TEXT, 
                               state TEXT DEFAULT 'NOT_STARTED', 
                               status TEXT DEFAULT 'n/a',event_time TIMESTAMP,
                               comment TEXT DEFAULT '',
                               CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
	  (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
	  (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (id,var));")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
	  (db:set-var db "MEGATEST_VERSION" megatest-version)
	  (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
	  (patch-db db)))
    db))

;;======================================================================
;; TODO:
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
;;======================================================================
(define (patch-db db)
  (handle-exceptions
   exn
   (begin
     (print "Exception: " exn)
     (print "ERROR: Possible out of date schema, attempting to add table metadata...")
     (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (id,var));")
     (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
     (db:set-var db "MEGATEST_VERSION" 1.17)
     )
   (let ((mver (db:get-var db "MEGATEST_VERSION")))
   (let ((mver (db:get-var db "MEGATEST_VERSION"))
	 (test-meta-def "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY,
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL,
                                     avg_disk    REAL,
                                     tags        TEXT DEFAULT '',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));"))
     (print "Current schema version: " mver " current megatest version: " megatest-version)
     (if (not mver)
	(begin
	  (print "Adding megatest-version to metadata")
	  (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version))))
     ;;      (if (< mver 1.18)
     ;; 	 (begin
     ;; 	   (print "Adding tags column to tests table")
     ;; 	   (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';")))
     (if (< mver 1.21)
	 (begin
	   (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY,
	   (sqlite3:execute db test-meta-def)
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL,
                                     avg_disk    REAL,
                                     tags        TEXT DEFAULT '',
                                CONSTRAINT test_meta_contstraint UNIQUE (id,testname));")
	   (for-each 
	    (lambda (stmt)
	      (sqlite3:execute db stmt))
	    (list 
	     "ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL
	     "ALTER TABLE tests ADD COLUMN value REAL;"
	     "ALTER TABLE tests ADD COLUMN tol REAL;"
	     "ALTER TABLE tests ADD COLUMN tol_perc REAL;"
	     "ALTER TABLE tests ADD COLUMN first_err TEXT;"
	     "ALTER TABLE tests ADD COLUMN first_warn TEXT;"
	     "ALTER TABLE tests ADD COLUMN units TEXT;"
	     ))))
     (if (< mver 1.22)
	 (begin
	   (sqlite3:execute db "DROP TABLE test_meta;")
	   (sqlite3:execute db test-meta-def)
	   (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                test_id INTEGER,
                                category TEXT DEFAULT '',
                                variable TEXT,
                                value,
                                comment TEXT DEFAULT '',
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")))
     (if (< mver megatest-version)
	 (db:set-var db "MEGATEST_VERSION" megatest-version)))))

;;======================================================================
;; meta get and set vars
;;======================================================================

;; returns number if string->number is successful, string otherwise
(define (db:get-var db var)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db "SELECT val FROM metadat WHERE var=?;" var)
    (if (string? res)
	(let ((valnum (string->number res)))
	  (if valnum valnum res))
	res)))

(define (db:set-var db var val)
  ;; Odd, I thought that if a constraint was placed on column then an insert with duplicate data
  ;; would fail and the insert would fall back to replace.
  ;; NB// accidently included primary key in the unique constraint which does not work.
  (let ((have (db:get-var db var)))
    ;; (if have
    ;; (sqlite3:execute db "UPDATE metadat SET val=? WHERE var=?;" val var)
  (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))
	(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))

;; use a global for some primitive caching, it is just silly to re-read the db 
;; over and over again for the keys since they never change

(define *db-keys* #f)

(define (db-get-keys db)
︙
441
442
443
444
445
446
447
























448

449
450
451
452
453
454
455

459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489

490
491
492
493
494
495
496
497








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+








  (sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))

;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
  (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))

;;======================================================================
;; T E S T   D A T A 
;;======================================================================
(define (db:csv->testdata db test-id csvdata)
  (let ((csvlist (csv->list csvdata)))
    (for-each 
     (lambda (csvrow)
       (apply sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,comment) VALUES (?,?,?,?,?);"
	      test-id (take (append csvrow '("" "" "" "")) 4)))
     csvlist)))

(define (db:load-test-data db run-id test-name itemdat)
  (let* ((item-path (item-list->path itemdat))
	 (testdat (db:get-test-info db run-id test-name item-path))
	 (test-id (db:test-get-id testdat)))
    (debug:print 1 "Enter records to insert in the test_data table, four fields, comma separated per line")
    (debug:print 4 "itemdat: " itemdat ", test-name: " test-name ", test-id: " test-id)
    (let loop ((lin (read-line)))
      (if (not (eof-object? lin))
	  (begin
	    (debug:print 4 lin)
	    (db:csv->testdata db test-id lin)
	    (loop (read-line)))))))    

;;======================================================================
;; Steps
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 6))
(define-inline (db:step-get-id              vec)    (vector-ref  vec 0))
(define-inline (db:step-get-test_id         vec)    (vector-ref  vec 1))
(define-inline (db:step-get-stepname        vec)    (vector-ref  vec 2))
︙

Modified megatest-version.scm from [47e03ef807] to [0e4590aa3f]. 

1
2
3


1
2

3



-
+

;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..
(define megatest-version 1.22)
(define megatest-version 1.23)

Modified megatest.scm from [6417d3c92b] to [94499f5a91].

︙
44
45
46
47
48
49
50





51
52
53
54
55
56
57

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








+
+
+
+
+








  :value                  : value measured
  :expected_value         : value expected
  :tol                    : |value-expect| <= tol
  :units                  : name of the units for value, expected_value and tol
  :first_err              : record an error message
  :first_warn             : record a warning message

Arbitrary test data loading
  -load-test-data         : read test specific data for storage in the test_data table
                            from standard in. Each line is comma delimited with four
                            fields category,variable,value,comment

Queries
  -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
  -testpatt patt          : in list-runs show only these tests, % is the wildcard
  -itempatt patt          : in list-runs show only tests with items that match patt
  -showkeys               : show the keys used in this megatest setup

Misc
︙
118
119
120
121
122
123
124

125
126
127
128
129
130
131

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








+








			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"
			"-usequeue"
			"-rebuild-db"
︙
557
558
559
560
561
562
563

564
565
566
567
568
569
570

563
564
565
566
567
568
569
570
571
572
573
574
575
576
577








+








	  (sqlite3:finalize! db)
	  (set! *didsomething* #t))))

(if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
	(args:get-arg "-set-toplog")
	(args:get-arg "-test-status")
	(args:get-arg "-set-values")
	(args:get-arg "-load-test-data")
	(args:get-arg "-runstep")
	(args:get-arg "-summarize-items"))
    (if (not (getenv "MT_CMDINFO"))
	(begin
	  (debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
	  (exit 5))
	(let* ((startingdir (current-directory))
︙
580
581
582
583
584
585
586


587
588
589
590
591
592
593

587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602








+
+








	       (status    (args:get-arg ":status")))
	  (change-directory testpath)
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, exiting")
		(exit 1)))
	  (set! db (open-db))
	  (if (args:get-arg "-load-test-data")
	      (db:load-test-data db run-id test-name itemdat))
	  (if (args:get-arg "-setlog")
	      (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog")))
	  (if (args:get-arg "-set-toplog")
	      (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	  (if (args:get-arg "-summarize-items")
	      (tests:summarize-items db run-id test-name #t)) ;; do force here
	  (if (args:get-arg "-runstep")
︙

Modified utils/installall.sh from [0ace91fc09] to [7a7c1d6a7f].

︙
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76

62
63
64
65
66
67
68

69
70
71
72
73
74
75
76








-
+








    tar xfvz chicken-${CHICKEN_VERSION}.tar.gz
    cd chicken-${CHICKEN_VERSION}
    make PLATFORM=linux PREFIX=$PREFIX
    make PLATFORM=linux PREFIX=$PREFIX install
    cd $BUILDHOME
fi

for f in readline apropos base64 regex-literals format regex-case test coops trace; do
for f in readline apropos base64 regex-literals format regex-case test coops trace csv dot-locking; do
  chicken-install $PROX $f
done

cd $BUILDHOME

for a in `ls */*.meta|cut -f1 -d/` ; do 
    echo $a
︙

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