From 484e3be524aadcb9e8abec56dbcba1a02d55f943 Mon Sep 17 00:00:00 2001 From: Steve Thorn Date: Thu, 22 Feb 2018 10:19:13 +0000 Subject: [PATCH 1/2] 2 syntax pod corrections + 2 new test files that increase to coverage of sub's tested with mostly empty data. --- lib/GraphViz2.pm | 6 ++--- lib/GraphViz2/Filer.pm | 2 +- t/test_more_methods.t | 53 ++++++++++++++++++++++++++++++++++++++++++ t/test_new.t | 18 ++++++++++++++ 4 files changed, 75 insertions(+), 4 deletions(-) create mode 100644 t/test_more_methods.t create mode 100644 t/test_new.t diff --git a/lib/GraphViz2.pm b/lib/GraphViz2.pm index dca519a..d16ad07 100644 --- a/lib/GraphViz2.pm +++ b/lib/GraphViz2.pm @@ -72,9 +72,9 @@ has global => has graph => ( - default => sub{return ''}, + default => sub{return {} }, is => 'rw', - #isa => HashRef, + isa => HashRef, required => 0, ); @@ -1742,7 +1742,7 @@ $level defaults to 'debug', and $message defaults to ''. If called with $level eq 'error', it dies with $message. -=head2 logger($logger_object]) +=head2 logger($logger_object) Gets or sets the log object. diff --git a/lib/GraphViz2/Filer.pm b/lib/GraphViz2/Filer.pm index c1cc2ba..afe89f0 100644 --- a/lib/GraphViz2/Filer.pm +++ b/lib/GraphViz2/Filer.pm @@ -159,7 +159,7 @@ It returns a new object of type C. =head1 Methods -=head1 get_annotations() +=head2 get_annotations() Returns a hash (sic) keyed by *.pl name, with the values being the text off line 3 of each script. diff --git a/t/test_more_methods.t b/t/test_more_methods.t new file mode 100644 index 0000000..35f737a --- /dev/null +++ b/t/test_more_methods.t @@ -0,0 +1,53 @@ +use strict; +use utf8; +use warnings; +use warnings qw(FATAL utf8); # Fatalize encoding glitches. +use open qw(:std :utf8); # Undeclared streams in UTF-8. +use charnames qw(:full :short); # Unneeded in v5.16. + +use Data::Dumper; +use Test::More; +use GraphViz2; + +# ------------------------------------------------ + +my $GraphViz2 = GraphViz2->new(); +my $count = 0; + +my %methods = ( + add_node => { id => 1, args => { name => 'TestNode1', label => 'n1' } }, + add_edge => { id => 2, args => { from => 'TestNode1', to => '' } }, + default_subgraph => { id => 3, args => {} }, + escape_some_chars => { id => 4, args => { $GraphViz2, "abc123[]()" } }, + push_subgraph => { + id => 5, + args => { + name => 'subgraph_test', + edge => {}, + graph => { bgcolor => 'grey', label => 'subgraph_test' } + } + }, + pop_subgraph => { id => 6, args => {} }, + report_valid_attributes => { id => 7, args => {} }, + run => { id => 8, args => {} }, + run_map => { id => 9, args => {} }, + run_mapless => { id => 10, args => {} }, +); +foreach my $sub ( sort { $methods{$a}{id} <=> $methods{$b}{id} } keys %methods ) +{ + + # Check we can call this function/method/sub + $count++; + can_ok( $GraphViz2, $sub ); + + $count++; + ok( + $GraphViz2->$sub( %{ $methods{$sub}{'args'} } ), + "Run $sub with -> " + . join( + ", ", map { "$_:$methods{$sub}{'args'}{$_}" } keys %{ $methods{$sub}{'args'} } + ) + ); +} +done_testing($count); + diff --git a/t/test_new.t b/t/test_new.t new file mode 100644 index 0000000..a9abcf6 --- /dev/null +++ b/t/test_new.t @@ -0,0 +1,18 @@ +use strict; +use utf8; +use warnings; +use warnings qw(FATAL utf8); # Fatalize encoding glitches. +use open qw(:std :utf8); # Undeclared streams in UTF-8. +use charnames qw(:full :short); # Unneeded in v5.16. + +use Test::More; + +# ------------------------------------------------ + +BEGIN{ use_ok('GraphViz2'); } + +my($count) = 1; # Counting the use_ok above. +$count++; +my $GraphViz2 = new_ok('GraphViz2'); +done_testing($count); + From 984f37ac2bcb3ea33b9915c798f04138e8f96cb6 Mon Sep 17 00:00:00 2001 From: Steve Thorn Date: Thu, 22 Feb 2018 14:24:03 +0000 Subject: [PATCH 2/2] fixed tests for run_map run_mapless. --- t/test_more_methods.t | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/t/test_more_methods.t b/t/test_more_methods.t index 35f737a..948f633 100644 --- a/t/test_more_methods.t +++ b/t/test_more_methods.t @@ -11,7 +11,9 @@ use GraphViz2; # ------------------------------------------------ -my $GraphViz2 = GraphViz2->new(); +my $GraphViz2 = GraphViz2->new( + im_meta => { URL => "http://savage.net.au/maps/demo.4.html" } +); my $count = 0; my %methods = ( @@ -29,21 +31,38 @@ my %methods = ( }, pop_subgraph => { id => 6, args => {} }, report_valid_attributes => { id => 7, args => {} }, - run => { id => 8, args => {} }, - run_map => { id => 9, args => {} }, - run_mapless => { id => 10, args => {} }, + run_map => { + id => 8, + subname => 'run', + args => { + format => 'png', + output_file => 't/test_more_run_map.png', + im_output_file => 't/test_more_run_map.map', + im_format => 'cmapx', + }, + }, + run_mapless => { + id => 9, + subname => 'run', + args => { + format => 'png', + output_file => 't/test_more_run_mapless.png', + }, + }, ); foreach my $sub ( sort { $methods{$a}{id} <=> $methods{$b}{id} } keys %methods ) { + my $subname = defined $methods{$sub}{'subname'} ? $methods{$sub}{'subname'} : $sub; + # Check we can call this function/method/sub $count++; - can_ok( $GraphViz2, $sub ); + can_ok( $GraphViz2, $subname ); $count++; ok( - $GraphViz2->$sub( %{ $methods{$sub}{'args'} } ), - "Run $sub with -> " + $GraphViz2->$subname( %{ $methods{$sub}{'args'} } ), + "Run $subname with -> " . join( ", ", map { "$_:$methods{$sub}{'args'}{$_}" } keys %{ $methods{$sub}{'args'} } )