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 ) 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 color =color node[ color =color ]; n iota [ number>string color prepend add-node ] each ; :: K_n,m ( n m -- 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[ "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[ "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 ) "dot" =layout 0 "filled" =style "lightgrey" =color node[ "filled" =style "white" =color ]; { "a0" "a1" "a2" "a3" } ~-> "process #1" =label add 1 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 ) [ ] keep [ 16.0 / 0.5 + =width ] [ 16.0 / 0.5 + =height ] [ 16 * "#%2x0000" sprintf =fillcolor ] tri ; : colored-circles-example ( -- 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 ) "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 ) graph[ "LR" =rankdir "8,8" =size ]; node[ 8 =fontsize "record" =shape ]; "node0" add-node[ " 0x10ba8| " =label ]; "node1" add-node[ " 0xf7fc4380| | |-1" =label ]; "node2" add-node[ " 0xf7fc44b8| | |2" =label ]; "node3" add-node[ " 3.43322790286038071e-06|44.79998779296875|0" =label ]; "node4" add-node[ " 0xf7fc4380| | |2" =label ]; "node5" add-node[ " (nil)| | |-1" =label ]; "node6" add-node[ " 0xf7fc4380| | |1" =label ]; "node7" add-node[ " 0xf7fc4380| | |2" =label ]; "node8" add-node[ " (nil)| | |-1" =label ]; "node9" add-node[ " (nil)| | |-1" =label ]; "node10" add-node[ " (nil)| | |-1" =label ]; "node11" add-node[ " (nil)| | |-1" =label ]; "node12" add-node[ " 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/)