Megatest

Check-in [4564a26ccb]
Login
Overview
Comment:Handle PATH containing spaces
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70
Files: files | file ages | folders
SHA1: 4564a26ccbd1ee122f97c727b2ac0660c962c70b
User & Date: mrwellan on 2022-08-17 09:54:31
Other Links: branch diff | manifest | tags
Context
2022-08-17
15:21
Fixed issues with handling of PATH containing spaces. check-in: 2bfad28089 user: mrwellan tags: v1.70
09:54
Handle PATH containing spaces check-in: 4564a26ccb user: mrwellan tags: v1.70
2022-08-15
12:32
Removed -target and -run-name from dashboard, added -target-run. Moved Runs tab to first position. Widened tree browser and test name blocks. check-in: a85cccf7ae user: mmgraham tags: v1.70
Changes

Modified tests.scm from [a1004e9ca7] to [5dcabca030].

1775
1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788
1789







-
+







		(append newres (list "}"))
		(loop (car tal)(cdr tal) newres)
		))))))

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

(define (tests:run-dot indat outtype) ;; outtype is plain, fig, dot, etc. http://www.graphviz.org/content/output-formats
  (let-values (((inp oup pid)(process "env -i PATH=$PATH dot" (list "-T" outtype))))
  (let-values (((inp oup pid)(process "env -i PATH=\"$PATH\" dot" (list "-T" outtype))))
    (with-output-to-port oup
      (lambda ()
	(map print indat)))
    (close-output-port oup)
    (let ((res (with-input-from-port inp
		 (lambda ()
		   (read-lines)))))
1797
1798
1799
1800
1801
1802
1803
1804

1805
1806
1807

1808
1809
1810
1811
1812
1813
1814
1797
1798
1799
1800
1801
1802
1803

1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814







-
+


-
+







  (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 sizex sizey)
    (if (common:file-exists? fname)
	(let ((res (with-input-from-file fname
		     (lambda ()
		       (read-lines)))))
	  (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname "&"))
	  (system (conc "env -i PATH=\"$PATH\" dot -T " outtype " < " dfile " > " fname "&"))
	  res)
	(begin
	  (system (conc "env -i PATH=$PATH dot -T " outtype " < " dfile " > " fname))
	  (system (conc "env -i PATH=\"$PATH\" dot -T " outtype " < " dfile " > " fname))
	  (with-input-from-file fname
	    (lambda ()
	      (read-lines)))))))
	  

;; for each test:
;;