Megatest

Check-in [96a83f9ea5]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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

︙
4172
4173
4174
4175
4176
4177
4178
4179

4180
4181
4182
4183
4184
4185
4186

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))))
       (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

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")
                  (time-out  (or (string->number (args:get-arg "-time-out")) 5))
                                 (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

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)))
									                                                            	result
										                                                            (car result)))
                                                                        (link (if (string? result)
										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:a (car result) 'href (cadr result))))))
                                                                       (s:td  link 'class status)))
                                                                runs))))
                                                        res))
                                                   item-keys)))
                               test-list)))))) 

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

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