From: Vincent Pit Date: Mon, 15 Jun 2009 21:22:43 +0000 (+0200) Subject: Factor the common part of t/20-hash.t and t/21-array.t into a new t/lib/autovivificat... X-Git-Tag: v0.02~11 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=6a425386b4dab23f859f51f3cc99a6ebe3c414f0;p=perl%2Fmodules%2Fautovivification.git Factor the common part of t/20-hash.t and t/21-array.t into a new t/lib/autovivification/TestCases.pm --- diff --git a/MANIFEST b/MANIFEST index a4cfc0f..9af2be8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -15,5 +15,6 @@ t/91-pod.t t/92-pod-coverage.t t/95-portability-files.t t/99-kwalitee.t +t/lib/autovivification/TestCases.pm t/lib/autovivification/TestRequired1.pm t/lib/autovivification/TestRequired2.pm diff --git a/samples/hash2array.pl b/samples/hash2array.pl index 72cd265..4e7ccaa 100644 --- a/samples/hash2array.pl +++ b/samples/hash2array.pl @@ -37,7 +37,7 @@ while (<$hash_t>) { $in_data = 1; print $array_t $_; } elsif (!$in_data) { - s{s/\^\$/%/}{s/^\$/@/}; + s{'%'}{'\@'}; print $array_t $_; } else { s!->{([a-z])}!'->[' . num($1) . ']'!eg; diff --git a/t/20-hash.t b/t/20-hash.t index 867152a..ad82aae 100644 --- a/t/20-hash.t +++ b/t/20-hash.t @@ -5,75 +5,13 @@ use warnings; use Test::More tests => 6 * 3 * 260; -sub testcase { - my ($var, $init, $code, $exp, $use, $global) = @_; - my $decl = $global ? "our $var; local $var;" : "my $var;"; - my $test = $var =~ /^[@%]/ ? "\\$var" : $var; - return <) { 1 while chomp; next unless /#/; - my @chunks = split /#+/, "$_ "; - s/^\s+//, s/\s+$// for @chunks; - my ($init, $code, $exp, $opts) = @chunks; - (my $var = $init) =~ s/[^\$@%\w].*//; - $init = $var eq $init ? '' : "$init;"; - my $use; - if ($opts) { - for (split ' ', $opts) { - my $no = 1; - $no = 0 if s/^([-+])// and $1 eq '-'; - $use .= ($no ? 'no' : 'use') . " autovivification '$_';" - } - } elsif (defined $opts) { - $opts = 'empty'; - $use = 'no autovivification;'; - } else { - $opts = 'default'; - $use = ''; - } - my @testcases = ( - [ $var, $init, $code, $exp, $use, 0 ], - [ $var, "use strict; $init", $code, $exp, $use, 1 ], - [ $var, "no strict; $init", $code, $exp, $use, 1 ], - ); - my @extra; - for (@testcases) { - my $var = $_->[0]; - if ($var =~ /\$/) { - my @new = @$_; - $new[0] =~ s/^$/%/; - $new[1] =~ s/$var\->/$var/g; - $new[2] =~ s/$var\->/$var/g; - push @extra, \@new; - } - } - push @testcases, @extra; - for (@testcases) { - my $testcase = testcase(@$_); - my ($var, $init, $code) = @$_; - my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts"; - eval $testcase; - diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@; - } + testcase_ok($_, '%'); } __DATA__ diff --git a/t/21-array.t b/t/21-array.t index 5183bdf..ed746c6 100644 --- a/t/21-array.t +++ b/t/21-array.t @@ -5,75 +5,13 @@ use warnings; use Test::More tests => 6 * 3 * 260; -sub testcase { - my ($var, $init, $code, $exp, $use, $global) = @_; - my $decl = $global ? "our $var; local $var;" : "my $var;"; - my $test = $var =~ /^[@%]/ ? "\\$var" : $var; - return <) { 1 while chomp; next unless /#/; - my @chunks = split /#+/, "$_ "; - s/^\s+//, s/\s+$// for @chunks; - my ($init, $code, $exp, $opts) = @chunks; - (my $var = $init) =~ s/[^\$@%\w].*//; - $init = $var eq $init ? '' : "$init;"; - my $use; - if ($opts) { - for (split ' ', $opts) { - my $no = 1; - $no = 0 if s/^([-+])// and $1 eq '-'; - $use .= ($no ? 'no' : 'use') . " autovivification '$_';" - } - } elsif (defined $opts) { - $opts = 'empty'; - $use = 'no autovivification;'; - } else { - $opts = 'default'; - $use = ''; - } - my @testcases = ( - [ $var, $init, $code, $exp, $use, 0 ], - [ $var, "use strict; $init", $code, $exp, $use, 1 ], - [ $var, "no strict; $init", $code, $exp, $use, 1 ], - ); - my @extra; - for (@testcases) { - my $var = $_->[0]; - if ($var =~ /\$/) { - my @new = @$_; - $new[0] =~ s/^$/@/; - $new[1] =~ s/$var\->/$var/g; - $new[2] =~ s/$var\->/$var/g; - push @extra, \@new; - } - } - push @testcases, @extra; - for (@testcases) { - my $testcase = testcase(@$_); - my ($var, $init, $code) = @$_; - my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts"; - eval $testcase; - diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@; - } + testcase_ok($_, '@'); } __DATA__ diff --git a/t/lib/autovivification/TestCases.pm b/t/lib/autovivification/TestCases.pm new file mode 100644 index 0000000..507a4d8 --- /dev/null +++ b/t/lib/autovivification/TestCases.pm @@ -0,0 +1,84 @@ +package autovivification::TestCases; + +use strict; +use warnings; + +use Test::More; + +sub import { + no strict 'refs'; + *{caller().'::testcase_ok'} = \&testcase_ok; +} + +sub source { + my ($var, $init, $code, $exp, $use, $global) = @_; + my $decl = $global ? "our $var; local $var;" : "my $var;"; + my $test = $var =~ /^[@%]/ ? "\\$var" : $var; + return <[0]; + if ($var =~ /\$/) { + my @new = @$_; + $new[0] =~ s/^$/$sigil/; + $new[1] =~ s/$var\->/$var/g; + $new[2] =~ s/$var\->/$var/g; + push @extra, \@new; + } + } + push @testcases, @extra; + for (@testcases) { + my $testcase = source(@$_); + my ($var, $init, $code) = @$_; + my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts"; + eval $testcase; + diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@; + } +} + +1;