compiler.graphviz: was broken since some time ago, fix and add tests

diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor
new file mode 100644 (file)
index 0000000..23f5f6f
--- /dev/null
+++ b/extra/compiler/graphviz/graphviz-tests.factor
@@ -0,0 +1,6 @@
+IN: compiler.graphviz.tests
+USING: compiler.graphviz io.files ;
+
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-call-graph exists? ] unit-test

diff --git a/extra/compiler/graphviz/graphviz.factor b/extra/compiler/graphviz/graphviz.factor
index 9823f93d4e644350b658ac60902ad1da810b988e..7378d3284c36eb0a7243ec2965ed5d1a38a681fe 100644 (file)
--- a/extra/compiler/graphviz/graphviz.factor
+++ b/extra/compiler/graphviz/graphviz.factor
@@ -18,15 +18,18 @@ IN: compiler.graphviz
         "}" ,
     ] { } make , ; inline
 
-: render-graph ( quot -- )
+: render-graph ( quot -- name )
     { } make
     "cfg" ".dot" make-unique-file
     dup "Wrote " prepend print
     [ [ concat ] dip ascii set-file-lines ]
     [ { "dot" "-Tpng" "-O" } swap suffix try-process ]
-    [ ".png" append "open" swap 2array try-process ]
+    [ ".png" append ]
     tri ; inline
 
+: display-graph ( name -- )
+    "open" swap 2array try-process ;
+
 : attrs>string ( seq -- str )
     [ "" ] [ "," join "[" "]" surround ] if-empty ;
 
@@ -75,12 +78,12 @@ IN: compiler.graphviz
 : optimized-cfg ( quot -- cfgs )
     {
         { [ dup cfg? ] [ 1array ] }
-        { [ dup quotation? ] [ test-cfg [ optimize-cfg ] map ] }
-        { [ dup word? ] [ test-cfg [ optimize-cfg ] map ] }
+        { [ dup quotation? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
+        { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
         [ ]
     } cond ;
 
-: render-cfg ( cfg -- )
+: render-cfg ( cfg -- name )
     optimized-cfg [ cfgs ] render-graph ;
 
 : dom-trees ( cfgs -- )
@@ -95,7 +98,7 @@ IN: compiler.graphviz
         ] over cfg-title graph,
     ] each ;
 
-: render-dom ( cfg -- )
+: render-dom ( cfg -- name )
     optimized-cfg [ dom-trees ] render-graph ;
 
 SYMBOL: word-counts
@@ -131,7 +134,7 @@ SYMBOL: vertex-names
     H{ } clone vertex-names set
     [ "ROOT" ] dip (call-graph-edges) ;
 
-: render-call-graph ( tree -- )
+: render-call-graph ( tree -- name )
     dup quotation? [ build-tree ] when
     analyze-recursive drop
     [ [ call-graph get call-graph-edges ] "Call graph" graph, ]