diff options
Diffstat (limited to 'ext/Pod-Html/t/lib/Testing.pm')
| -rw-r--r-- | ext/Pod-Html/t/lib/Testing.pm | 135 |
1 files changed, 118 insertions, 17 deletions
diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index 81a779e665..8bfb6b8b65 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -2,11 +2,13 @@ package Testing; use 5.10.0; use warnings; require Exporter; -our $VERSION = 1.26; # Let's keep this same as lib/Pod/Html.pm +our $VERSION = 1.27_001; # Let's keep this same as lib/Pod/Html.pm +$VERSION = eval $VERSION; our @ISA = qw(Exporter); our @EXPORT_OK = qw( setup_testing_dir xconvert + record_state_of_cache ); use Cwd; use Pod::Html; @@ -17,6 +19,9 @@ use File::Path ( qw| make_path | ); use File::Spec::Functions ':ALL'; use File::Temp ( qw| tempdir | ); use Data::Dumper;$Data::Dumper::Sortkeys=1; +use Pod::Html::Util qw( + unixify +); *ok = \&Test::More::ok; *is = \&Test::More::is; @@ -405,7 +410,10 @@ this key. Required. Hash reference holding arguments passed to C<Pod::Html::pod2html()> (though without the leading double hyphens (C<-->). See documentation for -F<Pod::Html>. Optional, but mostly necessary. +F<Pod::Html>. Optional, but mostly necessary. In particular, if a F<.pod> +file contains any C<LE<lt>E<gt>> tags, a C<podpath> element almost always +needs to be supplied with a colon-delimited list of directories from which to +begin a search for files containing POD. =item * C<debug> @@ -444,11 +452,12 @@ sub xconvert { my $podstub = $args->{podstub}; my $description = $args->{description}; my $debug = $args->{debug} // 0; + $args->{expect_fail} //= 0; if (defined $args->{p2h}) { die "Value for 'p2h' must be hashref" unless ref($args->{p2h}) eq 'HASH'; # TEST ME } - my $cwd = Pod::Html::_unixify( Cwd::cwd() ); + my $cwd = unixify( Cwd::cwd() ); my ($vol, $dir) = splitpath($cwd, 1); my @dirs = splitdir($dir); shift @dirs if $dirs[0] eq ''; @@ -479,6 +488,7 @@ sub xconvert { podstub => $podstub, outfile => $outfile, debug => $debug, + expect_fail => $args->{expect_fail}, } ); # pod2html creates these @@ -493,9 +503,6 @@ sub _prepare_argstable { my %args_table = ( infile => $args->{infile}, outfile => $args->{outfile}, - podpath => 't', - htmlroot => '/', - podroot => $args->{cwd}, ); my %no_arg_switches = map { $_ => 1 } @no_arg_switches; if (defined $args->{p2h}) { @@ -567,17 +574,28 @@ sub _process_diff { $diff = 'fc/n' if $^O =~ /^MSWin/; $diff = 'differences' if $^O eq 'VMS'; if ($diff) { - ok($args->{expect} eq $args->{result}, $args->{description}) or do { - my $expectfile = $args->{podstub} . "_expected.tmp"; - open my $tmpfile, ">", $expectfile or die $!; - print $tmpfile $args->{expect}, "\n"; - close $tmpfile; - open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" - or die("problem diffing: $!"); - print STDERR "# $_" while <$diff_fh>; - close $diff_fh; - unlink $expectfile unless $args->{debug}; - }; + my $outcome = $args->{expect} eq $args->{result}; + if ($outcome) { + ok($outcome, $args->{description}); + } + else { + if ($args->{expect_fail}) { + ok(! $outcome, $args->{description}); + } + else { + ok($outcome, $args->{description}) or do { + my $expectfile = $args->{podstub} . "_expected.tmp"; + open my $tmpfile, ">", $expectfile or die $!; + print $tmpfile $args->{expect}, "\n"; + close $tmpfile; + open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" + or die("problem diffing: $!"); + print STDERR "# $_" while <$diff_fh>; + close $diff_fh; + unlink $expectfile unless $args->{debug}; + }; + } + } } else { # This is fairly evil, but lets us get detailed failure modes @@ -587,6 +605,89 @@ sub _process_diff { return 1; } +=head2 C<record_state_of_cache()> + +=over 4 + +=item * Purpose + +During debugging, enable developer to examine the state of the Pod-Html cache +after each call to C<xconvert()>. + +=item * Arguments + +Single hash reference. + + record_state_of_cache( { + outdir => "$ENV{P5P_DIR}/pod-html", + stub => $args->{podstub}, + run => 1, + } ); + +Hash reference has the following key-value pairs: + +=over 4 + +=item * C<outdir> + +Any directory of your system to which you want a sorted copy of the cache to +be printed. + +=item * C<stub> + +The same value you passed in C<$args> to C<xconvert()>. + +=item * C<run> + +Integer which you set manually to distinguish among multiple runs of this +function within the same test file (presumably corresponding to multiple +invocations of C<xconvert()>). + +=back + +=item * Return Value + +Implicitly returns Perl-true value. + +=item * Comment + +Function will print out location of cache files and other information. + +=back + +=cut + +sub record_state_of_cache { + my $args = shift; + die("record_state_of_cache() takes hash reference") + unless ref($args) eq 'HASH'; + for my $k ( qw| outdir stub run | ) { + die("Argument to record_state_of_cache() lacks defined $k element") + unless defined $args->{$k}; + } + my $cwd = cwd(); + my $cache = catfile($cwd, 'pod2htmd.tmp'); + die("Could not locate file $cache") unless -f $cache; + die("Could not locate directory $args->{outdir}") unless -d $args->{outdir}; + die("'run' element takes integer") unless $args->{run} =~ m/^\d+$/; + + my @cachelines = (); + open my $in, '<', $cache or die "Unable to open $cache for reading"; + while (my $l = <$in>) { + chomp $l; + push @cachelines, $l; + } + close $in or die "Unable to close $cache after reading"; + + my $outfile = catfile($args->{outdir}, "$args->{run}.cache.$args->{stub}.$$.txt"); + die("$outfile already exists; did you remember to increment the 'run' argument?") + if -f $outfile; + open my $out, '>', $outfile or die "Unable to open $outfile for writing"; + print $out "$_\n" for (sort @cachelines); + close $out or die "Unable to close after writing"; + print STDERR "XXX: cache (sorted): $outfile\n"; +} + =head1 AUTHORS The testing code reworked into its present form has many authors and dates |