Megatest

Check-in [ba694f6238]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Removed backslash from strings made from continued lines. Fixed test control panel crash due to bad db read. Fixed handling of empty items lists, print error and not crash
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: ba694f62385378a4db4e93e7718586eb2a68d9a6
User & Date: matt on 2013-11-03 07:14:47
Other Links: branch diff | manifest | tags
Context
2013-11-03
07:25
Added test case for cascading failed dependencies check-in: c1101b6bec user: matt tags: v1.55
07:14
Removed backslash from strings made from continued lines. Fixed test control panel crash due to bad db read. Fixed handling of empty items lists, print error and not crash check-in: ba694f6238 user: matt tags: v1.55
00:20
set-busy-handler must also be excluded on writes for read-only db check-in: 99599de4c3 user: icfadm tags: v1.55
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified configf.scm from [a206263cb1] to [13e344a884].

︙
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132














133
134
135
136
137
138
139

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








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








    (if targ
	(or (configf:lookup config targ var)
	    (configf:lookup config "default" var))
	(configf:lookup config "default" var))))

(define-inline (configf:read-line p ht allow-processing)
  (let loop ((inl (read-line p)))
    (if (and (string? inl)
	     (not (string-null? inl))
	     (equal? "\\" (string-take-right inl 1))) ;; last character is \ 
	(let ((nextl (read-line p)))
	  (if (not (eof-object? nextl))
	      (loop (string-append inl nextl))))
	(if (and allow-processing 
		 (not (eq? allow-processing 'return-string)))
	    (configf:process-line inl ht)
	    inl))))
    (let ((cont-line (and (string? inl)
			  (not (string-null? inl))
			  (equal? "\\" (string-take-right inl 1)))))
      (if cont-line ;; last character is \ 
	  (let ((nextl (read-line p)))
	    (if (not (eof-object? nextl))
		(loop (string-append (if cont-line 
					 (string-take inl (- (string-length inl) 1))
					 inl)
				     nextl))))
	  (if (and allow-processing 
		   (not (eq? allow-processing 'return-string)))
	      (configf:process-line inl ht)
	      inl)))))

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

Modified dashboard-tests.scm from [e5436ec9f2] to [7d38654acd].

︙
372
373
374
375
376
377
378

379
380
381


382
383
384
385
386
387
388
389
390
391
392
393
394
395
396


397
398
399
400
401
402
403

372
373
374
375
376
377
378
379
380
381

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405
406








+


-
+
+














-
+
+








							      (set! testdat-path (conc rundir "/testdat.db"))
							      0))))
				    (need-update   (or (and (> curr-mod-time db-mod-time)
							    (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
						       (> (current-milliseconds)(+ last-update 10000))     ;; force update even 10 seconds
						       request-update))
				    (newtestdat (if need-update 
						    ;; NOTE: BUG HIDER, try to eliminate this exception handler
						    (handle-exceptions
						     exn 
						     (debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
						     (debug:print-info 0 "WARNING: test db access issue for test " test-id ": " ((condition-property-accessor 'exn 'message) exn))
						     (make-db:test)
						     (let* ((newdat (open-run-close db:get-test-info-by-id db test-id ))
							    (tstdat (if newdat
									(open-run-close tests:testdat-get-testinfo db test-id #f)
									'())))
						       (if (and newdat 
								(not (null? tstdat))) ;; (update-time cpuload diskfree run-duration)
							   (let* ((rec      (car tstdat))
								  (cpuload  (vector-ref rec 1))
								  (diskfree (vector-ref rec 2))
								  (run-dur  (vector-ref rec 3)))
							     (db:test-set-run_duration! newdat run-dur)
							     (db:test-set-diskfree!     newdat diskfree)
							     (db:test-set-cpuload!      newdat cpuload)))
						       ;; (debug:print 0 "newdat=" newdat)
						       newdat))
						       newdat)
						     )
						    #f)))
			       ;; (debug:print 0 "newtestdat=" newtestdat)
			       (cond
				((and need-update newtestdat)
				 (set! testdat newtestdat)
				 (set! teststeps    (db:get-compressed-steps test-id work-area: rundir))
				 (set! logfile      (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
︙

Modified db.scm from [e07d55450c] to [b34cccd126].

︙
88
89
90
91
92
93
94
95
96
97
98
99





100
101
102
103
104
105
106

88
89
90
91
92
93
94





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








-
-
-
-
-
+
+
+
+
+








    db))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db   (if idb 
		       (if (procedure? idb)
			   (idb)
			   idb)
		       (open-db)))
      (let* ((db   (cond
		    ((sqlite3:database? idb) idb)
		    ((not idb)               (open-db))
		    ((procedure? idb)       (idb))
		    (else   	            (open-db))))
	     (res #f))
	(set! res (apply proc db params))
	(if (not idb)(sqlite3:finalize! db))
	(debug:print-info 11 "open-run-close-no-exception-handling END" )
	res)
      #f))
︙
1912
1913
1914
1915
1916
1917
1918
1919

1920
1921
1922
1923
1924
1925
1926

1912
1913
1914
1915
1916
1917
1918

1919
1920
1921
1922
1923
1924
1925
1926








-
+








    (debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", query=" query ", params=" params)
    (if query
	;; hand queries off to the write queue
	(let ((response (case *transport-type*
			  ((http)
			   (debug:print-info 7 "Queuing item " item " for wrapped write")
			   (db:queue-write-and-wait db qry-sig query params))
			  (else  
			  (else 
			   (apply sqlite3:execute db query params)
			   #t))))
	  (debug:print-info 7 "Received " response " from wrapped write")
	  (server:reply return-address qry-sig response response))
	;; otherwise if appropriate flush the queue (this is a read or complex query)
	(begin
	  (cond
︙
2166
2167
2168
2169
2170
2171
2172

2173
2174
2175
2176
2177
2178
2179
2180








2181
2182
2183
2184
2185
2186
2187

2166
2167
2168
2169
2170
2171
2172
2173








2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188








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








  (let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area))
	 (res '()))
    (if (sqlite3:database? tdb)
	(handle-exceptions
	 exn
	 (debug:print 0 "ERROR: error on access to testdat for test with id " test-id)
	 '()
	 (begin
	 (sqlite3:for-each-row 
	  (lambda (id test-id stepname state status event-time logfile)
	    (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
	  tdb
	  "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
	  test-id)
	 (sqlite3:finalize! tdb)
	 (reverse res))
	   (sqlite3:for-each-row 
	    (lambda (id test-id stepname state status event-time logfile)
	      (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
	    tdb
	    "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
	    test-id)
	   (sqlite3:finalize! tdb)
	   (reverse res)))
	'())))

;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id #!key (work-area #f))
  (let ((steps   (db:get-steps-for-test db test-id work-area: work-area)))
    ;; organise the steps for better readability
︙

Modified db_records.scm from [e634aaf404] to [a8b0eafe9a]. 

1

2
3
4
5
6
7
8


1
2
3
4
5
6
7
8

-
+








(define (make-db:test)(make-vector 6))
(define (make-db:test)(make-vector 20))
(define-inline (db:test-get-id           vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id       vec) (vector-ref vec 1))
(define-inline (db:test-get-testname     vec) (vector-ref vec 2))
(define-inline (db:test-get-state        vec) (vector-ref vec 3))
(define-inline (db:test-get-status       vec) (vector-ref vec 4))
(define-inline (db:test-get-event_time   vec) (vector-ref vec 5))
(define-inline (db:test-get-host         vec) (vector-ref vec 6))
︙

Modified items.scm from [225b8827e5] to [efb067b49e].

︙
67
68
69
70
71
72
73
74
75
76








77
78
79
80
81
82
83

67
68
69
70
71
72
73



74
75
76
77
78
79
80
81
82
83
84
85
86
87
88








-
-
-
+
+
+
+
+
+
+
+








			       (list? x))
			     (map (lambda (x)
				    (debug:print 6 "item-assoc->item-list x: " x)
				    (if (< (length x) 2)
					(begin
					  (debug:print 0 "ERROR: malformed items spec " (string-intersperse x " "))
					  (list (car x)'()))
					(let ((name (car x))
					      (items (cadr x)))
					  (list name (string-split items)))))
					(let* ((name (car x))
					       (items (cadr x))
					       (ilist (list name (if (string? items)
								     (string-split items)
								     '()))))
					  (if (null? ilist)
					      (debug:print 0 "ERROR: No items specified for " name))
					  ilist)))
				  itemsdat))))
	(let ((debuglevel 5))
	  (debug:print 5 "item-assoc->item-list: itemsdat => itemlst ")
	  (if (debug:debug-mode 5)
	      (begin
		(pp itemsdat)
		(print " => ")
︙

Modified runs.scm from [4db13ad8f7] to [4c5e683265].

︙
434
435
436
437
438
439
440
441

442
443
444
445
446
447
448

434
435
436
437
438
439
440

441
442
443
444
445
446
447
448








-
+








	(set-megatest-env-vars run-id inrunname: runname) ;; these may be needed by the launching process
	(let ((items-list (items:get-items-from-config tconfig)))
	  (if (list? items-list)
	      (begin
		(tests:testqueue-set-items! test-record items-list)
		(list hed tal reg reruns))
	      (begin
		(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
		(debug:print 0 "ERROR: The proc from reading the items table did not yield a list - please report this")
		(exit 1))))))

     ((and (null? fails)
	   (not (null? non-completed)))
      (let* ((allinqueue (map (lambda (x)(if (string? x) x (db:test-get-testname x)))
        		      (append newtal reruns)))
	     ;; prereqstrs is a list of test names as strings that are prereqs for hed
︙

Modified tests.scm from [72fd2eb38f] to [0d9cac1a4f].

︙
735
736
737
738
739
740
741

742
743
744
745
746
747






748
749
750
751
752
753
754

735
736
737
738
739
740
741
742






743
744
745
746
747
748
749
750
751
752
753
754
755








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








	  (sqlite3:finalize! tdb))
	(debug:print 2 "Can't update testdat.db for test " test-id " read-only or non-existant"))))
    
(define (tests:testdat-get-testinfo db test-id work-area)
   (let ((tdb         (db:open-test-db-by-test-id db test-id work-area: work-area))
	 (res         '()))
     (if (sqlite3:database? tdb)
	 (begin
	 (sqlite3:for-each-row
	  (lambda (update-time cpuload diskfree run-duration)
	    (set! res (cons (vector update-time cpuload diskfree run-duration) res)))
	  tdb
	  "SELECT update_time,cpuload,diskfree,run_duration FROM test_rundat ORDER BY update_time ASC;")
	 (sqlite3:finalize! tdb))
	   (sqlite3:for-each-row
	    (lambda (update-time cpuload diskfree run-duration)
	      (set! res (cons (vector update-time cpuload diskfree run-duration) res)))
	    tdb
	    "SELECT update_time,cpuload,diskfree,run_duration FROM test_rundat ORDER BY update_time ASC;")
	   (sqlite3:finalize! tdb)))
     res))

;;======================================================================
;; A R C H I V I N G
;;======================================================================

(define (test:archive db test-id)
︙

Added tests/fullrun/tests/no_items/testconfig version [ee0c082186]. 

















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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

[ezsteps]
listfiles ls

[items]
FOO

[test_meta]
author matt
owner  bob
description This test runs a single ezstep which is expected to pass \
but there is an items definition with no items. This should evoke an \
error.

tags first,single
reviewed 09/10/2011, by Matt













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