Megatest

Diff
Login

Differences From Artifact [cdb59ffbe9]:

To Artifact [7cdd6fc78c]:


1631
1632
1633
1634
1635
1636
1637
1638



1639
1640
1641
1642

1643
1644
1645
1646
1647
1648
1649
1631
1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642
1643

1644
1645
1646
1647
1648
1649
1650
1651







-
+
+
+



-
+







      ;; (format temp-port "This file is ~A.~%" temp-path)
      (format temp-port "digraph tests {\n")
      (format temp-port "  size=4,8\n")
      ;; (format temp-port "   splines=none\n")
      (for-each
       (lambda (testname)
	 (let* ((testrec (hash-table-ref test-records testname))
		(waitons (or (tests:testqueue-get-waitons testrec) '())))
		(waitons (or (tests:testqueue-get-waitons testrec) '()))
		(my-mt-waitons (tests:get-mt-waitons testname #t)))
	   ;; (print "my-mt-waitons=" my-mt-waitons)
	   (for-each
	    (lambda (waiton)
	      (format temp-port (conc "   " waiton " -> " testname " [splines=ortho]\n")))
	    waitons)))
	    (append waitons my-mt-waitons))))
       all-testnames)
      (format temp-port "}\n")
      (close-output-port temp-port)
      (with-input-from-pipe
       (conc "env -i PATH=$PATH dot -T" outtype " < " temp-path)
       (lambda ()
	 (let ((res (read-lines)))
1664
1665
1666
1667
1668
1669
1670


1671
1672

1673
1674
1675
1676

1677

1678
1679
1680
1681
1682
1683
1684
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679

1680

1681
1682
1683
1684
1685
1686
1687
1688







+
+

-
+



-
+
-
+







		   (tal (cdr all-testnames))
		   (res (list "digraph tests {"
			      (conc " size=\"" (or sizex 11) "," (or sizey 11) "\";")
			      " ratio=0.95;"
			      )))
	  (let* ((testrec (hash-table-ref test-records hed))
		 (waitons (or (tests:testqueue-get-waitons testrec) '()))
		 (my-mt-waitons (tests:get-mt-waitons hed #t))
		 (all-waitons   (delete-duplicates (append waitons my-mt-waitons)))
		 (newres  (append res
				  (if (null? waitons)
				  (if (null? all-waitons)
				      (list (conc "   \"" hed "\" [shape=box];"))
				      (map (lambda (waiton)
					     (conc "   \"" waiton "\" -> \"" hed "\" [shape=box];"))
					   waitons)
					   all-waitons)))))
				      ))))
	    ;; (debug:print 0 *default-log-port* "For test "hed" got "all-waitons)
	    (if (null? tal)
		(append newres (list "}"))
		(loop (car tal)(cdr tal) newres)
		))))))

;; (tests:run-dot (list "digraph tests {" "a -> b" "}") "plain")