--- /dev/null
+USING: arrays formatting graphviz graphviz.ffi
+graphviz.notation graphviz.render graphviz.render.private
+io.directories io.files io.files.unique kernel locals math
+math.combinatorics math.parser sequences sets tools.test ;
+IN: graphviz.testing
+
+! Don't want to test canvas formats, since they'll open a
+! separate window (even if it's closed, that'll call exit() and
+! kill the Factor process).
+!
+! In fact, the exit() issue is why we probably don't even want
+! these formats supported in general, and why we have
+! graphviz.render:preview & preview-window. Should probably
+! gank them out of supported-formats in graphviz.ffi to begin
+! with.
+CONSTANT: canvas { "gtk" "x11" "xlib" }
+
+! Had some issues with the following formats. Graphviz 2.26.3
+! would die with "Error: deflation finish problem -2 cnt=0".
+! Could just be my installation, though.
+CONSTANT: zlib { "svgz" "vmlz" }
+
+! These are aliases for the neato flags -n/-n1/-n2, which
+! assume that all nodes have already been positioned, and thus
+! have "pos" attributes. Since this clearly isn't always the
+! case for our tests, we skip them to avoid useless rendering
+! errors.
+CONSTANT: neato-aliases { "nop" "nop1" "nop2" }
+
+:: smoke-test ( graph -- pass? )
+ temporary-file :> -O
+ supported-formats canvas diff zlib diff [| -T |
+ supported-engines neato-aliases diff [| -K |
+ graph -O -T -K (graphviz)
+ [ exists? ] [ delete-file ] bi
+ ] all?
+ ] all? ;
+
+: K_n ( n -- graph )
+ <graph>
+ node[ "point" =shape ];
+ graph[ "t" =labelloc "circo" =layout ];
+ over number>string "K " prepend =label
+ swap iota 2 [ first2 add-edge ] each-combination ;
+
+{ t } [ 5 K_n smoke-test ] unit-test
+{ t } [ 6 K_n smoke-test ] unit-test
+{ t } [ 7 K_n smoke-test ] unit-test
+
+:: partite-set ( n color -- cluster )
+ color <cluster>
+ color =color
+ node[ color =color ];
+ n iota [
+ number>string color prepend add-node
+ ] each ;
+
+:: K_n,m ( n m -- graph )
+ <graph>
+ node[ "point" =shape ];
+ graph[ "t" =labelloc "dot" =layout "LR" =rankdir ];
+ n "#FF0000" partite-set
+ m "#0000FF" partite-set
+ add-edge
+ n m "K %d,%d" sprintf =label ;
+
+{ t } [ 3 3 K_n,m smoke-test ] unit-test
+{ t } [ 3 4 K_n,m smoke-test ] unit-test
+{ t } [ 5 4 K_n,m smoke-test ] unit-test
+
+: add-cycle ( graph n -- graph' )
+ [ iota add-path ] [ 1 - 0 add-edge ] bi ;
+
+: C_n ( n -- graph )
+ <graph>
+ graph[ "t" =labelloc "circo" =layout ];
+ node[ "point" =shape ];
+ over number>string "C " prepend =label
+ swap add-cycle ;
+
+{ t } [ 5 C_n smoke-test ] unit-test
+{ t } [ 6 C_n smoke-test ] unit-test
+{ t } [ 7 C_n smoke-test ] unit-test
+
+: W_n ( n -- graph )
+ <graph>
+ graph[ "t" =labelloc "twopi" =layout ];
+ node[ "point" =shape ];
+ over number>string "W " prepend =label
+ over add-node
+ over 1 - add-cycle
+ swap [ ] [ 1 - iota >array ] bi add-edge ;
+
+{ t } [ 6 W_n smoke-test ] unit-test
+{ t } [ 7 W_n smoke-test ] unit-test
+{ t } [ 8 W_n smoke-test ] unit-test
+
+: cluster-example ( -- graph )
+ <digraph>
+ "dot" =layout
+ 0 <cluster>
+ "filled" =style
+ "lightgrey" =color
+ node[ "filled" =style "white" =color ];
+ { "a0" "a1" "a2" "a3" } ~->
+ "process #1" =label
+ add
+ 1 <cluster>
+ node[ "filled" =style ];
+ { "b0" "b1" "b2" "b3" } ~->
+ "process #2" =label
+ "blue" =color
+ add
+ "start" "a0" ->
+ "start" "b0" ->
+ "a1" "b3" ->
+ "b2" "a3" ->
+ "a3" "a0" ->
+ "a3" "end" ->
+ "b3" "end" ->
+ "start" add-node[ "Mdiamond" =shape ];
+ "end" add-node[ "Msquare" =shape ];
+ ;
+
+{ t } [ cluster-example smoke-test ] unit-test
+
+: colored-circle ( i -- node )
+ [ <node> ] keep
+ [ 16.0 / 0.5 + =width ]
+ [ 16.0 / 0.5 + =height ]
+ [ 16 * "#%2x0000" sprintf =fillcolor ] tri ;
+
+: colored-circles-example ( -- graph )
+ <graph>
+ graph[ "3,3" =size "circo" =layout ];
+ node[ "filled" =style
+ "circle" =shape
+ "true" =fixedsize
+ "" =label ];
+ edge[ "invis" =style ];
+ 0 add-node[ "invis" =style "none" =shape ];
+ 16 iota [
+ [ 0 -- ] [ colored-circle add ] bi
+ ] each ;
+
+{ t } [ colored-circles-example smoke-test ] unit-test
+
+: dfa-example ( -- graph )
+ <digraph>
+ "LR" =rankdir
+ "8,5" =size
+ node[ "doublecircle" =shape ];
+ { "LR_0" "LR_3" "LR_4" "LR_8" } add-nodes
+ node[ "circle" =shape ];
+ "LR_0" "LR_2" ->[ "SS(B)" =label ];
+ "LR_0" "LR_1" ->[ "SS(S)" =label ];
+ "LR_1" "LR_3" ->[ "S($end)" =label ];
+ "LR_2" "LR_6" ->[ "SS(b)" =label ];
+ "LR_2" "LR_5" ->[ "SS(a)" =label ];
+ "LR_2" "LR_4" ->[ "S(A)" =label ];
+ "LR_5" "LR_7" ->[ "S(b)" =label ];
+ "LR_5" "LR_5" ->[ "S(a)" =label ];
+ "LR_6" "LR_6" ->[ "S(b)" =label ];
+ "LR_6" "LR_5" ->[ "S(a)" =label ];
+ "LR_7" "LR_8" ->[ "S(b)" =label ];
+ "LR_7" "LR_5" ->[ "S(a)" =label ];
+ "LR_8" "LR_6" ->[ "S(b)" =label ];
+ "LR_8" "LR_5" ->[ "S(a)" =label ];
+ ;
+
+{ t } [ dfa-example smoke-test ] unit-test
+
+: record-example ( -- graph )
+ <digraph>
+ graph[ "LR" =rankdir "8,8" =size ];
+ node[ 8 =fontsize "record" =shape ];
+
+ "node0" add-node[
+ "<f0> 0x10ba8| <f1>" =label
+ ];
+ "node1" add-node[
+ "<f0> 0xf7fc4380| <f1> | <f2> |-1" =label
+ ];
+ "node2" add-node[
+ "<f0> 0xf7fc44b8| | |2" =label
+ ];
+ "node3" add-node[
+ "<f0> 3.43322790286038071e-06|44.79998779296875|0" =label
+ ];
+ "node4" add-node[
+ "<f0> 0xf7fc4380| <f1> | <f2> |2" =label
+ ];
+ "node5" add-node[
+ "<f0> (nil)| | |-1" =label
+ ];
+ "node6" add-node[
+ "<f0> 0xf7fc4380| <f1> | <f2> |1" =label
+ ];
+ "node7" add-node[
+ "<f0> 0xf7fc4380| <f1> | <f2> |2" =label
+ ];
+ "node8" add-node[
+ "<f0> (nil)| | |-1" =label
+ ];
+ "node9" add-node[
+ "<f0> (nil)| | |-1" =label
+ ];
+ "node10" add-node[
+ "<f0> (nil)| <f1> | <f2> |-1" =label
+ ];
+ "node11" add-node[
+ "<f0> (nil)| <f1> | <f2> |-1" =label
+ ];
+ "node12" add-node[
+ "<f0> 0xf7fc43e0| | |1" =label
+ ];
+
+ "node0" "node1" ->[ "f0" =tailport "f0" =headport ];
+ "node0" "node2" ->[ "f1" =tailport "f0" =headport ];
+ "node1" "node3" ->[ "f0" =tailport "f0" =headport ];
+ "node1" "node4" ->[ "f1" =tailport "f0" =headport ];
+ "node1" "node5" ->[ "f2" =tailport "f0" =headport ];
+ "node4" "node3" ->[ "f0" =tailport "f0" =headport ];
+ "node4" "node6" ->[ "f1" =tailport "f0" =headport ];
+ "node4" "node10" ->[ "f2" =tailport "f0" =headport ];
+ "node6" "node3" ->[ "f0" =tailport "f0" =headport ];
+ "node6" "node7" ->[ "f1" =tailport "f0" =headport ];
+ "node6" "node9" ->[ "f2" =tailport "f0" =headport ];
+ "node7" "node3" ->[ "f0" =tailport "f0" =headport ];
+ "node7" "node1" ->[ "f1" =tailport "f0" =headport ];
+ "node7" "node8" ->[ "f2" =tailport "f0" =headport ];
+ "node10" "node11" ->[ "f1" =tailport "f0" =headport ];
+ "node10" "node12" ->[ "f2" =tailport "f0" =headport ];
+ "node11" "node1" ->[ "f2" =tailport "f0" =headport ];
+ ;
+
+{ t } [ record-example smoke-test ] unit-test
+
+! TODO add the examples from graphviz's source code (the .gv
+! files in graphs/directed/ and graphs/undirected/)
projects / factor.git / commitdiff