#!/usr/bin/perl -w
use Test::More;
use strict;
use File::Spec;
sub _write_utf8_file
{
my ($out_path, $contents) = @_;
open my $out_fh, '>:encoding(utf8)', $out_path
or die "Cannot open '$out_path' for writing - $!";
print {$out_fh} $contents;
close($out_fh);
return;
}
# test graphviz (dot) file input => ASCII output
# and back to as_txt() again
BEGIN
{
plan tests => 140;
chdir 't' if -d 't';
use lib '../lib';
use_ok ("Graph::Easy") or die($@);
use_ok ("Graph::Easy::Parser") or die($@);
use_ok ("Graph::Easy::Parser::Graphviz") or die($@);
};
my @warnings;
#############################################################################
# override the warn method to catch warnigs
{
no warnings 'redefine';
package Graph::Easy::Base;
sub warn {
my ($self,$msg) = @_;
push @warnings, $msg;
}
}
#############################################################################
# parser object
my $def_parser = Graph::Easy::Parser->new(debug => 0);
is (ref($def_parser), 'Graph::Easy::Parser');
is ($def_parser->error(), '', 'no error yet');
my $dot_parser = Graph::Easy::Parser::Graphviz->new(debug => 0);
is (ref($dot_parser), 'Graph::Easy::Parser::Graphviz');
is ($dot_parser->error(), '', 'no error yet');
my $dir = File::Spec->catdir('in','dot');
opendir DIR, $dir or die ("Cannot read dir '$dir': $!");
my @files = readdir(DIR); closedir(DIR);
opendir DIR, 'dot' or die ("Cannot read dir 'dot': $!");
push @files, readdir(DIR); closedir(DIR);
binmode (STDERR, ':utf8') or die ("Cannot do binmode(':utf8') on STDERR: $!");
binmode (STDOUT, ':utf8') or die ("Cannot do binmode(':utf8') on STDOUT: $!");
eval { require Test::Differences; };
foreach my $f (sort {
$a =~ /^(\d+)/; my $a1 = $1 || '1';
$b =~ /^(\d+)/; my $b1 = $1 || '1';
$a1 <=> $b1 || $a cmp $b;
} @files)
{
my $file = File::Spec->catfile($dir,$f);
my $parser = $def_parser;
if (!-f $file)
{
$file = File::Spec->catfile('dot',$f);
next unless -f $file; # only files
# for files in t/dot, we need to use the Graphviz parser as they
# look like Graph::Easy text to the normal parser, which then fails
$parser = $dot_parser;
}
next unless $f =~ /\.dot/; # ignore anything else
print "# at $f\n";
my $txt = readfile($file);
$parser->reset();
my $graph = $parser->from_text($txt); # reuse parser object
$f =~ /^(\d+)/;
my $nodes = $1;
if (!defined $graph)
{
fail ("Graphviz input was invalid: " . $parser->error());
next;
}
is (scalar $graph->nodes(), $nodes, "$nodes nodes");
# for slow testing machines
$graph->timeout(20);
my $ascii = $graph->as_ascii();
my $of = $f; $of =~ s/\.dot/\.txt/;
my $out_path = File::Spec->catfile('out','dot',$of);
my $out = readfile($out_path);
$out =~ s/(^|\n)#[^# ]{2}.*\n//g; # remove comments
$out =~ s/\n\n\z/\n/mg; # remove empty lines
# print "txt: $txt\n";
# print "ascii: $ascii\n";
# print "should: $out\n";
if (!
is ($ascii, $out, "from $f"))
{
if ($ENV{__SHLOMIF__UPDATE_ME})
{
_write_utf8_file($out_path, $ascii);
}
if (defined $Test::Differences::VERSION)
{
Test::Differences::eq_or_diff ($ascii, $out);
}
else
{
fail ("Test::Differences not installed");
}
}
# if the txt output differes, read it in
my $f_txt = File::Spec->catfile('txt','dot',$of);
if (-f $f_txt)
{
$txt = readfile($f_txt);
}
$graph->debug(1);
if (!
is ($graph->as_txt(), $txt, "$f as_txt"))
{
if ($ENV{__SHLOMIF__UPDATE_ME})
{
_write_utf8_file($f_txt, scalar( $graph->as_txt() ));
}
if (defined $Test::Differences::VERSION)
{
Test::Differences::eq_or_diff ($graph->as_txt(), $txt);
}
else
{
fail ("Test::Differences not installed");
}
}
# print a debug output
my $debug = $ascii;
$debug =~ s/\n/\n# /g;
print "# Generated:\n#\n# $debug\n";
}
# check that only the expected warnings were generated
use Data::Dumper;
print STDERR Dumper(\@warnings) unless
is (scalar @warnings, 6, 'Got exactly 6 warnings');
my $i = 0;
for my $name (qw/bar foo pname fname bar brabble/)
{
like ($warnings[$i], qr/Ignoring unknown attribute '$name' for class/,
"Got warning about $name");
$i++;
}
1;
sub readfile
{
my ($file) = @_;
open my $FILE, $file or die ("Cannot read file $file: $!");
binmode ($FILE, ':utf8') or die ("Cannot do binmode(':utf8') on $FILE: $!");
local $/ = undef; # slurp mode
my $doc = <$FILE>;
close $FILE;
$doc;
}