Megatest

Diff
Login

Differences From Artifact [fd4aa50106]:

To Artifact [41a7ac7d26]:


878
879
880
881
882
883
884
885

886
887
888
889

890
891

892
893
894
895
896
897
898
899



900
901
902
903
904

905
906

907
908
909
910
911
912
913
878
879
880
881
882
883
884

885
886
887
888

889
890

891
892
893
894
895
896
897


898
899
900
901
902
903
904

905
906

907
908
909
910
911
912
913
914







-
+



-
+

-
+






-
-
+
+
+




-
+

-
+







      (with-input-from-pipe
       (conc "env -i PATH=$PATH dot -T" outtype " < " temp-path)
       (lambda ()
	 (let ((res (read-lines)))
	   ;; (delete-file temp-path)
	   res))))))

(define (tests:write-dot-file test-records fname)
(define (tests:write-dot-file test-records fname sizex sizey)
  (if (file-write-access? (pathname-directory fname))
      (with-output-to-file fname
	(lambda ()
	  (map print (tests:tests->dot test-records))))))
	  (map print (tests:tests->dot test-records sizex sizey))))))

(define (tests:tests->dot test-records)
(define (tests:tests->dot test-records sizex sizey)
  (let ((all-testnames (hash-table-keys test-records)))
    (if (null? all-testnames)
	'()
	(let loop ((hed (car all-testnames))
		   (tal (cdr all-testnames))
		   (res (list "digraph tests {"
			      " size=\"11,11\";"
			      " ratio=0.9;")))
			      (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) '()))
		 (newres  (append res
				  (if (null? waitons)
				      (list (conc "   \"" hed "\";"))
				      (list (conc "   \"" hed "\" [shape=box];"))
				      (map (lambda (waiton)
					     (conc "   \"" waiton "\" -> \"" hed "\";"))
					     (conc "   \"" waiton "\" -> \"" hed "\" [shape=box];"))
					   waitons)
				      ))))
	    (if (null? tal)
		(append newres (list "}"))
		(loop (car tal)(cdr tal) newres)
		))))))

924
925
926
927
928
929
930
931

932
933
934

935
936
937
938
939
940
941
925
926
927
928
929
930
931

932
933
934

935
936
937
938
939
940
941
942







-
+


-
+







		   (read-lines)))))
      (close-input-port inp)
      res)))

;; read data from tmp file or create if not exists
;; if exists regen in background
;;
(define (tests:lazy-dot testrecords  outtype)
(define (tests:lazy-dot testrecords  outtype sizex sizey)
  (let ((dfile (conc "/tmp/." (current-user-name) "-" (server:mk-signature) ".dot"))
	(fname (conc "/tmp/." (current-user-name) "-" (server:mk-signature) ".dotdat")))
    (tests:write-dot-file testrecords dfile)
    (tests:write-dot-file testrecords dfile sizex sizey)
    (if (file-exists? fname)
	(let ((res (with-input-from-file fname
		     (lambda ()
		       (read-lines)))))
	  (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname "&"))
	  res)
	(begin