Megatest

Check-in [1888a270be]
Login
Overview
Comment:Merged v1.60 into multi-transport
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi-transport
Files: files | file ages | folders
SHA1: 1888a270bebb08d94a1fb8cee1d22ddd92bc8169
User & Date: mrwellan on 2014-12-01 13:54:59
Other Links: branch diff | manifest | tags
Context
2014-12-01
19:39
Added back auto fallback to direct fs writes/reads check-in: 2ce6e734b4 user: mrwellan tags: multi-transport
13:54
Merged v1.60 into multi-transport check-in: 1888a270be user: mrwellan tags: multi-transport
2014-11-30
12:19
Merged ABORT changes check-in: 12a41bff5e user: matt tags: v1.60
10:39
Merged in try-nanomsg in prep for merging to one multi-transport code base check-in: 3fda9c352d user: matt tags: multi-transport
Changes

Modified archive.scm from [653c86c4f2] to [907e35ab0e].

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

;; Copyright 2006-2012, 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.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(declare (unit archive))
(declare (uses db))
(declare (uses common))

|
















>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
;; Copyright 2006-2014, 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.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(declare (unit archive))
(declare (uses db))
(declare (uses common))

Modified common.scm from [d99f383a66] to [a6b7130b40].

186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
201
202
203
204
    (1 "WARN")
    (2 "FAIL")
    (3 "CHECK")
    (4 "n/a")
    (5 "WAIVED")
    (6 "SKIP")
    (7 "DELETED")
    (8 "STUCK/DEAD")))


;; These are stopping conditions that prevent a test from being run
(define *common:cant-run-states-sym* 
  '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))

;;======================================================================
;; D E B U G G I N G   S T U F F 
;;======================================================================

(define *verbosity*         1)
(define *logging*           #f)







|
>



|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
    (1 "WARN")
    (2 "FAIL")
    (3 "CHECK")
    (4 "n/a")
    (5 "WAIVED")
    (6 "SKIP")
    (7 "DELETED")
    (8 "STUCK/DEAD")
    (9 "ABORT")))

;; These are stopping conditions that prevent a test from being run
(define *common:cant-run-states-sym* 
  '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE ABORT))

;;======================================================================
;; D E B U G G I N G   S T U F F 
;;======================================================================

(define *verbosity*         1)
(define *logging*           #f)
637
638
639
640
641
642
643

644
  (cond
   ((equal? status "PASS")    "green")
   ((equal? status "FAIL")    "red")
   ((equal? status "WARN")    "orange")
   ((equal? status "KILLED")  "orange")
   ((equal? status "KILLREQ") "purple")
   ((equal? status "RUNNING") "blue")

   (else "black")))







>

638
639
640
641
642
643
644
645
646
  (cond
   ((equal? status "PASS")    "green")
   ((equal? status "FAIL")    "red")
   ((equal? status "WARN")    "orange")
   ((equal? status "KILLED")  "orange")
   ((equal? status "KILLREQ") "purple")
   ((equal? status "RUNNING") "blue")
   ((equal? status "ABORT")   "brown")
   (else "black")))

Modified rmt.scm from [f7b514fa2e] to [d0047679a0].

361
362
363
364
365
366
367

368
369
370
371
372
373
374
			 run-ids
			 (rmt:get-all-run-ids)))
	(result      '()))
    (if (null? run-id-list)
	'()
	(for-each 
	 (lambda (th)

	   (thread-join! th)) ;; I assume that joining completed threads just moves on
	 (let loop ((hed     (car run-id-list))
		    (tal     (cdr run-id-list))
		    (threads '()))
	   (let* ((newthread (make-thread
			      (lambda ()
				(let ((res (rmt:send-receive 'get-tests-for-run-mindata hed (list hed testpatt states status not-in))))







>







361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
			 run-ids
			 (rmt:get-all-run-ids)))
	(result      '()))
    (if (null? run-id-list)
	'()
	(for-each 
	 (lambda (th)

	   (thread-join! th)) ;; I assume that joining completed threads just moves on
	 (let loop ((hed     (car run-id-list))
		    (tal     (cdr run-id-list))
		    (threads '()))
	   (let* ((newthread (make-thread
			      (lambda ()
				(let ((res (rmt:send-receive 'get-tests-for-run-mindata hed (list hed testpatt states status not-in))))
382
383
384
385
386
387
388










389
390
391
392
393
394
395
		  (newthreads (cons newthread threads)))
	     (thread-start! newthread)
	     (thread-sleep! 0.5) ;; give that thread some time to start
	     (if (null? tal)
		 newthreads
		 (loop (car tal)(cdr tal) newthreads))))))
    result))











(define (rmt:delete-test-records run-id test-id)
  (rmt:send-receive 'delete-test-records run-id (list run-id test-id)))

;; This is not needed as test steps are deleted on test delete call
;;
;; (define (rmt:delete-test-step-records run-id test-id)







>
>
>
>
>
>
>
>
>
>







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
		  (newthreads (cons newthread threads)))
	     (thread-start! newthread)
	     (thread-sleep! 0.5) ;; give that thread some time to start
	     (if (null? tal)
		 newthreads
		 (loop (car tal)(cdr tal) newthreads))))))
    result))

;; ;; IDEA: Threadify these - they spend a lot of time waiting ...
;; ;;
;; (define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
;;   (let ((run-id-list (if run-ids
;; 			 run-ids
;; 			 (rmt:get-all-run-ids))))
;;     (apply append (map (lambda (run-id)
;; 			 (rmt:send-receive 'get-tests-for-run-mindata run-id (list run-ids testpatt states status not-in)))
;; 		       run-id-list))))

(define (rmt:delete-test-records run-id test-id)
  (rmt:send-receive 'delete-test-records run-id (list run-id test-id)))

;; This is not needed as test steps are deleted on test delete call
;;
;; (define (rmt:delete-test-step-records run-id test-id)