Megatest

Diff
Login

Differences From Artifact [b4f35f97f8]:

To Artifact [9e83246be4]:


23
24
25
26
27
28
29

30
31
32
33
34
35
36
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37







+







;;======================================================================

(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses tdb))
(declare (uses common))
(declare (uses commonmod))
;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(declare (uses server))
(declare (uses stml2))

57
58
59
60
61
62
63

64
65
66
67
68
69
70
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72







+







 chicken.time
 srfi-13
 srfi-18
 srfi-69
 system-information
 regex
 
 commonmod
 )

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
1798
1799
1800
1801
1802
1803
1804
1805

1806
1807
1808
1809
1810
1811
1812
1800
1801
1802
1803
1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814







-
+







		(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)))))
1820
1821
1822
1823
1824
1825
1826
1827

1828
1829
1830

1831
1832
1833
1834
1835
1836
1837
1822
1823
1824
1825
1826
1827
1828

1829
1830
1831

1832
1833
1834
1835
1836
1837
1838
1839







-
+


-
+







  (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:
;;