Megatest

Check-in [c418c9c6fb]
Login
Overview
Comment:Merged in v1.60 but not cleaned up
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | multi-area
Files: files | file ages | folders
SHA1: c418c9c6fbadb460bd9ebe88d8d02496a21dbced
User & Date: matt on 2015-06-16 22:40:54
Other Links: branch diff | manifest | tags
Context
2015-06-16
22:40
Merged in v1.60 but not cleaned up Closed-Leaf check-in: c418c9c6fb user: matt tags: multi-area
00:07
Mulit-dboard, attempt2. check-in: 38bb3b9948 user: matt tags: v1.60
2015-06-04
23:09
Merged in v1.60 check-in: a7184bad29 user: matt tags: multi-area
Changes

Modified .fossil-settings/ignore-glob from [32534fbc23] to [4907666f99].

37
38
39
40
41
42
43



tests/installall/megatest.db
tests/installall/monitor.db
tests/megatest.db
tests/fdktestqa/simplelinks/*
tests/fdktestqa/testqa/megatest.db
tests/fdktestqa/testqa/monitor.db
megatest-fossil-hash.scm










>
>
>
37
38
39
40
41
42
43
44
45
46
tests/installall/megatest.db
tests/installall/monitor.db
tests/megatest.db
tests/fdktestqa/simplelinks/*
tests/fdktestqa/testqa/megatest.db
tests/fdktestqa/testqa/monitor.db
megatest-fossil-hash.scm
tests/release/runs/*
tests/release/links/*
tests/release/megatest.db

Modified api.scm from [9b234ec5e5] to [78a6b34423].

38
39
40
41
42
43
44

45
46
47
48
49
50
51
    get-run-status
    register-run
    get-tests-for-run
    get-test-id
    get-tests-for-runs-mindata
    get-run-name-from-id
    get-runs

    get-all-run-ids
    get-prev-run-ids
    get-run-ids-matching-target
    get-runs-by-patt
    get-steps-data
    get-steps-for-test
    login







>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    get-run-status
    register-run
    get-tests-for-run
    get-test-id
    get-tests-for-runs-mindata
    get-run-name-from-id
    get-runs
    get-num-runs
    get-all-run-ids
    get-prev-run-ids
    get-run-ids-matching-target
    get-runs-by-patt
    get-steps-data
    get-steps-for-test
    login
172
173
174
175
176
177
178


179
180
181
182
183
184
185
	    ;;======================================================================
	    ;; READ ONLY QUERIES
	    ;;======================================================================

	    ;; KEYS
	    ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct area-dat params))
	    ((get-keys)                        (db:get-keys dbstruct area-dat))



	    ;; ARCHIVES
	    ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct area-dat params))
	    
	    ;; TESTS
	    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct area-dat params))
	    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct area-dat params))







>
>







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	    ;;======================================================================
	    ;; READ ONLY QUERIES
	    ;;======================================================================

	    ;; KEYS
	    ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct area-dat params))
	    ((get-keys)                        (db:get-keys dbstruct area-dat))
	    ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
	    ((get-targets)                     (db:get-targets  dbstruct))

	    ;; ARCHIVES
	    ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct area-dat params))
	    
	    ;; TESTS
	    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct area-dat params))
	    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct area-dat params))
204
205
206
207
208
209
210

211
212
213
214
215
216
217
	    ((get-run-status)               (apply db:get-run-status dbstruct area-dat params))
	    ((set-run-status)               (apply db:set-run-status dbstruct area-dat params))
	    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct area-dat params))
	    ((get-test-id)                  (apply db:get-test-id dbstruct area-dat params))
	    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct area-dat params))
	    ((get-runs)                     (apply db:get-runs dbstruct area-dat params))
	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct area-dat))

	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct area-dat params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct area-dat params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct area-dat params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct area-dat params))

	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct area-dat params))







>







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	    ((get-run-status)               (apply db:get-run-status dbstruct area-dat params))
	    ((set-run-status)               (apply db:set-run-status dbstruct area-dat params))
	    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct area-dat params))
	    ((get-test-id)                  (apply db:get-test-id dbstruct area-dat params))
	    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct area-dat params))
	    ((get-runs)                     (apply db:get-runs dbstruct area-dat params))
	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct area-dat))
	    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct area-dat params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct area-dat params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct area-dat params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct area-dat params))

	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct area-dat params))

Modified bin/sleeprunner from [7ef4797782] to [64ce489f3b].

1
2
3
4
5
6
7
#!/bin/bash 

if [[ $SLEEPRUNNER == "" ]];then
SLEEPRUNNER=1
fi
  
echo "nbfake $@ &> /dev/null" | at now + $SLEEPRUNNER minutes &> /dev/null



|



1
2
3
4
5
6
7
#!/bin/bash 

if [[ $SLEEPRUNNER == "" ]];then
SLEEPRUNNER=0
fi
  
echo "nbfake $@ &> /dev/null" | at now + $SLEEPRUNNER minutes &> /dev/null

Modified common.scm from [8c0414434e] to [d360fbbd6b].

426
427
428
429
430
431
432


433
434
435
436
437
438
439
440

441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
   "disks" '("none" "")))

;;======================================================================
;; T A R G E T S
;;======================================================================

(define (common:args-get-target #!key (split #f))


  (let* ((target  (if (args:get-arg "-reqtarg")
		      (args:get-arg "-reqtarg")
		      (if (args:get-arg "-target")
			  (args:get-arg "-target")
			  (getenv "MT_TARGET"))))
	 (tlist   (if target (string-split target "/" #t) '()))
	 (valid   (if target
		      (and (not (null? tlist))

			   (null? (filter string-null? tlist)))
		      #f)))
    (if valid
	(if split
	    tlist
	    target)
	(if target
	    (begin
	      (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\"")
	      #f)
	    #f))))

;;======================================================================
;; M I S C   L I S T S
;;======================================================================








>
>
|







>








|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
   "disks" '("none" "")))

;;======================================================================
;; T A R G E T S
;;======================================================================

(define (common:args-get-target #!key (split #f))
  (let* ((keys    (keys:config-get-fields *configdat*))
	 (numkeys (length keys))
	 (target  (if (args:get-arg "-reqtarg")
		      (args:get-arg "-reqtarg")
		      (if (args:get-arg "-target")
			  (args:get-arg "-target")
			  (getenv "MT_TARGET"))))
	 (tlist   (if target (string-split target "/" #t) '()))
	 (valid   (if target
		      (and (not (null? tlist))
			   (eq? numkeys (length tlist))
			   (null? (filter string-null? tlist)))
		      #f)))
    (if valid
	(if split
	    tlist
	    target)
	(if target
	    (begin
	      (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/"))
	      #f)
	    #f))))

;;======================================================================
;; M I S C   L I S T S
;;======================================================================

Modified dashboard-tests.scm from [d0c66f198a] to [3d42f5226e].

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
			 (iup:label "TestComment                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (let ((newcomment (db:test-get-comment testdat)))
			     (if *dashboard-comment-share-slot*
				 (if (not (equal? (iup:attribute *dashboard-comment-share-slot* "VALUE")
						  newcomment))
				     (iup:attribute-set! *dashboard-comment-slot*
							 "VALUE"
							 newcomment)))
			     newcomment)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)







|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
			 (iup:label "TestComment                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (let ((newcomment (db:test-get-comment testdat)))
			     (if *dashboard-comment-share-slot*
				 (if (not (equal? (iup:attribute *dashboard-comment-share-slot* "VALUE")
						  newcomment))
				     (iup:attribute-set! *dashboard-comment-share-slot*
							 "VALUE"
							 newcomment)))
			     newcomment)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
	  (exit 1))
	(let* (;; (run-id        (if testdat (db:test-get-run_id testdat) #f))
	       (keydat        (if testdat (db:get-key-val-pairs dbstruct run-id) #f))
	       (rundat        (if testdat (db:get-run-info dbstruct run-id) #f))
	       (runname       (if testdat (db:get-value-by-header (db:get-rows rundat)
								  (db:get-header rundat)
								  "runname") #f))
	       (tdb           (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id))
	       ;; These next two are intentional bad values to ensure errors if they should not
	       ;; get filled in properly.
	       (logfile       "/this/dir/better/not/exist")
	       (rundir        (if testdat 
				  (db:test-get-rundir testdat)
				  logfile))
	       (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found 
	       (teststeps     (if testdat (tests:get-compressed-steps dbstruct run-id test-id) '()))
	       (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
	       (testname      (if testdat (db:test-get-testname testdat) "n/a"))
	       (testmeta      (if testdat 
				  (let ((tm (db:testmeta-get-record dbstruct testname)))
				    (if tm tm (make-db:testmeta)))
				  (make-db:testmeta)))







|






|







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
	  (exit 1))
	(let* (;; (run-id        (if testdat (db:test-get-run_id testdat) #f))
	       (keydat        (if testdat (db:get-key-val-pairs dbstruct run-id) #f))
	       (rundat        (if testdat (db:get-run-info dbstruct run-id) #f))
	       (runname       (if testdat (db:get-value-by-header (db:get-rows rundat)
								  (db:get-header rundat)
								  "runname") #f))
	       ;; (tdb           (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id))
	       ;; These next two are intentional bad values to ensure errors if they should not
	       ;; get filled in properly.
	       (logfile       "/this/dir/better/not/exist")
	       (rundir        (if testdat 
				  (db:test-get-rundir testdat)
				  logfile))
	       ;; (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found 
	       (teststeps     (if testdat (tests:get-compressed-steps dbstruct run-id test-id) '()))
	       (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
	       (testname      (if testdat (db:test-get-testname testdat) "n/a"))
	       (testmeta      (if testdat 
				  (let ((tm (db:testmeta-get-record dbstruct testname)))
				    (if tm tm (make-db:testmeta)))
				  (make-db:testmeta)))
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))
				   (system (conc "cd " rundir 
						 ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (max (file-modification-time db-path)
							(if (file-exists? testdat-path)
							    (file-modification-time testdat-path)
							    (begin
							      (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







|
|
|
|
|
|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))
				   (system (conc "cd " rundir 
						 ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (file-modification-time db-path))
				                   ;;     (max ..... (if (file-exists? testdat-path)
						   ;;      	      (file-modification-time testdat-path)
						   ;;      	      (begin
						   ;;      		(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
693
694
695
696
697
698
699
700

701
702
703
704
705
706
707
											      (db:test-data-get-value    x)
											      (db:test-data-get-expected x)
											      (db:test-data-get-tol      x)
											      (db:test-data-get-status   x)
											      (db:test-data-get-units    x)
											      (db:test-data-get-type     x)
											      (db:test-data-get-comment  x)))
										    (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%")))

									      "\n")))
							       (if (not (equal? currval newval))
								   (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
					  test-data))
				       ;;(dashboard:run-controls)
				       )))
				 (iup:attribute-set! tabs "TABTITLE0" "Steps")







|
>







693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
											      (db:test-data-get-value    x)
											      (db:test-data-get-expected x)
											      (db:test-data-get-tol      x)
											      (db:test-data-get-status   x)
											      (db:test-data-get-units    x)
											      (db:test-data-get-type     x)
											      (db:test-data-get-comment  x)))
										    ;; (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%")))
										    (db:read-test-data dbstruct area-dat run-id test-id "%")))
									      "\n")))
							       (if (not (equal? currval newval))
								   (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
					  test-data))
				       ;;(dashboard:run-controls)
				       )))
				 (iup:attribute-set! tabs "TABTITLE0" "Steps")

Modified dashboard.scm from [0d13806013] to [5e8da2e6dc].

66
67
68
69
70
71
72










73
74
75
76
77
78
79
      (exit)))

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))











;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *runremote* #f)







>
>
>
>
>
>
>
>
>
>







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
      (exit)))

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))
(define *useserver* (or (args:get-arg "-use-server")
			(configf:lookup *configdat* "dashboard" "use-server")))

(define *keys*   (if *useserver*
		     (rmt:get-keys)
		     (db:get-keys *dbstruct-local*)))
(define *tot-run-count* (if *useserver*
			    (rmt:get-num-runs "%")
			    (db:get-num-runs *dbstruct-local* "%")))


;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *runremote* #f)
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
			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    i))

(define (pad-list l n)(append l (make-list (- n (length l)))))






















(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  (hash-table-set! *searchpatts* x val))


;;======================================================================
;; T E S T S
;;======================================================================





;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>







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
			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    i))

(define (pad-list l n)(append l (make-list (- n (length l)))))

	 (allruns     (if *useserver*
			  (rmt:get-runs runnamepatt numruns *start-run-offset* keypatts)
			  (db:get-runs *dbstruct-local* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
				      *start-run-offset* keypatts)))
		       (tests       (if *useserver*
					(rmt:get-tests-for-run run-id testnamepatt states statuses
							       #f #f
							       *hide-not-hide*
							       sort-by
							       sort-order
							       'shortlist)
					(db:get-tests-for-run *dbstruct-local* run-id testnamepatt states statuses
							      #f #f
							      *hide-not-hide*
							      sort-by
							      sort-order
							      'shortlist)))
		       (key-vals    (if *useserver* 
					(rmt:get-key-vals run-id)
					(db:get-key-vals *dbstruct-local* run-id))))

(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  (hash-table-set! *searchpatts* x val))


;;======================================================================
;; T E S T S
;;======================================================================

	 (db-target-dat (if *useserver* 
			    (rmt:get-targets)
			    (db:get-targets *dbstruct-local*)))

;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
215
216
217
218
219
220
221



222
223
224
225
226
227
228
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))



			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3







>
>
>







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
					    (runs-for-targ (if *useserver*
							       (rmt:get-runs-by-patt *keys* "%" target #f #f #f)
							       (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)))
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3
246
247
248
249
250
251
252




253
254
255
256
257
258
259
;; NB// Wierd conflict error here
;;
;;		     (let* ((runs-dat     (db:get-runs-by-patt db *keys* "%" #f #f #f #f))

;;======================================================================
;; A R E A S
;;======================================================================





(define (dashboard:init-area data area-name apath)
  (let* ((mtconffile  (conc area-name "/megatest.config"))
	 (mtconf      (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
	 (area-dat    (let ((ad (make-megatest:area
			       area-name ;; area name
			       apath     ;; path to area







>
>
>
>







282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
;; NB// Wierd conflict error here
;;
;;		     (let* ((runs-dat     (db:get-runs-by-patt db *keys* "%" #f #f #f #f))

;;======================================================================
;; A R E A S
;;======================================================================
		       (if (number? run-id)
			     (dashboard:update-run-summary-tab))
			   (debug:print 0 "ERROR: tree-path->run-id returned non-number " run-id)))
		       )))

(define (dashboard:init-area data area-name apath)
  (let* ((mtconffile  (conc area-name "/megatest.config"))
	 (mtconf      (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
	 (area-dat    (let ((ad (make-megatest:area
			       area-name ;; area name
			       apath     ;; path to area
336
337
338
339
340
341
342
343



344
345
346
347
348
349
350
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))



    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
			   ;; 2x delta time has not passed since last query
			   ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime))







|
>
>
>







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
  (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
		    (if (> (length d) 1)
			d
			(list #f #f))))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
			   ;; 2x delta time has not passed since last query
			   ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime))

Modified db.scm from [524fbe8f76] to [db0d63a8d0].

1348
1349
1350
1351
1352
1353
1354
1355
1356




1357
1358
1359
1360
1361
1362
1363
    ;; Now do rollups for the toplevel tests
    ;;
    (db:delay-if-busy dbdat area-dat)
    (for-each
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	  (db:general-call db 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name)))) ;; (list run-id test-name))))
     toplevels)))




		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'







|

>
>
>
>







1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
    ;; Now do rollups for the toplevel tests
    ;;
    (db:delay-if-busy dbdat area-dat)
    (for-each
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	 (db:top-test-set-per-pf-counts db run-id test-name)))
     toplevels)))

(define (db:top-test-set-per-pf-counts db run-id test-name)
  (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name run-id test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
 
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
2722
2723
2724
2725
2726
2727
2728














2729
2730
2731
2732
2733
2734
2735
			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (db:delay-if-busy dbdat area-dat)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
			  test-id category variable value expected tol units (if comment comment "") status type)))
     csvlist)))















;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:get-run-ids-matching-target dbstruct area-dat keynames target res runname testpatt statepatt statuspatt)
  (let* ((dbdat    (db:get-db dbstruct area-dat #f))







>
>
>
>
>
>
>
>
>
>
>
>
>
>







2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (db:delay-if-busy dbdat area-dat)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
			  test-id category variable value expected tol units (if comment comment "") status type)))
     csvlist)))

;; This routine moved from tdb.scm, tdb:read-test-data
;;
(define (db:read-test-data dbstruct run-id test-id categorypatt)
  (let* ((dbdat      (db:get-db dbstruct run-id))
	 (db         (db:dbdat-get-db dbdat))
	 (res '()))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     db
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
    (reverse res)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:get-run-ids-matching-target dbstruct area-dat keynames target res runname testpatt statepatt statuspatt)
  (let* ((dbdat    (db:get-db dbstruct area-dat #f))
2822
2823
2824
2825
2826
2827
2828
2829


2830
2831
2832

2833
2834


2835
2836
2837
2838


2839



2840
2841
2842
2843
2844
2845
2846
2847
  (let ((dbdat  (db:get-db dbstruct area-dat run-id)))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbdat 'set-test-start-time (list test-id)))
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))

(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status)


  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
      (let ((dbdat (db:get-db dbstruct area-dat run-id)))

	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	(if (equal? status "RUNNING")


	    (db:general-call dbdat 'top-test-set-running (list test-name))
	    (if (equal? status "LAUNCHED")
		(db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))
		(db:general-call dbdat 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name))))


	#f)



      #f))

(define (db:test-get-logfile-info dbstruct area-dat run-id test-name)
  (db:with-db
   dbstruct area-dat
   run-id
   #f
   (lambda (db)







|
>
>
|
<

>

<
>
>
|
<
|
|
>
>

>
>
>
|







2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850

2851
2852
2853

2854
2855
2856

2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
  (let ((dbdat  (db:get-db dbstruct area-dat run-id)))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbdat 'set-test-start-time (list test-id)))
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))

;; (define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status)
(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path state status)
  (if ;; (and
      (not (equal? item-path ""))

      (let ((dbdat (db:get-db dbstruct area-dat run-id)))
   ;; (not (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))

	;; NOTE: No else clause needed for this case
	(case (string->symbol status)
	 ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))

	 ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
	 ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
	(let ((db (db:dbdat-get-db dbdat)))
	  (db:top-test-set-per-pf-counts db run-id test-name))
	#f)
      ;; if the test is not COMPLETED then this routine should not have been called
      (begin
	(debug:print 0 "ERROR: db:test-set-state-status called with state " state " and status " status)
	#f)))

(define (db:test-get-logfile-info dbstruct area-dat run-id test-name)
  (db:with-db
   dbstruct area-dat
   run-id
   #f
   (lambda (db)
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910





2911
2912
2913
2914
2915
2916
2917
2918
2919
2920




2921




2922
2923
2924
2925











2926

















2927
2928
2929
2930
2931
2932
2933
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")       ;; DONE
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set          "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 





                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status NOT IN ('TEN_STRIKES','BLOCKED')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''
                                              AND state IN ('NOT_STARTED','BLOCKED')) > 0 THEN 'FAIL'




                                  WHEN fail_count > 0 THEN 'FAIL' 




                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''











                                              AND status = 'SKIP') > 0 THEN 'SKIP'

















                                  ELSE 'UNKNOWN' END
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE test_id=?;") ;; using status since no state field
	))







|







>
>
>
>
>









|
>
>
>
>
|
>
>
>
>
|



>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")       ;; DONE
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')),
                 pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set          "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status IN ('INCOMPLETE')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'INCOMPLETE'
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status NOT IN ('TEN_STRIKES','BLOCKED')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''
                                              AND state IN ('NOT_STARTED','BLOCKED','INCOMPLETE')) > 0 THEN 'FAIL'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'ABORT') > 0 THEN 'ABORT'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'AUTO') > 0 THEN 'AUTO'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status IN ('STUCK/INCOMPLETE', 'INCOMPLETE')) > 0 THEN 'INCOMPLETE'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'CHECK') > 0 THEN 'CHECK'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'WARN') > 0 THEN 'WARN'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'WAIVED') > 0 THEN 'WAIVED'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=? 
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status NOT IN ('PASS','FAIL','WARN','WAIVED')) > 0 THEN 'ABORT'
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  ELSE 'UNKNOWN' END
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE test_id=?;") ;; using status since no state field
	))
3148
3149
3150
3151
3152
3153
3154
3155

3156
3157
3158
3159
3160
3161
3162
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))

  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)







|
>







3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode)
;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode itemmap) ;; #!key (mode '(normal))(itemmap #f))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)

Modified launch.scm from [7b605ded00] to [f126fd594d].

320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
				 ;; Since we should have a clean slate at this time there is no need to do 
				 ;; any of the other stuff that tests:test-set-status! does. Let's just 
				 ;; force RUNNING/n/a
				 

				 ;; (thread-sleep! 0.3)
				 (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")

				 (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat)
				 ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here

				 ;; if there is a runscript do it first
				 (if fullrunscript
				     (let ((pid (process-run fullrunscript)))
				       (rmt:test-set-top-process-pid run-id test-id pid area-dat)
				       (let loop ((i 0))







>
|







320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
				 ;; Since we should have a clean slate at this time there is no need to do 
				 ;; any of the other stuff that tests:test-set-status! does. Let's just 
				 ;; force RUNNING/n/a
				 

				 ;; (thread-sleep! 0.3)
				 (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
;; 				 (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat)
				 (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING" area-dat)
				 ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here

				 ;; if there is a runscript do it first
				 (if fullrunscript
				     (let ((pid (process-run fullrunscript)))
				       (rmt:test-set-top-process-pid run-id test-id pid area-dat)
				       (let loop ((i 0))
858
859
860
861
862
863
864

865
866
867
868
869
870
871
872
	(begin
	  (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
	  (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
    
    ;; prevent overlapping actions - set to LAUNCHED as early as possible
    ;;
    (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))

    (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat)
    (set! diskpath (get-best-disk configdat))
    (if diskpath
	(let ((dat  (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
	  (set! work-area (car dat))
	  (set! toptest-work-area (cadr dat))
	  (debug:print-info 2 "Using work area " work-area))
	(begin







>
|







859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
	(begin
	  (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
	  (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
    
    ;; prevent overlapping actions - set to LAUNCHED as early as possible
    ;;
    (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
;;    (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat)
    (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED" area-dat)
    (set! diskpath (get-best-disk configdat))
    (if diskpath
	(let ((dat  (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
	  (set! work-area (car dat))
	  (set! toptest-work-area (cadr dat))
	  (debug:print-info 2 "Using work area " work-area))
	(begin

Modified megatest-version.scm from [3b8d26b409] to [7d7023c394].

1
2
3
4
5
6
7
;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6015)






|

1
2
3
4
5
6
7
;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6017)

Modified megatest.scm from [2ea3890129] to [1954318c08].

1
2
3
4
5
6
7
8
9
10
11




12
13
14
15
16
17
18
;; 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.

;; (include "common.scm")
;; (include "megatest-version.scm")





;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)












>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
;; 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.

;; (include "common.scm")
;; (include "megatest-version.scm")

(define (toplevel-command . a) #f)

(define (toplevel-command . a) #f)

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
  license GPL, Copyright Matt Welland 2006-2015

Usage: megatest [options]
  -h                      : this help
  -version                : print megatest version (currently " megatest-version ")

Launching and managing runs
  -runall                 : run all tests that are not state COMPLETED and status PASS, 
                            CHECK or KILLED
  -runtests tst1,tst2 ... : run tests
  -remove-runs            : remove the data for a run, requires -runname and -testpatt
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname
  -set-run-status status  : sets status for run to status, requires -target and -runname







|
<
<







86
87
88
89
90
91
92
93


94
95
96
97
98
99
100
  license GPL, Copyright Matt Welland 2006-2015

Usage: megatest [options]
  -h                      : this help
  -version                : print megatest version (currently " megatest-version ")

Launching and managing runs
  -runall                 : run all tests or as specified by -testpatt


  -remove-runs            : remove the data for a run, requires -runname and -testpatt
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname
  -set-run-status status  : sets status for run to status, requires -target and -runname
294
295
296
297
298
299
300
301

302
303
304
305
306
307
308
			"-show-config"
			"-show-cmdinfo"
			"-get-run-status"

			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first

			"-runall"    ;; run all tests

			"-remove-runs"
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"







|
>







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
			"-show-config"
			"-show-cmdinfo"
			"-get-run-status"

			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first

			"-runall"    ;; run all tests, respects -testpatt
			"-run"       ;; alias for -runall
			"-remove-runs"
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
	(args:get-arg "-get-run-status"))
    (general-run-call
     "-set-run-status"
     "set run status"
     (lambda (target runname keys keyvals)
       (let* ((runsdat  (rmt:get-runs-by-patt keys runname 
					(common:args-get-target)
					#f #f))
	      (header   (vector-ref runsdat 0))
	      (rows     (vector-ref runsdat 1)))
	 (if (null? rows)
	     (begin
	       (debug:print-info 0 "No matching run found.")
	       (exit 1))
	     (let* ((row      (car (vector-ref runsdat 1)))







|







888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
	(args:get-arg "-get-run-status"))
    (general-run-call
     "-set-run-status"
     "set run status"
     (lambda (target runname keys keyvals)
       (let* ((runsdat  (rmt:get-runs-by-patt keys runname 
					(common:args-get-target)
					#f #f #f))
	      (header   (vector-ref runsdat 0))
	      (rows     (vector-ref runsdat 1)))
	 (if (null? rows)
	     (begin
	       (debug:print-info 0 "No matching run found.")
	       (exit 1))
	     (let* ((row      (car (vector-ref runsdat 1)))
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
	(let* ((dbstruct (make-dbr:dbstruct path: (megatest:area-path *area-dat*) local: #t))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (if (args:get-arg "-testpatt") 
			        (args:get-arg "-testpatt") 
			        "%"))
	       (keys        (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       (runs        (if (and (not (null? runstmp))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
				  (let loop ((hed (car runstmp))







|







943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
	(let* ((dbstruct (make-dbr:dbstruct path: (megatest:area-path *area-dat*) local: #t))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (if (args:get-arg "-testpatt") 
			        (args:get-arg "-testpatt") 
			        "%"))
	       (keys        (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       (runs        (if (and (not (null? runstmp))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
				  (let loop ((hed (car runstmp))
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
	       (db-targets  (args:get-arg "-list-db-targets"))
	       (seen        (make-hash-table))
	       (dmode       (let ((d (args:get-arg "-dumpmode")))
			      (if d (string->symbol d) #f)))
	       (data        (make-hash-table))
	       (fields-spec (if (args:get-arg "-fields")
				(extract-fields-constraints (args:get-arg "-fields"))
				(list (list "runs"  "id" "target"   "runname")
				      (cons "tests"  db:test-record-fields) ;; "id" "testname" "test_path")
				      (list "steps" "id" "stepname"))))
	       (runs-spec   (let ((r (alist-ref "runs"  fields-spec equal?)))
			      (if (and r (not (null? r))) r (list "id"))))
	       (tests-spec  (let ((t (alist-ref "tests" fields-spec equal?)))
			      (if (and t (null? t)) ;; all fields
				  db:test-record-fields
				  t)))
	       (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id"))))
	       (steps-spec  (alist-ref "steps" fields-spec equal?))
	       (test-field-index (make-hash-table)))







|


|
|







967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
	       (db-targets  (args:get-arg "-list-db-targets"))
	       (seen        (make-hash-table))
	       (dmode       (let ((d (args:get-arg "-dumpmode")))
			      (if d (string->symbol d) #f)))
	       (data        (make-hash-table))
	       (fields-spec (if (args:get-arg "-fields")
				(extract-fields-constraints (args:get-arg "-fields"))
				(list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")))
				      (cons "tests"  db:test-record-fields) ;; "id" "testname" "test_path")
				      (list "steps" "id" "stepname"))))
	       (runs-spec   (let ((r (alist-ref "runs"  fields-spec equal?))) ;; the check is now unnecessary
			      (if (and r (not (null? r))) r (list "id" ))))
	       (tests-spec  (let ((t (alist-ref "tests" fields-spec equal?)))
			      (if (and t (null? t)) ;; all fields
				  db:test-record-fields
				  t)))
	       (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id"))))
	       (steps-spec  (alist-ref "steps" fields-spec equal?))
	       (test-field-index (make-hash-table)))
1000
1001
1002
1003
1004
1005
1006
1007



1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
							 (db:get-value-by-header run header x))
						       keys) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (if (not dmode)(print targetstr))))



		   (let* ((run-id  (db:get-value-by-header run header "id"))
			  (runname (db:get-value-by-header run header "runname")) 
			  (tests   (if tests-spec
				       (rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc 
							     ;; use qryvals if test-spec provided
							     (if tests-spec
								 (string-intersperse adj-tests-spec ",")
								 ;; db:test-record-fields
								 #f))
				       '())))
		     (case dmode







|
>
>
>



|







1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
							 (db:get-value-by-header run header x))
						       keys) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (if (not dmode)
			     (print targetstr)
			     (hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '())))
			     )))
		   (let* ((run-id  (db:get-value-by-header run header "id"))
			  (runname (db:get-value-by-header run header "runname")) 
			  (tests   (if tests-spec
				       (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
							     ;; use qryvals if test-spec provided
							     (if tests-spec
								 (string-intersperse adj-tests-spec ",")
								 ;; db:test-record-fields
								 #f))
				       '())))
		     (case dmode
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
;;     launch task
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keyvals)
       (runs:run-tests target
		       runname
		       (args:get-arg "-testpatt")







|







1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
;;     launch task
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")(args:get-arg "-run"))
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keyvals)
       (runs:run-tests target
		       runname
		       (args:get-arg "-testpatt")

Added multi-dboard.scm version [0d13806013].













































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
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
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
;;======================================================================
;; Copyright 2006-2013, 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 format numbers)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)

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

(declare (uses margs))
(declare (uses launch))
(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses server))
(declare (uses synchash))
(declare (uses dcommon))
(declare (uses tree))
(declare (uses configf))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
  -h                : this help
  -group groupname  : display this group of areas
  -test testid      : control test identified by testid
  -guimonitor       : control panel for runs

Misc
  -rows N         : set number of rows
"))

;; process args
(define remargs (args:get-args 
		 (argv)
		 (list  "-group" ;; display this group of areas
			"-debug"
			) 
		 (list  "-h"
			"-v"
			"-q"
			)
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *runremote* #f)

(debug:setup)

(define *tim* (iup:timer))
(define *ord* #f)

(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")

(define (message-window msg)
  (iup:show
   (iup:dialog
    (iup:vbox 
     (iup:label msg #:margin "40x40")))))

(define (iuplistbox-fill-list lb items . default)
  (let ((i 1)
	(selected-item (if (null? default) #f (car default))))
    (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
    (for-each (lambda (item)
		(iup:attribute-set! lb (number->string i) item)
		(if selected-item
		    (if (equal? selected-item item)
			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    i))

(define (pad-list l n)(append l (make-list (- n (length l)))))


(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  (hash-table-set! *searchpatts* x val))


;;======================================================================
;; T E S T S
;;======================================================================


;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
			    (area-path (cdr tree-path)))
		       #f
		       ;; (test-id  (tree-path->test-id (cdr run-path))))
		       ;; (if test-id
		       ;;    (hash-table-set! (dboard:data-get-curr-test-ids *data*)
		       ;;		     window-id test-id))
		       ;; (print "path: " (tree:node->path obj id) " test-id: " test-id))))))
		       )))))
    ;; (iup:attribute-set! tb "VALUE" "0")
    ;; (iup:attribute-set! tb "NAME" "Runs")
    ;; (iup:attribute-set! tb "ADDEXPANDED" "NO")
    ;; (dboard:data-set-tests-tree! *data* tb)
    tb))
;;   (test-panel window-id)))

;; The function to update the fields in the test view panel
(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
  ;; get test-id
  ;; then get test record
  (if testdat
      (let* ((test-id      (hash-table-ref/default (dboard:data-get-curr-test-ids *data*) window-id #f))
	     (test-data    (hash-table-ref/default testdat test-id #f))
	     (run-id       (db:test-get-run_id test-data))
	     (targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*) 
						   run-id
						   '()))
	     (target       (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
	     (runname      (if (null? targ/runname) "" (car (cdr targ/runname))))
	     (steps-dat    (tests:get-compressed-steps *dbstruct-local* run-id test-id)))
	
	(if test-data
	    (begin
	      ;; 
	      (for-each 
	       (lambda (data)
		 (let ((mat    (car data))
		       (vals   (cadr data))
		       (rownum 1))
		   (for-each 
		    (lambda (key)
		      (let ((cell   (conc rownum ":1")))
			(if (not (equal? (iup:attribute mat cell)(conc key)))
			    (begin
			      ;; (print "setting cell " cell " in matrix " mat " to value " key)
			      (iup:attribute-set! mat cell (conc key))
			      (iup:attribute-set! mat "REDRAW" cell)))
			(set! rownum (+ rownum 1))))
		    vals)))
	       (list 
		(list run-info-matrix
		      (if test-id
			  (list (db:test-get-run_id test-data)
				target
				runname
				"n/a")
			  (make-list 4 "")))
		(list test-info-matrix
		      (if test-id
			  (list test-id
				(db:test-get-testname test-data)
				(db:test-get-item-path test-data)
				(db:test-get-state    test-data)
				(db:test-get-status   test-data)
				(seconds->string (db:test-get-event_time test-data))
				(db:test-get-comment  test-data))
			  (make-list 7 "")))
		(list test-run-matrix
		      (if test-id
			  (list (db:test-get-host     test-data)
				(db:test-get-uname    test-data)
				(db:test-get-diskfree test-data)
				(db:test-get-cpuload  test-data)
				(seconds->hr-min-sec (db:test-get-run_duration test-data)))
			  (make-list 5 "")))
		))
	      (dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;;      (if test-id
;;	  (list (
 

;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3
			   #:click-cb (lambda (obj lin col status)
					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))

    (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
    (iup:attribute-set! view-matrix "WIDTH0" "100")
    ;; (dboard:data-set-runs-matrix! *data* runs-matrix)
    (iup:hbox
     (iup:frame 
      #:title "Runs browser"
      (iup:vbox
       view-matrix)))))

;; Browse and control a single run
;;
(define (runcontrol window-id)
  (iup:hbox))

;; NB// Wierd conflict error here
;;
;;		     (let* ((runs-dat     (db:get-runs-by-patt db *keys* "%" #f #f #f #f))

;;======================================================================
;; A R E A S
;;======================================================================

(define (dashboard:init-area data area-name apath)
  (let* ((mtconffile  (conc area-name "/megatest.config"))
	 (mtconf      (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
	 (area-dat    (let ((ad (make-megatest:area
			       area-name ;; area name
			       apath     ;; path to area
			       'http     ;; transport
			       (list apath mtconf) ;; configinfo (legacy)
			       mtconf    ;; megatest.config
			       (make-hash-table) ;; denoise hash
			       #f        ;; client-signature
			       #f        ;; remote connections
			       #f        ;; run keys
			       (make-hash-table) ;; run-id -> (hash of test-ids => dat)
			       (and (file-exists? apath)(file-write-access? apath)) ;; read-only
			       )))
		      (hash-table-set! (dboard:data-areas data) area-name ad)
		      ad)))
    area-dat))

;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (let* ((apath      (configf:lookup (dboard:data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
				      ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
				      (area-dat   (dashboard:init-area data aname apath))
				      (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
				      (ad         (dashboard:area-display data area-dat window-id))
				      (areas      (dboard:data-areas data))
				      (dboard-dat (make-dboard:tab
						   #f           ;; tree
						   #f           ;; matrix
						   area-dat     ;;
						   #f           ;; view path
						   'default     ;; view type
						   #f           ;; controls
						   #f           ;; cached data
						   #f           ;; filters
						   #f           ;; the run-id
						   (make-hash-table) ;; run-id -> test-id, for current test id
						   ""
						   )))
				 (hash-table-set! (dboard:data-areas data) aname dboard-dat)
				 (dboard:tab-tree-set!   dboard-dat tb)
				 (dboard:tab-matrix-set! dboard-dat ad)
				 (iup:split
				  #:value 200
				  tb ad)))
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (dboard:data-current-tab-id-set! data curr)
						   (dboard:data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tab-ids     (dboard:data-tab-ids data)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(hash-table-set! tab-ids index hed)
	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
			   ;; 2x delta time has not passed since last query
			   ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime))
			   ;;     (let* ((changes   (dcommon:run-update data)) ;;keys data runname keypatts testpatt states statuses 'full my-window-id))
			   ;;            (endtime   (current-milliseconds)))
			   ;;       (set! nextmintime (+ endtime (* 2.0 (- endtime starttime))))
			   ;;       ;; (debug:print 11 "CHANGE(S): " (car changes) "...")
			   ;;       )
			   ;;     (debug:print-info 11 "Server overloaded")))))))
			   (dcommon:run-update data))))))

;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id
;;;
(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0                 ;; current window id
		   0                 ;; current tab id
		   #f                ;; redraw needed for current tab id
		   (make-hash-table) ;; tab-id -> areaname
		   )))
  (newdashboard data window-id)
  (iup:main-loop))

Modified rmt.scm from [8d17aa6591] to [c6b54359e7].

161
162
163
164
165
166
167






168
169
170





171
172
173
174
175
176
177
	      (common:del-remote! remote run-id)
	      ;; (mutex-unlock! *send-receive-mutex*)
	      (if (and faststart (equal? faststart "no"))
		  (begin
		    (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
		    (thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
		    (rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))






		  (begin
		    (server:kind-run run-id area-dat)
		    (rmt:open-qry-close-locally cmd run-id area-dat params))))





	    (begin
	      ;; (debug:print 0 "ERROR: Communication failed!")
	      ;; (mutex-unlock! *send-receive-mutex*)
	      ;; (exit)
	      (rmt:open-qry-close-locally cmd run-id area-dat params)
	      )))))








>
>
>
>
>
>
|
|
|
>
>
>
>
>







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	      (common:del-remote! remote run-id)
	      ;; (mutex-unlock! *send-receive-mutex*)
	      (if (and faststart (equal? faststart "no"))
		  (begin
		    (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
		    (thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
		    (rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
		  (let ((start-time (current-milliseconds))
			(max-query  (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
							"300")))
			(newres     (rmt:open-qry-close-locally cmd run-id params)))
		    (let ((delta (- (current-milliseconds) start-time)))
		      (if (> delta max-query)
			  (begin
		    ;; (server:kind-run run-id area-dat)
		    ;; (rmt:open-qry-close-locally cmd run-id area-dat params))))
			    (debug:print-info 0 "Starting server as query time " delta " is over the limit of " max-query)
			    (server:kind-run run-id)))
		      ;; return the result!
		      newres)
		    )))
	    (begin
	      ;; (debug:print 0 "ERROR: Communication failed!")
	      ;; (mutex-unlock! *send-receive-mutex*)
	      ;; (exit)
	      (rmt:open-qry-close-locally cmd run-id area-dat params)
	      )))))

352
353
354
355
356
357
358






359
360
361
362




363
364
365
366
367
368
369
;;
(define (rmt:get-key-val-pairs run-id area-dat)
  (rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat))

(define (rmt:get-keys area-dat)
  (rmt:send-receive 'get-keys #f '() area-dat))







;;======================================================================
;;  T E S T S
;;======================================================================





(define (rmt:get-test-id run-id testname item-path area-dat)
  (rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat))

(define (rmt:get-test-info-by-id run-id test-id area-dat)
  (if (and (number? run-id)(number? test-id))
      (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id) area-dat)
      (begin







>
>
>
>
>
>




>
>
>
>







363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
;;
(define (rmt:get-key-val-pairs run-id area-dat)
  (rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat))

(define (rmt:get-keys area-dat)
  (rmt:send-receive 'get-keys #f '() area-dat))

(define (rmt:get-key-vals run-id)
  (rmt:send-receive 'get-key-vals #f (list run-id)))

(define (rmt:get-targets)
  (rmt:send-receive 'get-targets #f '()))

;;======================================================================
;;  T E S T S
;;======================================================================

;; Just some syntatic sugar NOTE: Need to add area-dat
(define (rmt:register-test run-id test-name item-path)
  (rmt:general-call 'register-test run-id run-id test-name item-path))

(define (rmt:get-test-id run-id testname item-path area-dat)
  (rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat))

(define (rmt:get-test-info-by-id run-id test-id area-dat)
  (if (and (number? run-id)(number? test-id))
      (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id) area-dat)
      (begin
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515


516
517
518
519
520
521
522
523
524
525
526
527
528



529
530
531
532
533
534
535
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname) area-dat))
	   run-ids))))

(define (rmt:get-run-ids-matching keynames target res area-dat)
  (rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat)

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal)))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode) area-dat))

(define (rmt:get-count-tests-running-for-run-id run-id area-dat)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat))

;; Statistical queries

(define (rmt:get-count-tests-running run-id area-dat)
  (rmt:send-receive 'get-count-tests-running run-id (list run-id) area-dat))

(define (rmt:get-count-tests-running-for-testname run-id testname area-dat)
  (rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat))

(define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat)
  (rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat))



(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status area-dat)
  (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path status) area-dat))

(define (rmt:update-pass-fail-counts run-id test-name area-dat)
  (rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat))

;;======================================================================
;;  R U N S
;;======================================================================

(define (rmt:get-run-info run-id area-dat)
  (rmt:send-receive 'get-run-info run-id (list run-id) area-dat))




;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user area-dat)
  (rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat))
    
(define (rmt:get-run-name-from-id run-id area-dat)
  (rmt:send-receive 'get-run-name-from-id run-id (list run-id) area-dat))








|
|















>
>
|
|











>
>
>







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname) area-dat))
	   run-ids))))

(define (rmt:get-run-ids-matching keynames target res area-dat)
  (rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat)

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal))(itemmap #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap) area-dat))

(define (rmt:get-count-tests-running-for-run-id run-id area-dat)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat))

;; Statistical queries

(define (rmt:get-count-tests-running run-id area-dat)
  (rmt:send-receive 'get-count-tests-running run-id (list run-id) area-dat))

(define (rmt:get-count-tests-running-for-testname run-id testname area-dat)
  (rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat))

(define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat)
  (rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat))

;; state and status are extra hints not usually used in the calculation
;;
(define (rmt:roll-up-pass-fail-counts run-id test-name item-path state status area-dat)
  (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path state status) area-dat))

(define (rmt:update-pass-fail-counts run-id test-name area-dat)
  (rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat))

;;======================================================================
;;  R U N S
;;======================================================================

(define (rmt:get-run-info run-id area-dat)
  (rmt:send-receive 'get-run-info run-id (list run-id) area-dat))

(define (rmt:get-num-runs runpatt)
  (rmt:send-receive 'get-num-runs #f (list runpatt)))

;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user area-dat)
  (rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat))
    
(define (rmt:get-run-name-from-id run-id area-dat)
  (rmt:send-receive 'get-run-name-from-id run-id (list run-id) area-dat))

Modified runs.scm from [a90001432d] to [6969af8f2e].

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all area-dat))
    (set! all-test-names     (hash-table-keys all-tests-registry))
    (set! test-names         (tests:filter-test-names all-test-names test-patts))

    ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.
    ;;
    ;; (set! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    (set! required-tests     (lset-intersection equal? test-names all-test-names))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)

    ;; (set! test-names (delete-duplicates (tests:get-valid-tests toppath test-patts)))
    (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path configdat area-dat) " "))
    ;; (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path *configdat*) " "))







|
|







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all area-dat))
    (set! all-test-names     (hash-table-keys all-tests-registry))
    (set! test-names         (tests:filter-test-names all-test-names test-patts))

    ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.
    ;;
    (set! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    ;; (set! required-tests     (lset-intersection equal? test-names all-test-names))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)

    ;; (set! test-names (delete-duplicates (tests:get-valid-tests toppath test-patts)))
    (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path configdat area-dat) " "))
    ;; (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path *configdat*) " "))
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	  ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to 
	  ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends 
	  ;; on test A but test B reached the point on being registered as NOT_STARTED and test
	  ;; A failed for some reason then on re-run using -keepgoing the run can never complete.
	  ;;
	  ;; (rmt:general-call 'delete-tests-in-state run-id "NOT_STARTED")
	  
	  ;; Now convert FAIL and anything in allow-auto-rerun to NOT_STARTED
	  ;;
	  (for-each (lambda (state)
		      (rmt:set-tests-state-status run-id test-names state #f "NOT_STARTED" state area-dat))
		    (string-split (or (configf:lookup configdat "setup" "allow-auto-rerun") "")))))

    ;; Ensure all tests are registered in the test_meta table
    (runs:update-all-test_meta #f area-dat)







|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	  ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to 
	  ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends 
	  ;; on test A but test B reached the point on being registered as NOT_STARTED and test
	  ;; A failed for some reason then on re-run using -keepgoing the run can never complete.
	  ;;
	  ;; (rmt:general-call 'delete-tests-in-state run-id "NOT_STARTED")
	  
	  ;; Now convert anything in allow-auto-rerun to NOT_STARTED
	  ;;
	  (for-each (lambda (state)
		      (rmt:set-tests-state-status run-id test-names state #f "NOT_STARTED" state area-dat))
		    (string-split (or (configf:lookup configdat "setup" "allow-auto-rerun") "")))))

    ;; Ensure all tests are registered in the test_meta table
    (runs:update-all-test_meta #f area-dat)
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
	  '()
	  reg)))

(define runs:nothing-left-in-queue-count 0)

(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap area-dat)
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat itemmap: itemmap))
	 ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more







|







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
	  '()
	  reg)))

(define runs:nothing-left-in-queue-count 0)

(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap area-dat)
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap))
	 ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
	 (toppath                 (megatest:area-path      area-dat))
	 (run-limits-info         (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs area-dat)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2)) 
	 (max-concurrent-jobs     (list-ref run-limits-info 3))
	 (job-group-limit         (list-ref run-limits-info 4))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons item-path testmode area-dat itemmap: itemmap))
	 ;; (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails                   (runs:calc-fails prereqs-not-met))
	 (non-completed           (filter (lambda (x)             ;; remove hed from not completed list, duh, of course it is not completed!
					    (not (equal? x hed)))
					  (runs:calc-not-completed prereqs-not-met)))
	 (loop-list               (list hed tal reg reruns))
	 ;; configure the load runner







|







671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
	 (toppath                 (megatest:area-path      area-dat))
	 (run-limits-info         (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs area-dat)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2)) 
	 (max-concurrent-jobs     (list-ref run-limits-info 3))
	 (job-group-limit         (list-ref run-limits-info 4))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap))
	 ;; (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails                   (runs:calc-fails prereqs-not-met))
	 (non-completed           (filter (lambda (x)             ;; remove hed from not completed list, duh, of course it is not completed!
					    (not (equal? x hed)))
					  (runs:calc-not-completed prereqs-not-met)))
	 (loop-list               (list hed tal reg reruns))
	 ;; configure the load runner
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
     
     ;; Register tests 
     ;;
     ((not (hash-table-ref/default test-registry (db:test-make-full-name test-name item-path) #f))
      (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
      ;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs
      (let register-loop ((numtries 15))
	(rmt:general-call 'register-test run-id area-dat run-id test-name item-path)
	(if (rmt:get-test-id run-id test-name item-path)
	    (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'done)
	    (if (> numtries 0)
		(begin
		  (thread-sleep! 0.5)
		  (register-loop (- numtries 1)))
		(debug:print 0 "ERROR: failed to register test " (db:test-make-full-name test-name item-path)))))
      (if (not (eq? (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f) 'done))
	  (begin
	    (rmt:general-call 'register-test run-id area-dat run-id test-name "")
	    (if (rmt:get-test-id run-id test-name "")
		(hash-table-set! test-registry (db:test-make-full-name test-name "") 'done))))
      (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
      (if (and (null? tal)(null? reg))
	  (list hed tal (append reg (list hed)) reruns)
	  (list (runs:queue-next-hed tal reg reglen regfull)
		(runs:queue-next-tal tal reg reglen regfull)







|









|







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
     
     ;; Register tests 
     ;;
     ((not (hash-table-ref/default test-registry (db:test-make-full-name test-name item-path) #f))
      (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
      ;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs
      (let register-loop ((numtries 15))
	(rmt:register-test area-dat run-id test-name item-path)
	(if (rmt:get-test-id run-id test-name item-path)
	    (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'done)
	    (if (> numtries 0)
		(begin
		  (thread-sleep! 0.5)
		  (register-loop (- numtries 1)))
		(debug:print 0 "ERROR: failed to register test " (db:test-make-full-name test-name item-path)))))
      (if (not (eq? (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f) 'done))
	  (begin
	    (rmt:register-test area-dat run-id test-name "")
	    (if (rmt:get-test-id run-id test-name "")
		(hash-table-set! test-registry (db:test-make-full-name test-name "") 'done))))
      (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
      (if (and (null? tal)(null? reg))
	  (list hed tal (append reg (list hed)) reruns)
	  (list (runs:queue-next-hed tal reg reglen regfull)
		(runs:queue-next-tal tal reg reglen regfull)
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
		     (else
		      (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60)
			  (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now."))
		      ;; (debug:print 0 "         prereqs: " prereqs-not-met)
		      (hash-table-set! test-registry hed 'removed)
		      (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f)
		      ;; I'm unclear on if this roll up is needed - it may be the root cause of the "all set to FAIL" bug.
		      (rmt:roll-up-pass-fail-counts run-id test-name item-path "FAIL") ;; treat as FAIL
		      (list (if (null? tal)(car newtal)(car tal))
			    tal
			    reg
			    reruns)))))
	      ;; can't drop this - maybe running? Just keep trying
	      (let ((runable-tests (runs:runable-tests prereqs-not-met)))
		(if (null? runable-tests)







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
		     (else
		      (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60)
			  (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now."))
		      ;; (debug:print 0 "         prereqs: " prereqs-not-met)
		      (hash-table-set! test-registry hed 'removed)
		      (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f)
		      ;; I'm unclear on if this roll up is needed - it may be the root cause of the "all set to FAIL" bug.
		      (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "FAIL") ;; treat as FAIL
		      (list (if (null? tal)(car newtal)(car tal))
			    tal
			    reg
			    reruns)))))
	      ;; can't drop this - maybe running? Just keep trying
	      (let ((runable-tests (runs:runable-tests prereqs-not-met)))
		(if (null? runable-tests)
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
(define (runs:runable-tests tests)
  (filter (lambda (t)
	    (if (not (vector? t))
		t
		(let ((state  (db:test-get-state t))
		      (status (db:test-get-status t)))
		  (case (string->symbol state)
		    ((COMPLETED) #f)
		    ((NOT_STARTED)
		     (if (member status '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" ))
			 #f
			 t))
		    ((DELETED) #f)
		    (else t)))))
	  tests))







|







905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
(define (runs:runable-tests tests)
  (filter (lambda (t)
	    (if (not (vector? t))
		t
		(let ((state  (db:test-get-state t))
		      (status (db:test-get-status t)))
		  (case (string->symbol state)
		    ((COMPLETED INCOMPLETE) #f)
		    ((NOT_STARTED)
		     (if (member status '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" ))
			 #f
			 t))
		    ((DELETED) #f)
		    (else t)))))
	  tests))
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
	  (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
	;; (debug:print 0 "max-tries-hash: " (hash-table->alist *max-tries-hash*))

	;; Ensure all top level tests get registered. This way they show up as "NOT_STARTED" on the dashboard
	;; and it is clear they *should* have run but did not.
	(if (not (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f))
	    (begin
	      (rmt:general-call 'register-test run-id area-dat run-id test-name "" area-dat)
	      (hash-table-set! test-registry (db:test-make-full-name test-name "") 'done)))
	
	;; Fast skip of tests that are already "COMPLETED" - NO! Cannot do that as the items may not have been expanded yet :(
	;;
	(if (member (hash-table-ref/default test-registry tfullname #f) 
		    '(DONOTRUN removed)) ;; *common:cant-run-states-sym*) ;; '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))
	    (begin







|







1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
	  (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
	;; (debug:print 0 "max-tries-hash: " (hash-table->alist *max-tries-hash*))

	;; Ensure all top level tests get registered. This way they show up as "NOT_STARTED" on the dashboard
	;; and it is clear they *should* have run but did not.
	(if (not (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f))
	    (begin
	      (rmt:register-test area-dat run-id test-name "")
	      (hash-table-set! test-registry (db:test-make-full-name test-name "") 'done)))
	
	;; Fast skip of tests that are already "COMPLETED" - NO! Cannot do that as the items may not have been expanded yet :(
	;;
	(if (member (hash-table-ref/default test-registry tfullname #f) 
		    '(DONOTRUN removed)) ;; *common:cant-run-states-sym*) ;; '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))
	    (begin
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
    ;; LET* ((test-record
    ;; we get here on "drop through". All done!
    (debug:print-info 1 "All tests launched")))

(define (runs:calc-fails prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "COMPLETED")
		 (not (member (db:test-get-status test)
			      '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))))
	  prereqs-not-met))

(define (runs:calc-prereq-fail prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "NOT_STARTED")
		 (not (member (db:test-get-status test)
			      '("n/a" "KEEP_TRYING")))))
	  prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met)
  (filter
   (lambda (t)
     (or (not (vector? t))
	 (not (equal? "COMPLETED" (db:test-get-state t)))))
   prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met)
  (filter
   (lambda (t)
     (or (not (vector? t))
	 (not (equal? "COMPLETED" (db:test-get-state t)))))
   prereqs-not-met))

(define (runs:calc-runnable prereqs-not-met)
  (filter 
   (lambda (t)
     (or (not (vector? t))
	 (and (equal? "NOT_STARTED" (db:test-get-state t))
	      (member (db:test-get-status t)







|
















|


|
|
|
|
|
|







1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
    ;; LET* ((test-record
    ;; we get here on "drop through". All done!
    (debug:print-info 1 "All tests launched")))

(define (runs:calc-fails prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED"))
		 (not (member (db:test-get-status test)
			      '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))))
	  prereqs-not-met))

(define (runs:calc-prereq-fail prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "NOT_STARTED")
		 (not (member (db:test-get-status test)
			      '("n/a" "KEEP_TRYING")))))
	  prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met)
  (filter
   (lambda (t)
     (or (not (vector? t))
	 (not (member (db:test-get-state t) '("INCOMPLETE" "COMPLETED")))))
   prereqs-not-met))

;; (define (runs:calc-not-completed prereqs-not-met)
;;   (filter
;;    (lambda (t)
;;      (or (not (vector? t))
;; 	 (not (equal? "COMPLETED" (db:test-get-state t)))))
;;    prereqs-not-met))

(define (runs:calc-runnable prereqs-not-met)
  (filter 
   (lambda (t)
     (or (not (vector? t))
	 (and (equal? "NOT_STARTED" (db:test-get-state t))
	      (member (db:test-get-status t)
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (if (not test-id)(set! test-id (rmt:get-test-id run-id test-name item-path area-dat)))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (rmt:general-call 'register-test run-id area-dat run-id test-name item-path area-dat)
		  (set! test-id (rmt:get-test-id run-id test-name item-path area-dat))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (rmt:get-test-info-by-id run-id test-id area-dat))
	    (if (not testdat)
		(begin
		  (debug:print-info 0 "WARNING: server is overloaded, trying again in one second")
		  (thread-sleep! 1)







|







1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (if (not test-id)(set! test-id (rmt:get-test-id run-id test-name item-path area-dat)))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (rmt:register-test area-dat run-id test-name item-path)
		  (set! test-id (rmt:get-test-id run-id test-name item-path area-dat))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (rmt:get-test-info-by-id run-id test-id area-dat))
	    (if (not testdat)
		(begin
		  (debug:print-info 0 "WARNING: server is overloaded, trying again in one second")
		  (thread-sleep! 1)
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED
		(if testdat
		    (string->symbol (test:get-state testdat))
		    'failed-to-insert))
	((failed-to-insert)
	 (debug:print 0 "ERROR: Failed to insert the record into the db"))
	((NOT_STARTED COMPLETED DELETED)
	 (let ((runflag #f))
	   (cond
	    ;; -force, run no matter what
	    (force (set! runflag #t))
	    ;; NOT_STARTED, run no matter what
	    ((member (test:get-state testdat) '("DELETED" "NOT_STARTED"))(set! runflag #t))
	    ;; not -rerun and PASS, WARN or CHECK, do no run
	    ((and (or (not rerun)
		      keepgoing)
		  ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK
		  (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP" "WAIVED"))
		      (member (test:get-state  testdat) '("COMPLETED")))) 
	     (debug:print-info 2 "running test " test-name "/" item-path " suppressed as it is " (test:get-state testdat) " and " (test:get-status testdat))







|





|







1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED
		(if testdat
		    (string->symbol (test:get-state testdat))
		    'failed-to-insert))
	((failed-to-insert)
	 (debug:print 0 "ERROR: Failed to insert the record into the db"))
	((NOT_STARTED COMPLETED DELETED INCOMPLETE)
	 (let ((runflag #f))
	   (cond
	    ;; -force, run no matter what
	    (force (set! runflag #t))
	    ;; NOT_STARTED, run no matter what
	    ((member (test:get-state testdat) '("DELETED" "NOT_STARTED" "INCOMPLETE"))(set! runflag #t))
	    ;; not -rerun and PASS, WARN or CHECK, do no run
	    ((and (or (not rerun)
		      keepgoing)
		  ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK
		  (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP" "WAIVED"))
		      (member (test:get-state  testdat) '("COMPLETED")))) 
	     (debug:print-info 2 "running test " test-name "/" item-path " suppressed as it is " (test:get-state testdat) " and " (test:get-status testdat))
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
		       (set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists")))))

		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED") '("PASS" "FAIL" "ABORT") #f))
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test







|







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
		       (set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists")))))

		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test

Modified tdb.scm from [8118e8579d] to [d933067864].

38
39
40
41
42
43
44
45




46
47
48
49
50
51
52
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area area-dat) 




  (debug:print-info 11 "open-test-db " work-area)
  (if (and work-area 
	   (directory? work-area)
	   (file-read-access? work-area))
      (let* ((dbpath              (conc work-area "/testdat.db"))
	     (dbexists            (file-exists? dbpath))
	     (work-area-writeable (file-write-access? work-area))







<
>
>
>
>







38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
55
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)

;;
;; Moved these tables into <runid>.db
;; THIS CODE TO BE REMOVED
;;
  (debug:print-info 11 "open-test-db " work-area)
  (if (and work-area 
	   (directory? work-area)
	   (file-read-access? work-area))
      (let* ((dbpath              (conc work-area "/testdat.db"))
	     (dbexists            (file-exists? dbpath))
	     (work-area-writeable (file-write-access? work-area))
167
168
169
170
171
172
173


174
175
176
177
178
179
180
              id INTEGER PRIMARY KEY,
              var TEXT,
              val TEXT,
              ackstate INTEGER DEFAULT 0,
              CONSTRAINT metadat_constraint UNIQUE (var));"))))
  (debug:print 11 "db:testdb-initialize END"))



(define (tdb:read-test-data tdb test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     tdb
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)







>
>







170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
              id INTEGER PRIMARY KEY,
              var TEXT,
              val TEXT,
              ackstate INTEGER DEFAULT 0,
              CONSTRAINT metadat_constraint UNIQUE (var));"))))
  (debug:print 11 "db:testdb-initialize END"))

;; This routine moved to db:read-test-data
;;
(define (tdb:read-test-data tdb test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     tdb
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
219
220
221
222
223
224
225


226
227
228
229
230
231
232
;; S T E P S 
;;======================================================================

(define (tdb:step-get-time-as-string vec)
  (seconds->time-string (tdb:step-get-event_time vec)))

;; get a pretty table to summarize steps


;;
(define (tdb:get-steps-table steps);; organise the steps for better readability
  (let ((res (make-hash-table)))
    (for-each 
     (lambda (step)
       (debug:print 6 "step=" step)
       (let ((record (hash-table-ref/default 







>
>







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
;; S T E P S 
;;======================================================================

(define (tdb:step-get-time-as-string vec)
  (seconds->time-string (tdb:step-get-event_time vec)))

;; get a pretty table to summarize steps
;; 
;; NOT USED, WILL BE REMOVED
;;
(define (tdb:get-steps-table steps);; organise the steps for better readability
  (let ((res (make-hash-table)))
    (for-each 
     (lambda (step)
       (debug:print 6 "step=" step)
       (let ((record (hash-table-ref/default 

Modified testnanomsg/req-rep-client.scm from [7998d54555] to [6acf053764].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
;; watch nanomsg's pipeline load-balancer in action.
(use nanomsg)

(define req   (nn-socket 'req))

(nn-connect req  "tcp://localhost:22022")

;; (with-output-to-string (lambda ()(serialize obj)))
(define (client-send-receive soc msg)
  (nn-send soc msg)
  (nn-recv soc))

(define ((talk-to-server soc))
  (let loop ((cnt 20))
    (let ((name (list-ref '("Matt" "Tom" "Bob" "Jill" "James" "Jane")(random 6))))
      (print "Sending " name)
      (print (client-send-receive req name))
      (if (> cnt 0)(loop (- cnt 1)))))
  (print (client-send-receive req "quit"))
  (nn-close req)
  (exit))













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
;; watch nanomsg's pipeline load-balancer in action.
(use nanomsg)

(define req   (nn-socket 'req))

(nn-connect req  "tcp://localhost:22022")

;; (with-output-to-string (lambda ()(serialize obj)))
(define (client-send-receive soc msg)
  (nn-send soc msg)
  (nn-recv soc))

(define ((talk-to-server soc))
  (let loop ((cnt 2000))
    (let ((name (list-ref '("Matt" "Tom" "Bob" "Jill" "James" "Jane")(random 6))))
      (print "Sending " name)
      (print (client-send-receive req name))
      (if (> cnt 0)(loop (- cnt 1)))))
  (print (client-send-receive req "quit"))
  (nn-close req)
  (exit))

Modified testnanomsg/req-rep-server.scm from [d9de6da037] to [b86617cfd7].

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
      (nn-send soc "Ok, quitting"))
     ((and (>= (string-length msg-in) 4)
	   (equal? (substring msg-in 0 4) "ping"))
      (nn-send soc (conc (current-process-id)))
      (loop (nn-recv soc)))
     ;;((and (>= (string-length msg-in)
     (else
      (let ((this-task (random 15)))
	(thread-sleep! this-task)
	(nn-send soc (conc "hello " msg-in " this task took " this-task " seconds to complete"))
	(loop (nn-recv soc)))))))

(define (ping-self host port #!key (return-socket #t))
  ;; send a random number along with pid and check that we get it back
  (let* ((req     (nn-socket 'req))
	 (key     "ping")







|
|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
      (nn-send soc "Ok, quitting"))
     ((and (>= (string-length msg-in) 4)
	   (equal? (substring msg-in 0 4) "ping"))
      (nn-send soc (conc (current-process-id)))
      (loop (nn-recv soc)))
     ;;((and (>= (string-length msg-in)
     (else
      (let ((this-task (random 10)))
	(thread-sleep! (/ this-task 10.0))
	(nn-send soc (conc "hello " msg-in " this task took " this-task " seconds to complete"))
	(loop (nn-recv soc)))))))

(define (ping-self host port #!key (return-socket #t))
  ;; send a random number along with pid and check that we get it back
  (let* ((req     (nn-socket 'req))
	 (key     "ping")

Modified testnanomsg/req-rep.scm from [b77ebf1421] to [d17a548c7a].

Modified tests.scm from [7f981c8a71] to [42ae928d58].

30
31
32
33
34
35
36
37
38

39
40
41
42

43






44
45
46
47
48
49
50
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all area-dat)
  (let* ((test-search-path   (tests:get-tests-search-path (megatest:area-configdat area-dat) area-dat)))

    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat area-dat)
  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))

    (append paths (list (conc (megatest:area-path area-dat) "/tests")))))







(define (tests:get-valid-tests test-registry tests-paths)
  (if (null? tests-paths) 
      test-registry
      (let loop ((hed (car tests-paths))
		 (tal (cdr tests-paths)))
	(if (file-exists? hed)







|
|
>




>
|
>
>
>
>
>
>







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
55
56
57
58
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

;; Call this one to do all the work and get a standardized list of tests
;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat area-dat)
  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
    (filter (lambda (d)
;;     (append paths (list (conc (megatest:area-path area-dat) "/tests")))))
	      (if (directory-exists? d)
		  d
		  (begin
		    (debug:print 0 "WARNING: problem with directory " d ", dropping it from tests path")
		    #f)))
	    (append paths (list (conc *toppath* "/tests"))))))

(define (tests:get-valid-tests test-registry tests-paths)
  (if (null? tests-paths) 
      test-registry
      (let loop ((hed (car tests-paths))
		 (tal (cdr tests-paths)))
	(if (file-exists? hed)
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
			   type     )))
	    ;; This was run remote, don't think that makes sense. Perhaps not, but that is the easiest path for the moment.
	    (rmt:csv->test-data run-id test-id
				dat))))
      
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (not (equal? item-path ""))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path status))

    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(let ((cmt  (if waived waived comment)))
	  (rmt:general-call 'set-test-comment run-id cmt test-id)))))








|







290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
			   type     )))
	    ;; This was run remote, don't think that makes sense. Perhaps not, but that is the easiest path for the moment.
	    (rmt:csv->test-data run-id test-id
				dat))))
      
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (not (equal? item-path ""))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path state status))

    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(let ((cmt  (if waived waived comment)))
	  (rmt:general-call 'set-test-comment run-id cmt test-id)))))

581
582
583
584
585
586
587

588
589
590
591
592
593
594
;;     (set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))


(define (tests:get-testconfig test-name test-registry system-allowed area-dat)
  (let* ((test-path    (hash-table-ref/default test-registry test-name (conc (megatest:area-path area-dat) "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (tcfg         (if testexists
			   (read-config test-configf #f system-allowed environ-patt: (if system-allowed







>







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
;;     (set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))


(define (tests:get-testconfig test-name test-registry system-allowed area-dat)
  (let* ((test-path    (hash-table-ref/default test-registry test-name (conc (megatest:area-path area-dat) "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (tcfg         (if testexists
			   (read-config test-configf #f system-allowed environ-patt: (if system-allowed
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
	       ;; from the runnable list
	       (if keep-test
		   (for-each (lambda (waiton)
			       ;; for now we are waiting only on the parent test
			       (let* ((parent-test-id (rmt:get-test-id run-id waiton ""))
				      (wtdat          (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id (common:get-remote remote) test-id)))
				 (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED")
					      (member (db:test-get-status wtdat) '("FAIL")))
					 (member (db:test-get-status wtdat)  '("KILLED"))
					 (member (db:test-get-state wtdat)   '("INCOMPETE")))
				 ;; (if (or (member (db:test-get-status wtdat)
				 ;;        	 '("FAIL" "KILLED"))
				 ;;         (member (db:test-get-state wtdat)
				 ;;        	 '("INCOMPETE")))
				     (set! keep-test #f)))) ;; no point in running this one again







|







677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
	       ;; from the runnable list
	       (if keep-test
		   (for-each (lambda (waiton)
			       ;; for now we are waiting only on the parent test
			       (let* ((parent-test-id (rmt:get-test-id run-id waiton ""))
				      (wtdat          (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id (common:get-remote remote) test-id)))
				 (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED")
					      (member (db:test-get-status wtdat) '("FAIL" "ABORT")))
					 (member (db:test-get-status wtdat)  '("KILLED"))
					 (member (db:test-get-state wtdat)   '("INCOMPETE")))
				 ;; (if (or (member (db:test-get-status wtdat)
				 ;;        	 '("FAIL" "KILLED"))
				 ;;         (member (db:test-get-state wtdat)
				 ;;        	 '("INCOMPETE")))
				     (set! keep-test #f)))) ;; no point in running this one again

Modified tests/Makefile from [941536fddc] to [4435392f7a].

17
18
19
20
21
22
23
24
25
26





27
28




29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
FS  = $(shell df -T .|tail -1|awk '{print $$2}')
VER = $(shell fsl info|grep checkout|awk '{print $$2}'|cut -c 1-5)

# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : unit test1 test2 test3 test4 test5 test6 test7 test8 test9

unit :





	./rununittest.sh basicserver $(DEBUG)





server :
	cd ..;make -j;make install
	cd fullrun;$(MEGATEST) -server - -debug $(DEBUG) -run-id $(RUNID)

stopserver :
	cd ..;make -j && make install
	cd fullrun;$(MEGATEST) -stop-server 0

repl :
	cd ..;make -j && make install
	cd fullrun;$(MEGATEST) -:b -repl

test0 : cleanprep
	cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG)

test1 : cleanprep








|

|
>
>
>
>
>
|

>
>
>
>

<



<



<







17
18
19
20
21
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
FS  = $(shell df -T .|tail -1|awk '{print $$2}')
VER = $(shell fsl info|grep checkout|awk '{print $$2}'|cut -c 1-5)

# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : build unit test1 test2 test3 test4 test5 test6 test7 test8 test9

unit : basicserver.log runs.log misc.log

rel : 
	cd release;dashboard -rows 25 &

## basicserver.log : unittests/basicserver.scm
## 	script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log

%.log : build unittests/%.scm
	script -c "./rununittest.sh $* $(DEBUG)" $*.log
	if logpro unit.logpro $*.html < $*.log > /dev/null;then echo ALLPASS;else echo ALLFAIL;mv $*.log $*.log.FAIL;fi

server :

	cd fullrun;$(MEGATEST) -server - -debug $(DEBUG) -run-id $(RUNID)

stopserver :

	cd fullrun;$(MEGATEST) -stop-server 0

repl :

	cd fullrun;$(MEGATEST) -:b -repl

test0 : cleanprep
	cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG)

test1 : cleanprep

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
	     for dpath in none tmp; do \
	        (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
	     done;done;done

test11 :
	 cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10 ;do   (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )

minsetup : 

	cd ..;make -j && make install






	mkdir -p mintest/runs mintest/links
	cd mintest;$(MEGATEST) -stop-server 0
	cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & 
	sleep 3
	cd mintest;$(DASHBOARD) -rows 18 &

cleanprep : ../*.scm Makefile */*.config
	mkdir -p fullrun/tmp/mt_runs fullrun/tmp/mt_links /tmp/$(USER)/adisk1
	cd ..;make -j;make install
	rm -f */logging.db
	touch cleanprep

fullprep : cleanprep
	cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/%
	cd fullrun;$(BINPATH)/dashboard -rows 15 &








|
>

>
>
>
>
>
>






|

<







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
183
	     for dpath in none tmp; do \
	        (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
	     done;done;done

test11 :
	 cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10 ;do   (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )

build : ../*.scm
	if killall mtest -v ;then sleep 5;killall mtest -v -9;fi
	cd ..;make -j && make install
	touch build

cleanstart :
	killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi

minsetup : build
	mkdir -p mintest/runs mintest/links
	cd mintest;$(MEGATEST) -stop-server 0
	cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & 
	sleep 3
	cd mintest;$(DASHBOARD) -rows 18 &

cleanprep : ../*.scm Makefile */*.config build
	mkdir -p fullrun/tmp/mt_runs fullrun/tmp/mt_links /tmp/$(USER)/adisk1

	rm -f */logging.db
	touch cleanprep

fullprep : cleanprep
	cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/%
	cd fullrun;$(BINPATH)/dashboard -rows 15 &

Modified tests/fdktestqa/fdk.config from [2f7079bd4e] to [1449c69529].

25
26
27
28
29
30
31
32
33
34
35
36

# force server
server-query-threshold 0


[jobtools]
# launcher nbq -P ch_vp -C SLES11_EM64T_4G -Q /ciaf/fdk
# launcher nbfake
# maxload 4

launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 








|
|

|

25
26
27
28
29
30
31
32
33
34
35
36

# force server
server-query-threshold 0


[jobtools]
# launcher nbq -P ch_vp -C SLES11_EM64T_4G -Q /ciaf/fdk
launcher nbfake
maxload 4

# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 

Modified tests/fdktestqa/testqa/Makefile from [d3de829000] to [2d20ab8370].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37
38
BINDIR    = $(PWD)/../../../bin
PATH     := $(BINDIR):$(PATH)
MEGATEST  = $(BINDIR)/megatest
DASHBOARD = $(BINDIR)/dashboard
NEWDASHBOARD = $(BINDIR)/newdashboard
RUNNAME   = a


all :
	$(MEGATEST) -remove-runs -target a/b :runname c -testpatt %/%
	$(MEGATEST) -runtests % -target a/b :runname c

bigbig :
	for tn in a b c d;do \
	   ($(MEGATEST) -runtests % -target a/b :runname $tn & ) ; \
	done

bigrun :
	$(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V)

bigrun2 :
	$(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V)

bigrun3 :
	$(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME)

dashboard : 

	$(DASHBOARD) -rows 20 &

newdashboard :
	$(NEWDASHBOARD) &

compile :
	(cd ../../..;make -j && make install)

clean :
	rm -rf ../simple*/*/* megatest.db db/* ../simple*/.db/* logs/* monitor.db







|











|


|


|


>











1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
BINDIR    = $(PWD)/../../../bin
PATH     := $(BINDIR):$(PATH)
MEGATEST  = $(BINDIR)/megatest
DASHBOARD = $(BINDIR)/dashboard
NEWDASHBOARD = $(BINDIR)/newdashboard
RUNNAME   = a
NUMTESTS  = 20

all :
	$(MEGATEST) -remove-runs -target a/b :runname c -testpatt %/%
	$(MEGATEST) -runtests % -target a/b :runname c

bigbig :
	for tn in a b c d;do \
	   ($(MEGATEST) -runtests % -target a/b :runname $tn & ) ; \
	done

bigrun :
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V)

bigrun2 :
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V)

bigrun3 :
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME)

dashboard : 
	mkdir -p ../simpleruns
	$(DASHBOARD) -rows 20 &

newdashboard :
	$(NEWDASHBOARD) &

compile :
	(cd ../../..;make -j && make install)

clean :
	rm -rf ../simple*/*/* megatest.db db/* ../simple*/.db/* logs/* monitor.db

Modified tests/fullrun/megatest.config from [a0ee46acbe] to [a28ebec5df].

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
MYRUNNAME2 /this/is/[system echo $MT_RUNNAME]/my/runname


# XTERM   [system xterm]
# RUNDEAD [system exit 56]

[server]




# Use http instead of direct filesystem access
transport http
# transport fs
# transport nmsg

synchronous 0

# If the server can't be started on this port it will try the next port until
# it succeeds
port 9080

# This server will keep running this number of hours after last access. 
# Three minutes is 0.05 hours
# timeout 0.025
timeout 0.061

# faststart; unless no, start server but proceed with writes until server started

faststart yes

# Start server when average query takes longer than this
# server-query-threshold 55500
server-query-threshold 100
timeout 0.01

# daemonize yes
# hostname #{scheme (get-host-name)}

## disks are:
## name host:/path/to/area







>
>
>


















>
|



|







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
183
184
185
MYRUNNAME2 /this/is/[system echo $MT_RUNNAME]/my/runname


# XTERM   [system xterm]
# RUNDEAD [system exit 56]

[server]

# force use of server always
required yes

# Use http instead of direct filesystem access
transport http
# transport fs
# transport nmsg

synchronous 0

# If the server can't be started on this port it will try the next port until
# it succeeds
port 9080

# This server will keep running this number of hours after last access. 
# Three minutes is 0.05 hours
# timeout 0.025
timeout 0.061

# faststart; unless no, start server but proceed with writes until server started
faststart no
# faststart yes

# Start server when average query takes longer than this
# server-query-threshold 55500
server-query-threshold 1000
timeout 0.01

# daemonize yes
# hostname #{scheme (get-host-name)}

## disks are:
## name host:/path/to/area
228
229
230
231
232
233
234
235
236
237
238
239
240



241
242
243
244
245
246
247






#  <testsuite>/<creationdate>
# Within the archive the data is structured like this:
#  <target>/<runname>/<test>/
disk0 /tmp/#{getenv USER}/adisk1

# Uncomment these to emulate a job queue with a long time (look in bin/sleeprunner for the time)
[jobtools]
launcher #{scheme (case (string->symbol (conc (getenv "datapath"))) \
                      ((none) "nbfake") \
                      ((openlava) "bsub") \
                      (else "sleeprunner"))}

# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 




[configf:settings trim-trailing-spaces yes]

[test]
# VAL1 has trailing spaces
VAL1 Foo    
VAL2 ==>#{get test VAL1}Bar<== no spaces between Foo and Bar to pass













|
|
|
|


>
>
>







>
>
>
>
>
>
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
#  <testsuite>/<creationdate>
# Within the archive the data is structured like this:
#  <target>/<runname>/<test>/
disk0 /tmp/#{getenv USER}/adisk1

# Uncomment these to emulate a job queue with a long time (look in bin/sleeprunner for the time)
[jobtools]
# launcher #{ scheme (case (string->symbol (conc (getenv "datapath"))) \
#                         ((none) "nbfake") \
#                         ((openlava) "bsub") \
#                         (else "sleeprunner"))}

# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 

# launcher #{shell if which bsub > /dev/null;then echo bsub -q priority -o openlava.log;else echo sleeprunner;fi}
launcher nbfake

[configf:settings trim-trailing-spaces yes]

[test]
# VAL1 has trailing spaces
VAL1 Foo    
VAL2 ==>#{get test VAL1}Bar<== no spaces between Foo and Bar to pass

ltest #{scheme (case (string->symbol (conc (getenv "datapath"))) \
                        ((none) "nbfake") \
                        ((openlava) "bsub") \
                        (else "sleeprunner"))}

Added tests/release/Makefile version [0d13fa9945].





















>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10


dashboard : compile
	dashboard -rows 24 &

compile : runs
	cd ../..;make -j install

runs :
	mkdir -p runs

Added tests/release/megatest.config version [0bf84b11be].













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
[fields]
release TEXT
iteration TEXT

[setup]
linktree #{getenv MT_RUN_AREA_HOME}/links
max_concurrent_jobs 100
logviewer (%MTCMD%) 2> /dev/null > /dev/null
# htmlviewercmd firefox -new-window 
htmlviewercmd arora

[jobtools]
# launcher #{shell if which bsub > /dev/null;then echo bsub;else echo nbfake;fi}
launcher nbfake
maxload 2.5

[server]
required yes

[disks]
disk0 #{getenv MT_RUN_AREA_HOME}/runs

Added tests/release/runconfigs.config version [45021e9fc7].



















>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
[default]
MTRUNNER   #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../utils/mtrunner}
MTTESTDIR  #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/..}
MTPATH     #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../bin}

[v1.60/15]

[include atwork.config]

Added tests/release/tests/fullrun/results.logpro version [7bd9c74d1a].

























































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ("exit_0"		        1  20)
		     ("ezlog_fail_then_pass"    1  20)
		     ("ezlog_pass"	        1  20)
		     ("ez_pass"		        1  20)
		     ("lineitem_pass"	        1  20)
		     ("priority_1"	        1  20)
		     ("priority_10"	        1  20)
		     ("priority_10_waiton_1"    1  20)
		     ("priority_3"	        1  20)
		     ("priority_4"	        1  20)
		     ;; ("priority_5"	        1  20)
		     ("priority_6"	        1  20)
;;		     ("priority_7"	        1  20)
		     ("priority_8"	        1  20)
		     ("priority_9"	        1  20)
		     ("runfirst"	        7  20)
		     ("singletest"	        1  20)
		     ("singletest2"	        1  20)
		     ("special"		        1  20)
		     ("sqlitespeed"	       10  20)
		     ("test1"		        1  20)
		     ("test2"		        6  20)
		     ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ("exit_1"		        1  20)
		     ("ez_exit2_fail"           1  20)
		     ("ez_fail"		        1  20)
		     ("ez_fail_quick"	        1  20)
		     ("ezlog_fail"	        1  20)
		     ("lineitem_fail"	        1  20)
		     ("logpro_required_fail"    1  20)
		     ("manual_example"	        1  20)
		     ("neverrun"	        1  20)))
		     
(define warn-specs   '(("ezlog_warn"	        1  20)))

(define nost-specs   '(("wait_no_items1"        1  20)
		       ("wait_no_items2"        1  20)
		       ("wait_no_items3"        1  20)
		       ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
(expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
(expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
(expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
(expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
(expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
(expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
(expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
(expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
(expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/fullrun/testconfig version [be4bd3c0d9].























>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
[ezsteps]
cleantop $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -target ubuntu/nfs/none -runname release_toplevel -testpatt %
runall   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt %            -target ubuntu/nfs/none -runname release_toplevel -runwait
runtop   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt all_toplevel -target ubuntu/nfs/none -runname release_toplevel -rerun FAIL -preclean -runwait
results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_toplevel -target ubuntu/nfs/none -runname release_toplevel 

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel

Added tests/release/tests/itemwait/testconfig version [c976040a3b].

















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# test2 from the tests/Makefile

[var]
tname itemwait

[pre-launch-env-vars]
NUMTESTS 20

[ezsteps]

# Set things up
clean      $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -remove-runs -testpatt % -target  %/% -runname #{get var tname}%
runbigrun3 $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH nbfake megatest -run     -testpatt bigrun3 -target a/bigrun3 -runname #{get var tname}
# watchrun watches until it sees at least one RUNNING in bigrun and one PASS in bigrun2
watchrun   sleep 15;watchrun.sh #{get var tname}

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel


# test2 : fullprep

Added tests/release/tests/itemwait/watchrun.sh version [3cd7d57805].



























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#!/bin/bash

runname=$1

pass=no
alldone=no
while [[ $alldone == no ]];do
    sleep 5
    $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -list-runs $runname > list-runs.log
    bigrun_running=$(cat list-runs.log | egrep 'bigrun\(.*RUNNING'|wc -l)
    bigrun2_pass=$(cat list-runs.log   | egrep 'bigrun2.*COMPLETED.*PASS'|wc -l)
    echo "bigrun_running=$bigrun_running, bigrun2_pass=$bigrun2_pass"
    if [[ $bigrun_running -gt 0 ]] && [[ $bigrun2_pass -gt 0 ]];then
	pass=yes
	alldone=yes
    fi
    if [[ $bigrun_running -eq 0 ]];then
	echo "bigrun all done and no bigrun2 found with PASS."
	alldone=yes
    fi
done

if [[ $pass == yes ]];then
    echo PASS
    exit 0
else
    echo FAIL
    exit 1
fi

Added tests/release/tests/rollup/firstres.logpro version [aa9c55c1c8].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        7  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/rollup/results.logpro version [ed47d73b48].



































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        5  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
(expect:required in logbody =  1  "Toplevel will be NOT_STARTED"        #/Test: runfirst\s+State: (INCOMPLETE|NOT_STARTED)/)
(expect:required in logbody =  1  "runfirst/b/2 will be NOT_STARTED/INCOMPLETE" #/Test: runfirst.b.2.\s+State: NOT_STARTED\s+Status: INCOMPLETE/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/rollup/testconfig version [3a08af0f00].

























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# test2 from the tests/Makefile

[var]
tname rollup

[ezsteps]

# Set things up
clean    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -remove-runs -testpatt %                    -target  ubuntu/nfs/none -runname #{get var tname}%
runfirst $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -runtests runfirst/% -reqtarg ubuntu/nfs/none -runname #{get var tname}   -preclean
firstres $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -list-runs #{get var tname}   -target ubuntu/nfs/none

# Set one test item to INCOMPLETE
setstate $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -set-state-status INCOMPLETE,FAIL :state COMPLETED :status PASS -testpatt runfirst/b/2 -target ubuntu/nfs/none -runname #{get var tname}

# Rerun a different test item
rerun    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  runfirst/spring     -reqtarg ubuntu/nfs/none -runname #{get var tname} -preclean -rerun PASS

results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname} -target ubuntu/nfs/none

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel


# test2 : fullprep

Added tests/release/tests/test2/results.logpro version [0604885ee3].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        2  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/test2/results_a.logpro version [0604885ee3].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        2  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/test2/results_b.logpro version [0604885ee3].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        2  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/test2/testconfig version [94d7901019].























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
# test2 from the tests/Makefile

[var]
tname test2
mtpath #{shell readlink -f ../../bin}

[ezsteps]
clean    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -remove-runs -testpatt %                    -target  ubuntu/nfs/none -runname #{get var tname}%
part1    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt ez_pass,runfirst/a/% -reqtarg ubuntu/nfs/none -runname #{get var tname}   -preclean
part2    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  %/,%/ai             -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part3    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -runtests %/,%/ai                           -reqtarg ubuntu/nfs/none -runname #{get var tname}_b -preclean
part4    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  runfirst/%,%/ai     -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part5    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt %/,%/winter          -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part6    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -set-state-status COMPLETED,FORCED :state COMPLETED :status PASS -testpatt ez_p%s,runfirst/ -target ubuntu/nfs/none -runname #{get var tname}

results   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}   -target ubuntu/nfs/none
results_a $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_a -target ubuntu/nfs/none
results_b $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_b -target ubuntu/nfs/none

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel


# test2 : fullprep

Added tests/release/tests/testpatt/cleanres.logpro version [8613c2bd62].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ;; ("runfirst"	        2  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/testpatt/results.logpro version [0604885ee3].

































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
55
56
57
58
59
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
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
;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_0"		        1  20)
		     ;; ("ezlog_fail_then_pass"    1  20)
		     ;; ("ezlog_pass"	        1  20)
		     ;; ("ez_pass"		        1  20)
		     ;; ("lineitem_pass"	        1  20)
		     ;; ("priority_1"	        1  20)
		     ;; ("priority_10"	        1  20)
		     ;; ("priority_10_waiton_1"    1  20)
		     ;; ("priority_3"	        1  20)
		     ;; ("priority_4"	        1  20)
		     ;; ;; ("priority_5"	        1  20)
		     ;; ("priority_6"	        1  20)
;;		     ;; ("priority_7"	        1  20)
		     ;; ("priority_8"	        1  20)
		     ;; ("priority_9"	        1  20)
		     ("runfirst"	        2  20)
		     ;; ("singletest"	        1  20)
		     ;; ("singletest2"	        1  20)
		     ;; ("special"		        1  20)
		     ;; ("sqlitespeed"	       10  20)
		     ;; ("test1"		        1  20)
		     ;; ("test2"		        6  20)
		     ;; ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ;; ("exit_1"		        1  20)
		     ;; ("ez_exit2_fail"           1  20)
		     ;; ("ez_fail"		        1  20)
		     ;; ("ez_fail_quick"	        1  20)
		     ;; ("ezlog_fail"	        1  20)
		     ;; ("lineitem_fail"	        1  20)
		     ;; ("logpro_required_fail"    1  20)
		     ;; ("manual_example"	        1  20)
		     ;; ("neverrun"	        1  20)
		     ))
		     
(define warn-specs   '(
                     ;; ("ezlog_warn"	        1  20)
                     ))

(define nost-specs   '(
                       ;; ("wait_no_items1"        1  20)
		       ;; ("wait_no_items2"        1  20)
		       ;; ("wait_no_items3"        1  20)
		       ;; ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
;; (expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
;; (expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
;; (expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
;; (expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
;; (expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
;; (expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
;; (expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
;; (expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

Added tests/release/tests/testpatt/testconfig version [ddc5455f74].

























>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
[ezsteps]
clean    $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -testpatt % -target ubuntu/nfs/none -runname release_testpatt
cleanres $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_testpatt -target ubuntu/nfs/none

runitems $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt runfirst/%2 -target ubuntu/nfs/none -runname release_testpatt
results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_testpatt -target ubuntu/nfs/none

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel

Modified tests/rununittest.sh from [d9bb67915f] to [1c13c943af].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/bin/bash

# Usage: rununittest.sh testname debuglevel
#

# Ensure all is made
(cd ..;make && make install)

# put megatest on path from correct location
mtbindir=$(readlink -f ../bin)

export PATH="${mtbindir}:$PATH"

# Clean setup
#





<
<
<







1
2
3
4
5



6
7
8
9
10
11
12
#!/bin/bash

# Usage: rununittest.sh testname debuglevel
#




# put megatest on path from correct location
mtbindir=$(readlink -f ../bin)

export PATH="${mtbindir}:$PATH"

# Clean setup
#

Added tests/unit.logpro version [64aefe97ac].

















>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
;; You should have at least one expect:required. This ensures that your process ran
(expect:required in "LogFileBody" > 0 "At least one PASS" #/\[.{0,4}PASS.{0,4}\]/)

;; You may need ignores to suppress false error or warning hits from the later expects
;; NOTE: Order is important here!
(expect:ignore   in "LogFileBody"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
(expect:warning  in "LogFileBody"  = 0 "Any warning" #/warn/)
(expect:error    in "LogFileBody"  = 0 "Any error"  (list #/error/i #/\[.{0,4}FAIL.{0,4}\]/)) ;; but disallow any other errors

Modified tests/unittests/misc.scm from [68603bcdd2] to [f0ad22a5f3].

39
40
41
42
43
44
45




;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,%/b%"))











>
>
>
39
40
41
42
43
44
45
46
47
48

;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,%/b%"))


(exit)

Modified tests/unittests/runs.scm from [61908ea980] to [25943e33c5].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
(define keys (db:get-keys *db*))

(test "get all legal tests" (list "test1" "test2") (sort (get-all-legal-tests) string<=?))

(test "register-run" #t (number?
			 (db:register-run *db*
					  '(("SYSTEM" "key1")("RELEASE" "key2"))
					  "myrun" 
					  "new"
					  "n/a" 
					  "bob")))

(test #f #t             (cdb:tests-register-test *runremote* 1 "nada" ""))
(test #f 1              (cdb:remote-run db:get-test-id #f 1 "nada" ""))
(test #f "NOT_STARTED"  (vector-ref (open-run-close db:get-test-info #f 1 "nada" "") 3))
(test #f "NOT_STARTED"  (vector-ref (cdb:get-test-info *runremote* 1 "nada" "") 3))

(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "key2" (vector-ref (car (vector-ref (runs:get-runs-by-patt *db* '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1))

(test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))))
(test #f #t (runs:operate-on 'print "%" "%" "%"))

;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" 
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
|

|


|






|
|
<
|


|







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

15
16
17
18
19
20
21
22
23
24
25
(define keys (rmt:get-keys))

(test "get all legal tests" (list "test1" "test2") (sort (hash-table-keys (tests:get-all)) string<=?))

(test "register-run" #t (number?
			 (rmt:register-run 
					  '(("SYSTEM" "key1")("RELEASE" "key2"))
					  "myrun" 
					  "new"
					  "n/a" 
					  "bob")))

(test #f #t             (rmt:register-test 1 "nada" ""))
(test #f 30001          (rmt:get-test-id 1 "nada" ""))

(test #f "NOT_STARTED"  (vector-ref (rmt:get-test-info-by-id 1 30001) 3)) ;; "nada" "") 3))

(test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def"))
(test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1))

(test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))))
(test #f #t (runs:operate-on 'print "%" "%" "%"))

;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" 
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
46
47
48
49
50
51
52
53

54
55
56
57
58

59
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
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

(define test-id #f)

;; force keepgoing
; (hash-table-set! args:arg-hash "-keepgoing" #t)
(hash-table-set! args:arg-hash "-itempatt" "%")
(hash-table-set! args:arg-hash "-testpatt" "%")
(hash-table-set! args:arg-hash "-target" "ubuntu/r1.2")

(test "Setup for a run"       #t (begin (setup-for-run) #t))

(define *tdb* #f)
(define keyvals #f)
(test "target->keyval" #t (let ((kv (keys:target->keyval keys (args:get-arg "-target"))))

			    (set! keyvals kv)(list? keyvals)))

(define testdbpath (conc "/tmp/" (getenv "USER") "/megatest_testing"))
(system (conc "rm -f " testdbpath "/testdat.db;mkdir -p " testdbpath))

(print "Using " testdbpath " for test db")
(test #f #t (let ((db (open-test-db testdbpath)))
	      (set! *tdb* db)
	      (sqlite3#database? db)))
(sqlite3#finalize! *tdb*)

;; (test "Remove the rollup run" #t (begin (remove-runs) #t))
(define tconfig #f)
(test "get a testconfig" #t (let ((tconf (tests:get-testconfig "test1" 'return-procs)))
			      (set! tconfig tconf)
			      (hash-table? tconf)))
(db:clean-all-caches)

(test "set-megatest-env-vars"
      "ubuntu"
      (begin
	(set-megatest-env-vars 1 inkeys: keys)
	(get-environment-variable "SYSTEM")))
(test "setup-env-defaults"
      "see this variable"
      (begin
	(setup-env-defaults "runconfigs.config" 1 *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars")
	(get-environment-variable "ALLTESTS")))

(test #f "ubuntu" (car (keys:target-set-args keys (args:get-arg "-target") args:arg-hash)))

(define rinfo #f)
(test "get-run-info"  #f (vector? (vector-ref (let ((rinf (cdb:remote-run db:get-run-info #f 1)))
						(set! rinfo rinf)
						rinf) 0)))
(test "get-key-vals"  "key1" (car (cdb:remote-run db:get-key-vals #f 1)))
(test "tests:sort-by" '() (tests:sort-by-priority-and-waiton (make-hash-table)))

(test "update-test_meta" "test1" (begin
				   (runs:update-test_meta "test1" tconfig)
				   (let ((dat (cdb:remote-run db:testmeta-get-record #f "test1")))
				     (vector-ref dat 1))))

(define test-path "tests/test1")
(define disk-path #f)
(test "get-best-disk"    #t (string? (file-exists? (let ((d (get-best-disk *configdat*)))
						     (set! disk-path d)
						     d))))
(test "create-work-area" #t (symbolic-link? (car (create-work-area 1 rinfo keyvals 1 test-path disk-path "test1" '()))))
(test #f "" (item-list->path '()))

(test "launch-test" #t (string? (file-exists? (launch-test 1 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table)))))




(test "Run a test" #t (general-run-call 
		       "-runtests" 
		       "run a test"
		       (lambda (target runname keys keyvallst)

			 (let ((test-patts "test%"))
			   ;; (runs:run-tests target runname test-patts user (make-hash-table))
			   ;; (run:test run-id run-info key-vals runname test-record flags parent-test)
			   ;; (set! *verbosity* 22) ;; (list 0 1 2))
			   (run:test 1 ;; run-id
				     #f        ;; run-info is yet only a dream
				     keyvallst ;; (keys:target->keyval keys target)

				     "run1"    ;; runname 
				     (vector            ;; test_records.scm tests:testqueue

				      "test1"           ;; testname
				      tconfig           ;; testconfig
				      '()               ;; waitons
				      0                 ;; priority
				      #f                ;; items
				      #f                ;; itemsdat
				      ""                ;; itempath
				      )
				     args:arg-hash      ;; flags (e.g. -itemspatt)



				     #f)
			   ;; (set! *verbosity* 0)
			   ))))

























(test "server stop" #f (let ((hostname (car  *runremote*))
			     (port     (cadr *runremote*)))
			 (tasks:kill-server #t hostname port server-pid 'http)
			 (open-run-close tasks:get-best-server tasks:open-db)))

(exit 1)









































;; (test "cache is coherent" #t (let ((cached-info (db:get-test-info-cached-by-id db 2))
;; 				   (non-cached  (db:get-test-info-not-cached-by-id db 2)))
;; 			       (print "\nCached:    " cached-info)
;; 			       (print "Noncached: " non-cached)
;; 			       (equal? cached-info non-cached)))

(change-directory test-work-dir)

(test "Add a step"  #t
      (begin
	(db:teststep-set-status! db 2 "step1" "start" 0 "This is a comment" "mylogfile.html")
	(sleep 2)
	(db:teststep-set-status! db 2 "step1" "end" "pass" "This is a different comment" "finallogfile.html")
	(set! test-id (db:test-get-id (car (cdb:remote-run db:get-tests-for-run #f 1 "test1" '() '()))))
	(number? test-id)))

(test "Get rundir"       #t (let ((rundir (cdb:remote-run db:test-get-rundir-from-test-id #f test-id)))
			      (print "Rundir " rundir)
			      (system (conc "mkdir -p " rundir))
			      (string? rundir)))
(test #f #t (sqlite3#database? (open-test-db "./")))







|
>
|




>













|


<




|




|





|


|




|










<
|
>
>

<
|
|
|
>
|
<
|
|
|
|
|
>
|
|
>
|
|
<
<
<
<
<
|
<
>
>
>
|
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>



<
<
<
<


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







>


|

|
|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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
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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

(define test-id #f)

;; force keepgoing
; (hash-table-set! args:arg-hash "-keepgoing" #t)
(hash-table-set! args:arg-hash "-itempatt" "%")
(hash-table-set! args:arg-hash "-testpatt" "%")
(hash-table-set! args:arg-hash "-target" "ubuntu/r1.2") ;; SYSTEM/RELEASE
(hash-table-set! args:arg-hash "-runname" "testrun")
(test "Setup for a run"       #t (begin (launch:setup-for-run) #t))

(define *tdb* #f)
(define keyvals #f)
(test "target->keyval" #t (let ((kv (keys:target->keyval keys (args:get-arg "-target"))))
			    (print "keyvals=" kv ", keys=" keys)
			    (set! keyvals kv)(list? keyvals)))

(define testdbpath (conc "/tmp/" (getenv "USER") "/megatest_testing"))
(system (conc "rm -f " testdbpath "/testdat.db;mkdir -p " testdbpath))

(print "Using " testdbpath " for test db")
(test #f #t (let ((db (open-test-db testdbpath)))
	      (set! *tdb* db)
	      (sqlite3#database? db)))
(sqlite3#finalize! *tdb*)

;; (test "Remove the rollup run" #t (begin (remove-runs) #t))
(define tconfig #f)
(test "get a testconfig" #t (let ((tconf (tests:get-testconfig "test1" (tests:get-all) 'return-procs )))
			      (set! tconfig tconf)
			      (hash-table? tconf)))


(test "set-megatest-env-vars"
      "ubuntu"
      (begin
	(runs:set-megatest-env-vars 1 inkeys: keys)
	(get-environment-variable "SYSTEM")))
(test "setup-env-defaults"
      "see this variable"
      (begin
	(setup-env-defaults "runconfigs.config" 1 *already-seen-runconfig-info* keyvals environ-patt: "pre-launch-env-vars")
	(get-environment-variable "ALLTESTS")))

(test #f "ubuntu" (car (keys:target-set-args keys (args:get-arg "-target") args:arg-hash)))

(define rinfo #f)
(test "get-run-info"  #f (vector? (vector-ref (let ((rinf (rmt:get-run-info 1)))
						(set! rinfo rinf)
						rinf) 0)))
;; (test "get-key-vals"  "key1" (car (db:get-key-vals *dbstruct* 1)))
(test "tests:sort-by" '() (tests:sort-by-priority-and-waiton (make-hash-table)))

(test "update-test_meta" "test1" (begin
				   (runs:update-test_meta "test1" tconfig)
				   (let ((dat (rmt:testmeta-get-record "test1")))
				     (vector-ref dat 1))))

(define test-path "tests/test1")
(define disk-path #f)
(test "get-best-disk"    #t (string? (file-exists? (let ((d (get-best-disk *configdat*)))
						     (set! disk-path d)
						     d))))
(test "create-work-area" #t (symbolic-link? (car (create-work-area 1 rinfo keyvals 1 test-path disk-path "test1" '()))))
(test #f "" (item-list->path '()))


;;======================================================================
;; Create a test with multiple items and verify that rollup logic works
;;======================================================================


(rmt:register-test 1 "rollup" "") ;; toplevel test
(for-each
 (lambda (itempath)
   (rmt:register-test 1 "rollup" itempath)
   (let ((test-id (rmt:get-test-id 1 "rollup" itempath))

	 (comment (conc "This is a comment for itempath " itempath)))
     ;; (rmt:test-set-state-status-by-id run-id test-id "COMPLETED" "PASS" comment)
      (tests:test-set-status! 1 test-id "COMPLETED" "PASS" comment #f))) ;;  #!key (work-area #f))
 '("item/1" "item/2" "item/3" "item/4" "item/5"))
 
(test #f #t (number? (rmt:get-test-id 1 "rollup" "item/4")))

(define (get-state-status run-id testname itempath)
  (let ((tdat (rmt:get-test-info-by-id 1 (rmt:get-test-id run-id testname itempath))))
    (list (db:test-get-state  tdat)
	  (db:test-get-status tdat))))







(test "Rollup PASS" '("COMPLETED" "PASS") (get-state-status 1 "rollup" ""))
(let ((test-id (rmt:get-test-id 1 "rollup" "item/4"))
      (top-id  (rmt:get-test-id 1 "rollup" "")))
  (for-each 


   (lambda (state status rup-state rup-status)
     ;; reset to COMPLETED/PASS
     (tests:test-set-status! 1 test-id "COMPLETED" "PASS" #f #f)
     (test "Top reset to COMPLETED/PASS" '("COMPLETED" "PASS")(get-state-status 1 "rollup" ""))
     (tests:test-set-status! 1 test-id state status #f #f)
     (test (conc "Item set to " state "/" status)
	   (list state status)
	   (get-state-status 1 "rollup" "item/4"))
     (test (conc "Rollup of " state "/" status)
	   (list rup-state rup-status)
	   (get-state-status 1 "rollup" "")))
   '("COMPLETED" "COMPLETED" "INCOMPLETE" "INCOMPLETE" "RUNNING" "RUNNING" "COMPLETED" "COMPLETED")
   '("ABORT"     "FAIL"      "PASS"       "FAIL"       "PASS"    "FAIL"    "BLAH"      "AUTO") 
   '("COMPLETED" "COMPLETED" "COMPLETED"  "COMPLETED"  "RUNNING" "RUNNING" "COMPLETED" "COMPLETED")
   '("ABORT"     "FAIL"      "FAIL"       "FAIL"       "PASS"    "FAIL"    "ABORT"     "AUTO")))


(test "launch-test" #t
      (string? 
       (file-exists?
	;; (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params)
	(launch-test 30001 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table)))))








(exit 1)




;; (test "Run a test" #t (general-run-call 
;; 		       "-runtests" 
;; 		       "run a test"
;; 		       (lambda (target runname keys keyvallst)
;; 			 (let ((test-patts "test%"))
;; 			   ;; (runs:run-tests target runname test-patts user (make-hash-table))
;; 			   ;; (run:test run-id run-info key-vals runname test-record flags parent-test)
;; 			   ;; (set! *verbosity* 22) ;; (list 0 1 2))
;; 			   (run:test 1 ;; run-id
;; 				     #f        ;; run-info is yet only a dream
;; 				     keyvallst ;; (keys:target->keyval keys target)
;; 				     "run1"    ;; runname 
;; 				     (vector            ;; test_records.scm tests:testqueue
;; 				      "test1"           ;; testname
;; 				      tconfig           ;; testconfig
;; 				      (make-hash-table) ;; flags
;; 				      #f                ;; parent test
;; 				      (tests:get-all)   ;; test registry
;; 				      0                 ;; priority
;; 				      #f                ;; items
;; 				      #f                ;; itemsdat
;; 				      ""                ;; itempath
;; 				      )
;; 				     args:arg-hash      ;; flags (e.g. -itemspatt)
;; 				     #f)
;; 			   ;; (set! *verbosity* 0)
;; 			   ))))
;; 
;; 
;; 
;; 
;; 
;; (test "server stop" #f (let ((hostname (car  *runremote*))
;; 			     (port     (cadr *runremote*)))
;; 			 (tasks:kill-server #t hostname port server-pid 'http)
;; 			 (open-run-close tasks:get-best-server tasks:open-db)))

;; (test "cache is coherent" #t (let ((cached-info (db:get-test-info-cached-by-id db 2))
;; 				   (non-cached  (db:get-test-info-not-cached-by-id db 2)))
;; 			       (print "\nCached:    " cached-info)
;; 			       (print "Noncached: " non-cached)
;; 			       (equal? cached-info non-cached)))

(change-directory test-work-dir)
(test #f #t (> (length (mt:get-tests-for-run 1 "test1" '() '())) 0))
(test "Add a step"  #t
      (begin
	(rmt:teststep-set-status! 1 30002 "step1" "start" 0 "This is a comment" "mylogfile.html")
	(sleep 2)
	(rmt:teststep-set-status! 1 30002 "step1" "end" "pass" "This is a different comment" "finallogfile.html")
	(set! test-id (db:test-get-id (car (mt:get-tests-for-run 1 "test1" '() '()))))
	(number? test-id)))

(test "Get rundir"       #t (let ((rundir (cdb:remote-run db:test-get-rundir-from-test-id #f test-id)))
			      (print "Rundir " rundir)
			      (system (conc "mkdir -p " rundir))
			      (string? rundir)))
(test #f #t (sqlite3#database? (open-test-db "./")))

Modified tests/unittests/tests.scm from [da39a3ee5e] to [15fd3688ae].



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
;;======================================================================
;; itemwait, itemmatch

(db:compare-itempaths ref-item-path item-path itemmap)

;; prereqs-not-met

(rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))

	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))

Modified utils/Makefile.installall from [c6531307ff] to [df8e3cb2ff].

32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
ifeq ($(PREFIX),)
PREFIX=$(PWD)/target
endif

# Set this on the command line of your make call if needed: make PROXY=host.com:1234
PROXY=


# Select version of chicken, sqlite3 etc
CHICKEN_VERSION=4.9.0.1
SQLITE3_VERSION=3080500
# http://www.sqlite.org/2014/sqlite-autoconf-3080500.tar.gz

# Override IUPBRANCH to use other than trunk
IUPBRANCH=iup-3.10.1

# Eggs to install (straightforward ones)







>

|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
ifeq ($(PREFIX),)
PREFIX=$(PWD)/target
endif

# Set this on the command line of your make call if needed: make PROXY=host.com:1234
PROXY=

# http://code.call-cc.org/dev-snapshots/2015/06/07/chicken-4.10.0rc1.tar.gz
# Select version of chicken, sqlite3 etc
CHICKEN_VERSION=4.10.0rc1
SQLITE3_VERSION=3080500
# http://www.sqlite.org/2014/sqlite-autoconf-3080500.tar.gz

# Override IUPBRANCH to use other than trunk
IUPBRANCH=iup-3.10.1

# Eggs to install (straightforward ones)
134
135
136
137
138
139
140



141
142
143
144
145
146
147

chicken-4.9.0rc1.tar.gz : 
	wget http://code.call-cc.org/dev-snapshots/2014/04/17/chicken-4.9.0rc1.tar.gz

chicken-4.9.0.1.tar.gz :
	wget http://code.call-cc.org/releases/4.9.0/chicken-4.9.0.1.tar.gz




# git clone git://code.call-cc.org/chicken-core
# git clone http://code.call-cc.org/git/chicken-core.git

$(CHICKEN_INSTALL) : chicken-core/chicken.scm $(PREFIX)/setup-chicken4x.sh $(PREFIX)/setup-chicken4x.csh
	cd chicken-core;make PLATFORM=linux PREFIX=$(PREFIX)
	cd chicken-core;make PLATFORM=linux PREFIX=$(PREFIX) install








>
>
>







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

chicken-4.9.0rc1.tar.gz : 
	wget http://code.call-cc.org/dev-snapshots/2014/04/17/chicken-4.9.0rc1.tar.gz

chicken-4.9.0.1.tar.gz :
	wget http://code.call-cc.org/releases/4.9.0/chicken-4.9.0.1.tar.gz

chicken-4.10.0rc1.tar.gz :
	wget http://code.call-cc.org/dev-snapshots/2015/06/07/chicken-4.10.0rc1.tar.gz

# git clone git://code.call-cc.org/chicken-core
# git clone http://code.call-cc.org/git/chicken-core.git

$(CHICKEN_INSTALL) : chicken-core/chicken.scm $(PREFIX)/setup-chicken4x.sh $(PREFIX)/setup-chicken4x.csh
	cd chicken-core;make PLATFORM=linux PREFIX=$(PREFIX)
	cd chicken-core;make PLATFORM=linux PREFIX=$(PREFIX) install

Added utils/mtrunner version [ee53d3f91b].





























>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
#! /bin/bash

# Run megatest from within megatest
# Usage: mtrunner testsuite_dir megatest_bin_dir command args ....

for var in $(env | egrep "^MT_"|cut -d= -f1);do
  unset ${var}
done
cd $1
shift
export PATH="$1:$PATH"
shift 

"$@"