Diff

Not logged in

Differences From Artifact [47992ecd6a]:

To Artifact [3b72cbaf00]:


1217
1218
1219
1220
1221
1222
1223
1224
1225


1226
1227
1228
1229
1230
1231
1232
1217
1218
1219
1220
1221
1222
1223


1224
1225
1226
1227
1228
1229
1230
1231
1232







-
-
+
+







			   (string->number deadtime-str)
			   7200))) ;; two hours
    (if (number? ovr-deadtime)(set! deadtime ovr-deadtime))
    
    ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
    ;;
    ;; HOWEVER: this code in run:test seems to work fine
    ;;              (> (- (current-seconds)(+ (db:test-event_time testdat)
    ;;                     (db:test-run_duration testdat)))
    ;;              (> (- (current-seconds)(+ (dbr:test-event_time testdat)
    ;;                     (dbr:test-run_duration testdat)))
    ;;                    600) 
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
1276
1277
1278
1279
1280
1281
1282
1283
1284


1285
1286
1287
1288
1289
1290
1291
1276
1277
1278
1279
1280
1281
1282


1283
1284
1285
1286
1287
1288
1289
1290
1291







-
-
+
+







			   (string->number deadtime-str)
			   7200))) ;; two hours
    (if (number? ovr-deadtime)(set! deadtime ovr-deadtime))
    
    ;; in RUNNING or REMOTEHOSTSTART for more than 10 minutes
    ;;
    ;; HOWEVER: this code in run:test seems to work fine
    ;;              (> (- (current-seconds)(+ (db:test-event_time testdat)
    ;;                     (db:test-run_duration testdat)))
    ;;              (> (- (current-seconds)(+ (dbr:test-event_time testdat)
    ;;                     (dbr:test-run_duration testdat)))
    ;;                    600) 
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (test-id run-dir uname testname item-path)
       (if (and (equal? uname "n/a")
		(equal? item-path "")) ;; this is a toplevel test
	   ;; what to do with toplevel? call rollup?
3147
3148
3149
3150
3151
3152
3153
3154

3155
3156
3157
3158

3159
3160
3161
3162
3163
3164
3165
3147
3148
3149
3150
3151
3152
3153

3154
3155
3156
3157

3158
3159
3160
3161
3162
3163
3164
3165







-
+



-
+







			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (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 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-testname testdat) "/" (db:test-item-path testdat)))
		     (let* ((full-testname (conc (dbr:test-testname testdat) "/" (dbr:test-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))
		       (if (or (not stored-test)
			       (and stored-test
				    (> (db:test-event_time testdat)(db:test-event_time stored-test))))
				    (> (dbr:test-event_time testdat)(dbr:test-event_time stored-test))))
			   ;; this test is younger, store it in the hash
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351




3352
3353
3354
3355
3356
3357
3358
3341
3342
3343
3344
3345
3346
3347




3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358







-
-
-
-
+
+
+
+







	   ;; next should be using mt:get-tests-for-run?
	   (let ((tests             (db:get-tests-for-run-state-status dbstruct run-id waitontest-name))
		 (ever-seen         #f)
		 (parent-waiton-met #f)
		 (item-waiton-met   #f))
	     (for-each 
	      (lambda (test)
		;; (if (equal? waitontest-name (db:test-testname test)) ;; by defintion this had better be true ...
		(let* ((state             (db:test-state test))
		       (status            (db:test-status test))
		       (item-path         (db:test-item-path test))
		;; (if (equal? waitontest-name (dbr:test-testname test)) ;; by defintion this had better be true ...
		(let* ((state             (dbr:test-state test))
		       (status            (dbr:test-status test))
		       (item-path         (dbr:test-item-path test))
		       (is-completed      (equal? state "COMPLETED"))
		       (is-running        (equal? state "RUNNING"))
		       (is-killed         (equal? state "KILLED"))
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
		       ;;                                       testname-b    path-a    path-b
		       (same-itempath     (db:compare-itempaths ref-test-name item-path ref-item-path itemmaps))) ;; (equal? ref-item-path item-path)))
		  (set! ever-seen #t)