Megatest

Check-in [96a83f9ea5]
Login
Overview
Comment:fix for tagexpr and default timeout on tsend
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 96a83f9ea5e62c9adced7d43f9818eb86e832d25
User & Date: pjhatwal on 2018-06-06 18:48:49
Other Links: branch diff | manifest | tags
Context
2018-06-07
17:17
hash to alist conversion for tagexpr bug fix check-in: 6b4a7cf4a4 user: pjhatwal tags: v1.65
2018-06-06
18:48
fix for tagexpr and default timeout on tsend check-in: 96a83f9ea5 user: pjhatwal tags: v1.65
2018-06-04
08:43
Added additional time to the transient test state/status change resistance. Now at 40 seconds. Seems to resist all reasonable transient changes. check-in: 5a7b531a52 user: mrwellan tags: v1.65
Changes

Modified db.scm from [b5d86e1d41] to [3551c538f8].

4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
	     (lambda (tag)
	       (hash-table-set! res tag
				(delete-duplicates
				 (cons testname (hash-table-ref/default res tag '())))))
	     tags)))
	db
	"SELECT testname,tags FROM test_meta")
       res))))

;; read the record given a testname
(define (db:testmeta-get-record dbstruct testname)
  (let ((res   #f))
    (db:with-db
     dbstruct
     #f







|







4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
	     (lambda (tag)
	       (hash-table-set! res tag
				(delete-duplicates
				 (cons testname (hash-table-ref/default res tag '())))))
	     tags)))
	db
	"SELECT testname,tags FROM test_meta")
       (hash-table->alist res)))))

;; read the record given a testname
(define (db:testmeta-get-record dbstruct testname)
  (let ((res   #f))
    (db:with-db
     dbstruct
     #f

Modified mtut.scm from [81ee6438b2] to [1b362234c6].

1375
1376
1377
1378
1379
1380
1381

1382

1383
1384
1385
1386
1387
1388
1389
		(rmt:get-keys))))))
    ((tsend)
       (if (null? remargs)
	      (print "ERROR: missing data to send to trigger listeners")
	      (let* ((msg       (car remargs))
                  (mtconfdat (simple-setup (args:get-arg "-start-dir")))
                  (mtconf    (car mtconfdat))

                  (time-out  (or (string->number (args:get-arg "-time-out")) 5))

                  (listeners (configf:get-section mtconf "listeners"))
                  (user-info  (user-information (current-user-id)))
                  (prev-seen (make-hash-table))) ;; catch duplicates
             (if user-info
              (begin
               (for-each
              (lambda (listener)







>
|
>







1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
		(rmt:get-keys))))))
    ((tsend)
       (if (null? remargs)
	      (print "ERROR: missing data to send to trigger listeners")
	      (let* ((msg       (car remargs))
                  (mtconfdat (simple-setup (args:get-arg "-start-dir")))
                  (mtconf    (car mtconfdat))
                  (time-out  (if (args:get-arg "-time-out")
                                 (string->number (args:get-arg "-time-out")) 
                               5))
                  (listeners (configf:get-section mtconf "listeners"))
                  (user-info  (user-information (current-user-id)))
                  (prev-seen (make-hash-table))) ;; catch duplicates
             (if user-info
              (begin
               (for-each
              (lambda (listener)

Modified tests.scm from [a30dd7d6b3] to [001680f09e].

827
828
829
830
831
832
833

834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
                                          (map (lambda (item-name)  
  		                             (let* ((res (s:tr  'class item-name
				                         (s:td  item-name 'class "test" )
                                                           (map (lambda (run)
                                                               (let* ((run-test (hash-table-ref/default item-hash item-name  #f))
                                                                      (run-id (db:get-value-by-header run header "id"))
                                                                      (result (hash-table-ref/default run-test run-id "n/a"))

                                                                      (status (if (string? result)
										result
										(car result)))
                                                                        (link (if (string? result)
										result
                                                                                (if (equal? flag #t) 
                                                                                (s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname="  item-name ))
										(s:a (car result) 'href (cadr result))))))
                                                                       (s:td  link 'class status)))
                                                                runs))))
                                                        res))
                                                   item-keys)))
                               test-list)))))) 

;; (tests:create-html-tree "test-index.html")







>

|
|

|


|







827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
                                          (map (lambda (item-name)  
  		                             (let* ((res (s:tr  'class item-name
				                         (s:td  item-name 'class "test" )
                                                           (map (lambda (run)
                                                               (let* ((run-test (hash-table-ref/default item-hash item-name  #f))
                                                                      (run-id (db:get-value-by-header run header "id"))
                                                                      (result (hash-table-ref/default run-test run-id "n/a"))
                                                                      (relative-path (get-relative-path)) 
                                                                      (status (if (string? result)
									                                                            	result
										                                                            (car result)))
                                                                        (link (if (string? result)
										                                                            result
                                                                                (if (equal? flag #t) 
                                                                                (s:a (car result) 'href (conc "./test_log?runid=" run-id "&testname="  item-name ))
																																								(s:a (car result) 'href (cadr result))))))
                                                                       (s:td  link 'class status)))
                                                                runs))))
                                                        res))
                                                   item-keys)))
                               test-list)))))) 

;; (tests:create-html-tree "test-index.html")