Megatest

Check-in [a19566e0b3]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Roll up RUNNING from subtests prioritised over PASS and FAIL. More work done towards moving values, expected, tol and units to test_data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | test_step_table_good
Files: files | file ages | folders
SHA1: a19566e0b3cdb31f1a7b0ccb7b3d6f1dabaea1a9
User & Date: matt on 2011-09-08 23:59:54
Other Links: manifest | tags
Context
2011-09-10
23:03
Added lineitem data uploading and tests check-in: 1eb40d3a48 user: matt tags: trunk
2011-09-08
23:59
Roll up RUNNING from subtests prioritised over PASS and FAIL. More work done towards moving values, expected, tol and units to test_data check-in: a19566e0b3 user: matt tags: trunk, test_step_table_good
20:56
Partial moved all values, expected, tol, units to test_data check-in: b846d139bd user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dashboard-tests.scm from [41c37aec4d] to [563dea2bd2].

︙︙
60
61
62
63
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

			 (lambda (testdat)
			   (db:test-get-comment testdat)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-id testdat)))
	    (store-label "testvalue"
			 (iup:label "TestValue                          "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-value testdat)))
	    (store-label "testexpectedvalue"
			 (iup:label "TestExpectedValue                  "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-expected_value testdat)))
	    (store-label "testtol"
			 (iup:label "TestTol                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-tol testdat)))
	    (store-label "testunits"
			 (iup:label "TestUnits                          "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-units testdat)))
	    )))))

;;======================================================================
;; Test meta panel
;;======================================================================
(define (test-meta-panel testmeta store-meta)
  (iup:frame 








|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|








60
61
62
63
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

			 (lambda (testdat)
			   (db:test-get-comment testdat)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-id testdat)))
;;	    (store-label "testvalue"
;;			 (iup:label "TestValue                          "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-value testdat)))
;;	    (store-label "testexpectedvalue"
;;			 (iup:label "TestExpectedValue                  "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-expected_value testdat)))
;;	    (store-label "testtol"
;;			 (iup:label "TestTol                             "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-tol testdat)))
;;	    (store-label "testunits"
;;			 (iup:label "TestUnits                          "
;;				    #:expand "HORIZONTAL")
;;			 (lambda (testdat)
;;			   (db:test-get-units testdat)))
	    )))))

;;======================================================================
;; Test meta panel
;;======================================================================
(define (test-meta-panel testmeta store-meta)
  (iup:frame
︙︙

Modified db.scm from [62f0fe7bb7] to [3658d50d45].

︙︙
136
137
138
139
140
141
142

143
144
145
146
147
148
149

	     ;; "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.25)
	 (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 REAL,








>








136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

	     ;; "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.25)
	 (begin
	   (sqlite3:execute db "DROP TABLE test_data;")
	   (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 REAL,
︙︙

Modified keys.scm from [e97ed0b788] to [3c8c631b29].

︙︙
63
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

(define-inline (keys->valslots keys) ;; => ?,?,? ....
  (string-intersperse (map (lambda (x) "?") keys) ","))

(define-inline (keys->key/field keys . additional)
  (string-join (map (lambda (k)(conc (key:get-fieldname k) " " (key:get-fieldtype k)))(append keys additional)) ","))

(define (args:usage . a) #f)





;; Using the keys pulled from the database (initially set from the megatest.config file)
;; look for the equivalent value on the command line and add it to a list, or #f if not found.
;; default => (val1 val2 val3 ...)
;; withkey => (:key1 val1 :key2 val2 :key3 val3 ...)
(define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE!
  (let* ((keynames   (map key:get-fieldname keys))
	 (argkeys    (map (lambda (k)(conc ":" k)) keynames))
	 (withkey    (not (null? withkey)))
	 (newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args [args assumes ("calling-prog-name" .... ) ]
    ;;(debug:print 0 "remargs: " remargs " newremargs: " newremargs)
    (apply append (map (lambda (x)
			 (let ((val (args:get-arg x)))
			   ;; (debug:print 0 "x: " x " val: " val)
			   (if (not val)



			       ;; (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")

			       (set! val "default"))
			   (if withkey (list x val) (list val))))
		       argkeys))))
  
;; Given a list of keys (list of vectors) return an alist ((key argval) ...)
(define (keys->alist keys defaultval)
  (let* ((keynames   (map key:get-fieldname keys))
	 (newremargs (args:get-args (cons "blah" remargs) (map (lambda (k)(conc ":" k)) keynames) '() args:arg-hash 0))) ;; the cons blah works around a bug in args








>
>
>
>















>
>
>
|
>
|








63
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

(define-inline (keys->valslots keys) ;; => ?,?,? ....
  (string-intersperse (map (lambda (x) "?") keys) ","))

(define-inline (keys->key/field keys . additional)
  (string-join (map (lambda (k)(conc (key:get-fieldname k) " " (key:get-fieldtype k)))(append keys additional)) ","))

(define (args:usage . a) #f)

;; keys->vallist is called several times (quite unnecessarily), use this hash to suppress multiple
;; reporting of missing keys on the command line.
(define keys:warning-suppress-hash (make-hash-table))

;; Using the keys pulled from the database (initially set from the megatest.config file)
;; look for the equivalent value on the command line and add it to a list, or #f if not found.
;; default => (val1 val2 val3 ...)
;; withkey => (:key1 val1 :key2 val2 :key3 val3 ...)
(define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE!
  (let* ((keynames   (map key:get-fieldname keys))
	 (argkeys    (map (lambda (k)(conc ":" k)) keynames))
	 (withkey    (not (null? withkey)))
	 (newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args [args assumes ("calling-prog-name" .... ) ]
    ;;(debug:print 0 "remargs: " remargs " newremargs: " newremargs)
    (apply append (map (lambda (x)
			 (let ((val (args:get-arg x)))
			   ;; (debug:print 0 "x: " x " val: " val)
			   (if (not val)
			       (begin
				 (if (not (hash-table-ref/default keys:warning-suppress-hash x #f))
				     (begin
				       (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
				       (hash-table-set! keys:warning-suppress-hash x #t)))
				 (set! val "default")))
			   (if withkey (list x val) (list val))))
		       argkeys))))
  
;; Given a list of keys (list of vectors) return an alist ((key argval) ...)
(define (keys->alist keys defaultval)
  (let* ((keynames   (map key:get-fieldname keys))
	 (newremargs (args:get-args (cons "blah" remargs) (map (lambda (k)(conc ":" k)) keynames) '() args:arg-hash 0))) ;; the cons blah works around a bug in args
︙︙

Modified runs.scm from [653baf7c64] to [98ddc7507a].

︙︙
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100

			test-name
			pth 
			;; (conc "," (string-intersperse tags ",") ",")
			))
     item-paths )))

;; get the previous record for when this test was run where all keys match but runname

(define (test:get-previous-test-run-records db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)








>
|








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

			test-name
			pth 
			;; (conc "," (string-intersperse tags ",") ",")
			))
     item-paths )))

;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
(define (test:get-previous-test-run-record db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)
︙︙
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

		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (car results)))))))))
    
;; get the previous record for when this test was run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records

(define (test:get-matching-previous-test-run-records db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
     (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
    (if (not keyvals)
	#f

	(let ((prev-run-ids '()))
	  (apply sqlite3:for-each-row
		 (lambda (id)
		   (set! prev-run-ids (cons id prev-run-ids)))
		 db
		 (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) #f ;; no previous runs? return #f
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 








|
|
>













<
>










|








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

		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (car results)))))))))
    
;; get the previous records for when these tests were run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records? This one looks for all matching tests
;; can use wildcards. 
(define (test:get-matching-previous-test-run-records db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
     (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
    (if (not keyvals)

	'()
	(let ((prev-run-ids '()))
	  (apply sqlite3:for-each-row
		 (lambda (id)
		   (set! prev-run-ids (cons id prev-run-ids)))
		 db
		 (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each
︙︙
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let* ((real-status status)
	 (item-path   (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
	 (otherdat    (if dat dat (make-hash-table)))
	 ;; before proceeding we must find out if the previous test (where all keys matched except runname)
	 ;; was WAIVED if this test is FAIL
	 (waived   (if (equal? status "FAIL")
		       (let ((prev-test (test:get-previous-test-run-records db run-id test-name item-path)))
			 (if prev-test ;; true if we found a previous test in this run series
			     (let ((prev-status (db:test-get-status   prev-test))
				   (prev-state  (db:test-get-state    prev-test))
				   (prev-comment (db:test-get-comment prev-test)))
			       (debug:print 4 "prev-status " prev-status ", prev-state " prev-state ", prev-comment " prev-comment)
			       (if (and (equal? prev-state  "COMPLETED")
					(equal? prev-status "WAIVED"))








|








174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let* ((real-status status)
	 (item-path   (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
	 (otherdat    (if dat dat (make-hash-table)))
	 ;; before proceeding we must find out if the previous test (where all keys matched except runname)
	 ;; was WAIVED if this test is FAIL
	 (waived   (if (equal? status "FAIL")
		       (let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path)))
			 (if prev-test ;; true if we found a previous test in this run series
			     (let ((prev-status (db:test-get-status   prev-test))
				   (prev-state  (db:test-get-state    prev-test))
				   (prev-comment (db:test-get-comment prev-test)))
			       (debug:print 4 "prev-status " prev-status ", prev-state " prev-state ", prev-comment " prev-comment)
			       (if (and (equal? prev-state  "COMPLETED")
					(equal? prev-status "WAIVED"))
︙︙
225
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240


241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

	  (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))
	     (or (equal? status "PASS")
		 (equal? status "WARN")
		 (equal? status "FAIL")
		 (equal? status "WAIVED")))

	(begin
	  (sqlite3:execute 
	   db
	   "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN' OR status='WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name run-id test-name)


	  (sqlite3:execute
	   db
	   "UPDATE tests
             SET state=CASE WHEN (SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 
                          'RUNNING'
                       ELSE 'COMPLETED' END,
                status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name)))
    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
			 (if waived waived comment) run-id test-name item-path))
    ))









|
>








>
>
|
|
|
|


|
|
|








227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

	  (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))
	     (or (equal? status "PASS")
		 (equal? status "WARN")
		 (equal? status "FAIL")
		 (equal? status "WAIVED")
		 (equal? status "RUNNING")))
	(begin
	  (sqlite3:execute 
	   db
	   "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN' OR status='WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';"
	   run-id test-name run-id test-name run-id test-name)
	  (if (equal? status "RUNNING") ;; running takes priority over all other states, force the test state to RUNNING
	      (sqlite3:execute db "UPDATE tests SET state=? WHERE run_id=? AND testname=? AND item_path='';" run-id test-name)
	      (sqlite3:execute
	       db
	       "UPDATE tests
                       SET state=CASE WHEN (SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 
                          'RUNNING'
                       ELSE 'COMPLETED' END,
                          status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
                       WHERE run_id=? AND testname=? AND item_path='';"
	       run-id test-name run-id test-name))))
    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(sqlite3:execute db "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
			 (if waived waived comment) run-id test-name item-path))
    ))
︙︙
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880

	      ;; read configs with tricks turned off (i.e. no system)
	      (test-conf    (if testexists (read-config test-configf #f #f)(make-hash-table))))
	 (runs:update-test_meta db test-name test-conf)))
     test-names)))
	 
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys)
  (let* ((new-run-id   (register-run db keys))
	 (prev-tests   (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
	 (curr-tests   (db-get-tests-for-run db new-run-id "%" "%"))
	 (curr-tests-hash (make-hash-table)))
    ;; index the already saved tests by testname and itempath in curr-tests-hash
    (for-each
     (lambda (testdat)
       (let* ((testname  (db:test-get-testname testdat))
	      (item-path (db:test-get-item-path testdat))
	      (full-name (conc testname "/" item-path)))








|
|
|








869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885

	      ;; read configs with tricks turned off (i.e. no system)
	      (test-conf    (if testexists (read-config test-configf #f #f)(make-hash-table))))
	 (runs:update-test_meta db test-name test-conf)))
     test-names)))
	 
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys)
  (let* ((new-run-id      (register-run db keys))
	 (prev-tests      (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
	 (curr-tests      (db-get-tests-for-run db new-run-id "%" "%"))
	 (curr-tests-hash (make-hash-table)))
    ;; index the already saved tests by testname and itempath in curr-tests-hash
    (for-each
     (lambda (testdat)
       (let* ((testname  (db:test-get-testname testdat))
	      (item-path (db:test-get-item-path testdat))
	      (full-name (conc testname "/" item-path)))
︙︙
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919

	      (full-name (conc testname "/" item-path))
	      (prev-test-dat (hash-table-ref/default curr-tests-hash full-name #f))
	      (test-steps      (db:get-steps-for-test db (db:test-get-id testdat)))
	      (new-test-record #f))
	 ;; replace these with insert ... select
	 (apply sqlite3:execute 
		db 
		(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,value,expected_value,tol,units,first_err,first_warn) "
		      "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
		new-run-id (cddr (vector->list testdat)))
	 (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path)))
	 (hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
	 ;; Now duplicate the test steps
	 (debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	 (sqlite3:execute 
	  db 
	  (conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
		"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ;; Now duplicate the test data
	 (debug:print 4 "Copying records in test_data from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	 (sqlite3:execute 
	  db 
	  (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,comment) "
		"SELECT " (db:test-get-id new-testdat) ",category,variable,value,comment FROM test_data WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ))
     prev-tests)))
	 
     








|
|














|
|






895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924

	      (full-name (conc testname "/" item-path))
	      (prev-test-dat (hash-table-ref/default curr-tests-hash full-name #f))
	      (test-steps      (db:get-steps-for-test db (db:test-get-id testdat)))
	      (new-test-record #f))
	 ;; replace these with insert ... select
	 (apply sqlite3:execute 
		db 
		(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn) "
		      "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
		new-run-id (cddr (vector->list testdat)))
	 (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path)))
	 (hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
	 ;; Now duplicate the test steps
	 (debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	 (sqlite3:execute 
	  db 
	  (conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
		"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ;; Now duplicate the test data
	 (debug:print 4 "Copying records in test_data from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	 (sqlite3:execute 
	  db 
	  (conc "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected_value,tol,units,comment) "
		"SELECT " (db:test-get-id new-testdat) ",category,variable,value,expected_value,tol,units,comment FROM test_data WHERE test_id=?;")
	  (db:test-get-id testdat))
	 ))
     prev-tests)))

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