first commit
This commit is contained in:
douboer
703
perl/lib/Graph-Easy-0.76/t/graphviz.t
Normal file
703
perl/lib/Graph-Easy-0.76/t/graphviz.t
Normal file
@@ -0,0 +1,703 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
# test as_graphviz() output
|
||||
|
||||
use Test::More;
|
||||
use strict;
|
||||
|
||||
BEGIN
|
||||
{
|
||||
plan tests => 157;
|
||||
chdir 't' if -d 't';
|
||||
use lib '../lib';
|
||||
use_ok ("Graph::Easy") or die($@);
|
||||
};
|
||||
|
||||
#############################################################################
|
||||
my $graph = Graph::Easy->new();
|
||||
|
||||
is (ref($graph), 'Graph::Easy');
|
||||
|
||||
is ($graph->error(), '', 'no error yet');
|
||||
|
||||
is ($graph->nodes(), 0, '0 nodes');
|
||||
is ($graph->edges(), 0, '0 edges');
|
||||
|
||||
is (join (',', $graph->edges()), '', '0 edges');
|
||||
|
||||
my $grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/digraph.*\{/, 'looks like digraph');
|
||||
unlike ($grviz, qr/#/, 'and has proper comment');
|
||||
like ($grviz, qr#// Generated#, 'and has proper comment');
|
||||
|
||||
#############################################################################
|
||||
# after first call to as_graphviz, these should now exist:
|
||||
|
||||
can_ok ("Graph::Easy::Node", qw/
|
||||
attributes_as_graphviz
|
||||
as_graphviz_txt
|
||||
/);
|
||||
|
||||
#############################################################################
|
||||
# with some nodes
|
||||
|
||||
my $bonn = Graph::Easy::Node->new( name => 'Bonn' );
|
||||
my $berlin = Graph::Easy::Node->new( 'Berlin' );
|
||||
|
||||
my $edge = $graph->add_edge ($bonn, $berlin);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/Bonn/, 'contains Bonn');
|
||||
like ($grviz, qr/Berlin/, 'contains Bonn');
|
||||
|
||||
like ($grviz, qr/arrowhead=open/, 'contains open arrowheads');
|
||||
|
||||
unlike ($grviz, qr/\w+=,/, "doesn't contain empty defintions");
|
||||
|
||||
#############################################################################
|
||||
# with attributes on the graph
|
||||
|
||||
$graph->set_attribute( 'graph', 'fill' => 'red' );
|
||||
|
||||
like ($graph->as_graphviz(), qr/bgcolor="#ff0000"/, 'contains bgcolor="#ff0000"');
|
||||
|
||||
#############################################################################
|
||||
# with label/label-pos attributes on the graph
|
||||
|
||||
$graph->set_attribute( 'graph', 'label' => 'My Label' );
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/label="My Label"/, 'graph label');
|
||||
like ($grviz, qr/labelloc=top/, 'default is top (dot 1.1 seems to get this wrong)');
|
||||
|
||||
$graph->set_attribute( 'graph', 'label-pos' => 'top' );
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/label="My Label"/, 'graph label');
|
||||
like ($grviz, qr/labelloc=top/, 'default is top');
|
||||
|
||||
$graph->set_attribute( 'graph', 'label-pos' => 'bottom' );
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/label="My Label"/, 'graph label');
|
||||
like ($grviz, qr/labelloc=bottom/, 'now bottom');
|
||||
|
||||
#############################################################################
|
||||
# with some nodes with attributes
|
||||
|
||||
$bonn->set_attribute( 'shape' => 'rect' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/[^"]Berlin[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/shape=box/, 'contains shape');
|
||||
|
||||
#############################################################################
|
||||
# remapped attributes, quoted attributes
|
||||
|
||||
$bonn->set_attributes( {
|
||||
fill => '#808080',
|
||||
title => 'title string',
|
||||
color => 'red',
|
||||
'border-color' => 'brown',
|
||||
class => 'city',
|
||||
} );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/fillcolor="#808080"/, 'contains fillcolor');
|
||||
like ($grviz, qr/tooltip="title string"/, 'contains tooltip');
|
||||
like ($grviz, qr/color="#a52a2a"/, 'contains color');
|
||||
like ($grviz, qr/fontcolor="#ff0000"/, 'contains fontcolor');
|
||||
unlike ($grviz, qr/(city|class)/, "doesn't contain class");
|
||||
|
||||
#############################################################################
|
||||
# quoting (including " in node names)
|
||||
|
||||
$bonn->{name} = 'Bonn"';
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/"Bonn\\""/, 'quoted Bonn"');
|
||||
|
||||
$bonn->{name} = 'Bonn und Umgebung';
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/"Bonn und Umgebung"/, 'quoted "Bonn und Umgebung"');
|
||||
|
||||
is (join(",", $graph->_graphviz_remap_edge_style('style', 'bold')), 'style,bold', 'style,bold');
|
||||
|
||||
my ($name,$style) = $graph->_graphviz_remap_edge_style('style', 'double');
|
||||
is ($name, undef, 'style=double suppressed');
|
||||
is ($style, undef, 'style=double suppressed');
|
||||
|
||||
($name,$style) = $graph->_graphviz_remap_edge_style('style', 'solid');
|
||||
|
||||
is ($name, undef, 'style=solid suppressed');
|
||||
is ($style, undef, 'style=solid suppressed');
|
||||
|
||||
$bonn->{name} = '2A';
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/"2A"/, '"2A" must be quoted');
|
||||
|
||||
$bonn->{name} = '123';
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/ 123 /, '"123" needs no quotes');
|
||||
|
||||
# strict should come last in this list:
|
||||
for (qw/0AB graph subgraph edge node Graph Edge Strict strict/)
|
||||
{
|
||||
$bonn->{name} = $_;
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/"$_"/, "'$_' needs quotes");
|
||||
}
|
||||
|
||||
$bonn->set_attribute('label', 'Graph::Easy');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/label="Graph::Easy"/, 'label with non \w needs quoting');
|
||||
|
||||
#############################################################################
|
||||
# flow directions
|
||||
|
||||
$graph->set_attribute('graph','flow','south');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/rankdir/, 'flow south needs no rankdir');
|
||||
like ($grviz, qr/"strict" -> Berlin/, 'edge direction normal');
|
||||
|
||||
$graph->set_attribute('graph','flow','west');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/rankdir=LR/, 'flow west has LR and reversed edges');
|
||||
like ($grviz, qr/Berlin -> "strict"/, 'edge direction reversed');
|
||||
like ($grviz, qr/dir=back/, 'edge direction reversed');
|
||||
|
||||
$graph->set_attribute('graph','flow','up');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/rankdir/, 'flow west has TB and reversed edges');
|
||||
like ($grviz, qr/Berlin -> "strict"/, 'edge direction reversed');
|
||||
like ($grviz, qr/dir=back/, 'edge direction reversed');
|
||||
|
||||
#############################################################################
|
||||
# arrow styles
|
||||
|
||||
# flow is up, so arrowhead becomes arrowtail:
|
||||
|
||||
$graph->set_attribute('edge', 'arrow-style', 'closed');
|
||||
|
||||
is ($graph->get_attribute('edge', 'arrow-style'), 'closed');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/arrowtail=empty/, 'arrow-style closed => empty');
|
||||
|
||||
$graph->set_attribute('edge', 'arrow-style', 'filled');
|
||||
is ($graph->get_attribute('edge', 'arrow-style'), 'filled');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/arrowtail=normal/, 'arrow-style filled => normal');
|
||||
|
||||
# set flow to down, so arrowtail becomes arrowhead again
|
||||
$graph->set_attribute('graph','flow','down');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/arrowhead=normal/, 'arrow-style filled => normal');
|
||||
|
||||
$graph->del_attribute('edge','arrow-style');
|
||||
$edge->set_attribute('arrow-style','filled');
|
||||
is ($graph->error(),'', 'no error');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/arrowhead=normal/, 'arrow-style filled => normal');
|
||||
|
||||
$edge->set_attribute('arrow-style','none');
|
||||
is ($graph->error(),'', 'no error');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/arrowhead=none/, 'arrow-style none');
|
||||
|
||||
#############################################################################
|
||||
#############################################################################
|
||||
# undirected edges
|
||||
|
||||
my $e = $graph->add_edge('A','B');
|
||||
|
||||
$e->undirected(1); $e->bidirectional(0);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/A -> B.*arrowhead=none/, 'arrowhead on undirected edge');
|
||||
like ($grviz, qr/A -> B.*arrowtail=none/, 'arrowtail on undirected edge');
|
||||
|
||||
#############################################################################
|
||||
# bidirectional edges
|
||||
|
||||
$e->undirected(0); $e->bidirectional(1);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/A -> B.*arrowhead=open/, 'arrowhead on bidirectional edge');
|
||||
like ($grviz, qr/A -> B.*arrowtail=open/, 'arrowtail on bidirectional edge');
|
||||
|
||||
|
||||
#############################################################################
|
||||
#############################################################################
|
||||
# label-color vs. color
|
||||
|
||||
$e->bidirectional(0);
|
||||
|
||||
$e->set_attribute('color','red');
|
||||
$e->set_attribute('label-color','blue');
|
||||
$e->set_attribute('label','A to B');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/A -> B \[ color="#ff0000", fontcolor="#0000ff", label/, 'label-color');
|
||||
|
||||
#############################################################################
|
||||
# missing label-color (fall back to color)
|
||||
|
||||
$e->del_attribute('label-color');
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/A -> B \[ color="#ff0000", fontcolor="#ff0000", label/, 'label-color');
|
||||
|
||||
$e->del_attribute('label','A to B');
|
||||
|
||||
#############################################################################
|
||||
# no label, no fontcolor nec.:
|
||||
|
||||
$e->del_attribute('label');
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/A -> B \[ color="#ff0000" \]/, 'label-color');
|
||||
|
||||
#############################################################################
|
||||
# link vs. autolink and linkbase
|
||||
|
||||
$graph->set_attribute('node','linkbase','http://bloodgate.com/');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/bloodgate.com/, 'linkbase alone does nothing');
|
||||
unlike ($grviz, qr/link/, 'linkbase alone does nothing');
|
||||
|
||||
$graph->set_attribute('node','autolink','name');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/URL="http:\/\/bloodgate.com/, 'linkbase plus link');
|
||||
|
||||
$graph->del_attribute('node','autolink');
|
||||
$graph->set_attribute('graph','autolink','name');
|
||||
|
||||
is ($graph->attribute('graph','autolink'), 'name', 'autolink=name');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/URL="http:\/\/bloodgate.com/, 'linkbase plus link');
|
||||
|
||||
#############################################################################
|
||||
# link vs. autolink and linkbase
|
||||
|
||||
$bonn->set_attribute('point-style', 'star');
|
||||
is ($graph->error(),'', 'no error');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/point-style/, 'point-style is filtered out');
|
||||
|
||||
|
||||
#############################################################################
|
||||
# node shape "none"
|
||||
|
||||
$bonn->{name} = 'Bonn';
|
||||
$bonn->set_attribute( 'shape' => 'none' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*shape=plaintext/, 'contains shape=plaintext');
|
||||
|
||||
|
||||
# some different node shapes
|
||||
|
||||
for my $s (qw/
|
||||
invhouse invtrapezium invtriangle
|
||||
triangle octagon hexagon pentagon house
|
||||
septagon trapezium
|
||||
/)
|
||||
{
|
||||
$bonn->set_attribute( 'shape' => $s );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*shape=$s/, "contains shape=$s");
|
||||
}
|
||||
|
||||
#############################################################################
|
||||
# font-size support
|
||||
|
||||
$bonn->set_attribute( 'font-size' => '2em' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*fontsize=22/, '11px eq 1em');
|
||||
|
||||
#############################################################################
|
||||
# bold-dash, broad and wide edges
|
||||
|
||||
$bonn->set_attribute( 'border-style' => 'broad' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*style="filled,setlinewidth\(5\)"/,
|
||||
'5 pixel for broad border');
|
||||
|
||||
#############################################################################
|
||||
# quoting of special characters
|
||||
|
||||
$bonn->set_attribute( 'label' => '$a = 2;' );
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($graph->as_graphviz(), qr/Bonn.*label="\$a = 2;"/, 'contains label unquoted');
|
||||
|
||||
$bonn->set_attribute( 'label' => '2"' );
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/Bonn.*label="2\\""/, 'contains label 2"');
|
||||
|
||||
|
||||
#############################################################################
|
||||
# groups as clusters
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn, $berlin, $edge) = $graph->add_edge ('Bonn', 'Berlin');
|
||||
my $group = $graph->add_group ('Test:');
|
||||
|
||||
$group->add_node($bonn);
|
||||
$group->add_node($berlin);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/subgraph "cluster\d+"\s+\{/, 'contains cluster');
|
||||
|
||||
#############################################################################
|
||||
# nodes w/o links and attributes in a group
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
$bonn = $graph->add_node ('Bonn');
|
||||
$berlin = $graph->add_node ('Berlin');
|
||||
|
||||
$group = $graph->add_group ('Test:');
|
||||
|
||||
$group->add_node($bonn);
|
||||
$group->add_node($berlin);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/Bonn(.|\n)*Berlin(.|\n)*\}(.|\n)*\}/, 'contains nodes inside group');
|
||||
|
||||
#############################################################################
|
||||
# node with border-style: none:
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
$bonn = $graph->add_node ('Bonn');
|
||||
$bonn->set_attribute('border-style', 'none');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/Bonn.*color="#ffffff".*style=filled/,
|
||||
'contains color white, style filled');
|
||||
|
||||
#############################################################################
|
||||
# node with shape: rounded;
|
||||
|
||||
$bonn->del_attribute('border-style');
|
||||
$bonn->set_attribute( 'shape' => 'rounded' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*style="rounded,filled"/, 'contains rounded,filled');
|
||||
|
||||
#############################################################################
|
||||
# invisible nodes and node with shape: point;
|
||||
|
||||
$bonn->del_attribute('border-style');
|
||||
$bonn->set_attribute( 'shape' => 'invisible' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*shape=plaintext/, 'contains shape plaintext');
|
||||
like ($grviz, qr/Bonn.*label=" "/, 'contains label=" "');
|
||||
|
||||
$bonn->del_attribute('border-style');
|
||||
$bonn->set_attribute( 'shape' => 'point' );
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"]/, 'contains Bonn unquoted');
|
||||
like ($grviz, qr/Bonn.*shape=plaintext/, 'contains shape plaintext');
|
||||
like ($grviz, qr/Bonn.*label="*"/, 'contains label="*"');
|
||||
|
||||
#############################################################################
|
||||
# edge styles double and double-dash
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$edge->set_attribute('style','double');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"].*color="#000000:#000000/, 'contains Bonn and black:black');
|
||||
unlike ($grviz, qr/style="?solid/, "doesn't contain solid");
|
||||
|
||||
$edge->set_attribute('style','double-dash');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/[^"]Bonn[^"].*color="#000000:#000000/, 'contains Bonn and black:black');
|
||||
unlike ($grviz, qr/style="?solid/, "doesn't contain solid");
|
||||
like ($grviz, qr/style="?dashed/, 'contains solid');
|
||||
|
||||
#############################################################################
|
||||
# root node (also testing that a root of '0' actually works)
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('0','1');
|
||||
$graph->set_attribute('root','0');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/root=0/, 'contains root=0');
|
||||
like ($grviz, qr/0.*rank=0/, 'contains rank=0');
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('a','b');
|
||||
$graph->set_attribute('root','b');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/root=b/, 'contains root=0');
|
||||
like ($grviz, qr/b.*rank=0/, 'contains rank=0');
|
||||
|
||||
#############################################################################
|
||||
# headport/tailport
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$edge->set_attribute('start','west');
|
||||
$edge->set_attribute('end','east');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/tailport=w/, 'contains tailport=w');
|
||||
like ($grviz, qr/headport=e/, 'contains headport=e');
|
||||
|
||||
# headport/tailport with relative flow
|
||||
|
||||
$edge->set_attribute('start','right');
|
||||
$edge->set_attribute('end','left');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/tailport=s/, 'contains tailport=s');
|
||||
like ($grviz, qr/headport=n/, 'contains headport=n');
|
||||
|
||||
#############################################################################
|
||||
# colorscheme support
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
|
||||
$graph->add_group('Cities');
|
||||
|
||||
$graph->set_attribute('node','colorscheme','pastel19');
|
||||
$graph->set_attribute('color','red');
|
||||
$edge->set_attribute('color','1');
|
||||
$berlin->set_attribute('color','1');
|
||||
$berlin->set_attribute('colorscheme','set23');
|
||||
$bonn->set_attribute('color','1');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/graph(.|\n)*color="#ff0000"/, 'contains graph color=#ff0000');
|
||||
like ($grviz, qr/Bonn.*color="#fbb4ae"/, 'contains Bonn color=#fbb4ae');
|
||||
like ($grviz, qr/Berlin.*color="#66c2a5"/, 'contains Berlin color=#66c2a5');
|
||||
like ($grviz, qr/->.*Berlin.*color="#a6cee3"/, 'contains edge with default color 1 from set312');
|
||||
|
||||
#############################################################################
|
||||
# test inheritance of colorscheme for edges, groups and anon things:
|
||||
|
||||
$graph->set_attribute('colorscheme','pastel19');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/->.*Berlin.*color="#fbb4ae"/, 'contains edge with color 1 from pastel19');
|
||||
|
||||
#############################################################################
|
||||
# autolabel is skipped
|
||||
|
||||
$graph->set_attribute('node','autolabel','15');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/autolabel/, "doesn't contain autolabel");
|
||||
|
||||
#############################################################################
|
||||
# test that the attributes group, rows and columns are skipped
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$group = $graph->add_group('Cities');
|
||||
$group->add_nodes($bonn, $berlin);
|
||||
$bonn->set_attribute('size','2,2');
|
||||
|
||||
$graph->layout();
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/rows=/, 'does not contain rows=');
|
||||
unlike ($grviz, qr/columns=/, 'does not contain columns=');
|
||||
unlike ($grviz, qr/group=/, 'does not contain group=');
|
||||
|
||||
#############################################################################
|
||||
# test output of fillcolor and color of groups
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$group = $graph->add_group('Cities');
|
||||
$group->add_nodes($bonn, $berlin);
|
||||
$group->set_attribute('fill','red');
|
||||
$group->set_attribute('color','blue');
|
||||
|
||||
$graph->layout();
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/fillcolor="#ff0000"/, 'fillcolor=red');
|
||||
like ($grviz, qr/fontcolor="#0000ff"/, 'fontcolor=blue');
|
||||
|
||||
#############################################################################
|
||||
# test group class attributes
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$group = $graph->add_group('Cities');
|
||||
$group->add_nodes($bonn, $berlin);
|
||||
|
||||
$graph->set_attribute('group','fill','red');
|
||||
|
||||
$graph->layout();
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/cluster(.|\n)*fillcolor="#ff0000"/, 'fillcolor=blue');
|
||||
|
||||
#############################################################################
|
||||
# node->as_graphviz()
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$group = $graph->add_group('Cities');
|
||||
$group->add_nodes($bonn, $berlin);
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
unlike ($grviz, qr/Berlin.*label=.*Berlin/, "label isn't output needlessly");
|
||||
|
||||
#############################################################################
|
||||
# HSV colors and alpha channel should be preserved in output
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$group = $graph->add_group('Cities');
|
||||
$group->add_nodes($bonn, $berlin);
|
||||
|
||||
# as hex (not preserved) due to alpha channel
|
||||
$bonn->set_attribute('color', 'hsv(0, 1.0, 0.5, 0.5)');
|
||||
$berlin->set_attribute('color', '#ff000080');
|
||||
|
||||
# preserved
|
||||
$graph->set_attribute('color', 'hsv(0, 0.6, 0.7)');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
|
||||
like ($grviz, qr/fontcolor="0 0.6 0.7"/, "graph color was preserved");
|
||||
like ($grviz, qr/Berlin.*fontcolor="#ff000080"/, "Berlin's color got converted");
|
||||
like ($grviz, qr/Bonn.*fontcolor="#8000007f"/, "Bonn's color got converted");
|
||||
|
||||
#############################################################################
|
||||
# edge label
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$edge->set_attribute('label','car');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/label=car/, "edge label appears in output");
|
||||
|
||||
#############################################################################
|
||||
# fill as class attribute
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
$bonn->set_attribute('class','red');
|
||||
|
||||
$graph->set_attribute('node.red', 'fill', 'red');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
like ($grviz, qr/fillcolor="#ff0000"/, "contains fill red");
|
||||
|
||||
#############################################################################
|
||||
# \c in labels
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
|
||||
$graph->set_attribute('label', 'foo\cbar');
|
||||
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
|
||||
$bonn->set_attribute('label', 'bar\cbar');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
unlike ($grviz, qr/\\c/, "no \\c in output");
|
||||
|
||||
#############################################################################
|
||||
# borderwidth == 0 overrides style
|
||||
|
||||
$graph = Graph::Easy->new();
|
||||
($bonn,$berlin,$edge) = $graph->add_edge ('Bonn','Berlin');
|
||||
|
||||
$bonn->set_attribute('borderstyle','dashed');
|
||||
$bonn->set_attribute('borderwidth','0');
|
||||
|
||||
$berlin->set_attribute('borderstyle','double');
|
||||
$berlin->set_attribute('borderwidth','0');
|
||||
|
||||
$grviz = $graph->as_graphviz();
|
||||
print $grviz;
|
||||
unlike ($grviz, qr/style=.*dashed/, "no dashed in output");
|
||||
unlike ($grviz, qr/peripheries/, "no peripheries in output");
|
||||
|
||||
#############################################################################
|
||||
# subgraph
|
||||
|
||||
#$graph = Graph::Easy->new();
|
||||
my $g = Graph::Easy->new;
|
||||
my $a_ = $g->add_group('A');
|
||||
my $b_ = $g->add_group('B');
|
||||
my $c = $g->add_group('C');
|
||||
my $d = $g->add_group('D');
|
||||
my $n1 = $g->add_node('one');
|
||||
my $n2 = $g->add_node('two');
|
||||
my $n3 = $g->add_node('three');
|
||||
my $n4 = $g->add_node('four');
|
||||
|
||||
$a_->add_member($n1);
|
||||
$b_->add_member($c);
|
||||
$b_->add_member($n2);
|
||||
$a_->add_member($b_);
|
||||
$c->add_member($n3);
|
||||
$d->add_member($n4);
|
||||
|
||||
$grviz = $g->as_graphviz();
|
||||
is($a_->{_order},1,'subgraph A is level 1');
|
||||
is($d->{_order},1,'subgraph D is level 1');
|
||||
is($b_->{_order},2,'subgraph B is level 2');
|
||||
is($c->{_order},3,'subgraph C is level 3');
|
||||
like($grviz,qr/subgraph "cluster\d+" \{\n label="A";\n subgraph "cluster\d+" \{/,'subgraph indent');
|
||||
Reference in New Issue
Block a user