Megatest

Diff
Login

Differences From Artifact [4543da4028]:

To Artifact [661a4dba80]:


25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41





42
43
44
45
46
47
48
25
26
27
28
29
30
31

32
33
34
35






36
37
38
39
40
41
42
43
44
45
46
47







-
+



-
-
-
-
-
-
+
+
+
+
+








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

(define (tests:get-valid-tests testsdir test-patts #!key (test-names '()))
(define (tests:get-valid-tests testsdir test-patts) ;;  #!key (test-names '()))
  (let ((tests (glob (conc testsdir "/tests/*")))) ;; " (string-translate patt "%" "*")))))
    (set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
    (delete-duplicates
     (append test-names 
	     (filter (lambda (testname)
		       (tests:match test-patts testname #f))
		     (map (lambda (testp)
			    (last (string-split testp "/")))
			  tests))))))
     (filter (lambda (testname)
	       (tests:match test-patts testname #f))
	     (map (lambda (testp)
		    (last (string-split testp "/")))
		  tests)))))

;; tests:glob-like-match
(define (tests:glob-like-match patt str) 
  (let ((like (substring-index "%" patt)))
    (let* ((notpatt  (equal? (substring-index "~" patt) 0))
	   (newpatt  (if notpatt (substring patt 1) patt))
	   (finpatt  (if like
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
302
303
304
305
306
307
308

309
310
311
312
313
314
315
316







-
+







	      (print "Obtained lock for " outputfilename)
	      (print "Failed to obtain lock for " outputfilename))
	  (let ((oup    (open-output-file outputfilename))
		(counts (make-hash-table))
		(statecounts (make-hash-table))
		(outtxt "")
		(tot    0)
		(testdat (cdb:remote-run db:test-get-records-for-index-file run-id test-name)))
		(testdat (cdb:remote-run db:test-get-records-for-index-file #f run-id test-name)))
	    (with-output-to-port
		oup
	      (lambda ()
		(set! outtxt (conc outtxt "<html><title>Summary: " test-name 
				   "</title><body><h2>Summary for " test-name "</h2>"))
		(for-each
		 (lambda (testrecord)