summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorJames E Keenan <jkeenan@cpan.org>2021-05-10 15:23:03 +0000
committerJames E Keenan <jkeenan@cpan.org>2021-06-28 13:36:54 +0000
commit8433f82996ead276b305b5c8e4314d9295e08bbe (patch)
tree55f0c2336741bfcbb3c16780739225a598d3e685 /ext
parentfc0b7d587a8d05437521d55af93bf10fbdc32e2b (diff)
downloadperl-8433f82996ead276b305b5c8e4314d9295e08bbe.tar.gz
ext/Pod-Html/t/*.t: Have each file run in tempdir
Until now, the tests for this library ran inside the ext/Pod-Html directory in the core distribution. Since the tests necessarily create files while the harness runs, there was a possibility for race conditions, which meant that we had to have a workaround in t/harness to have the tests in this directory not run in parallel. This commit restructures the testing process so that each test program gets its own tempdir in which to create files and directories. The test architecture is now found in t/lib/Testing.pm. This module will export two functions on demand that are used in the individual test files. They guarantee that all files created when running a test program will be created in a temporary directory rather than underneath the core distribution. t/pod2html-lib.pl is now superseded by t/lib/Testing.pm and can be removed. The workaround has been removed from t/harness. Change directory name from testdir/ to corpus/. So as to more precisely describe what the directory's purpose is. Keep porting tests happy. Update MANIFEST and known_pod_issues database. Acknowledge Craig Berry's recommendation in earlier branch This should help in the resolution of https://github.com/Perl/perl5/issues/12271. Correct typo spotted by rjbs.
Diffstat (limited to 'ext')
-rw-r--r--ext/Pod-Html/corpus/perlpodspec-copy.pod (renamed from ext/Pod-Html/testdir/perlpodspec-copy.pod)0
-rw-r--r--ext/Pod-Html/corpus/perlvar-copy.pod (renamed from ext/Pod-Html/testdir/perlvar-copy.pod)0
-rw-r--r--ext/Pod-Html/t/cache.t29
-rw-r--r--ext/Pod-Html/t/crossref.t57
-rw-r--r--ext/Pod-Html/t/crossref2.t60
-rw-r--r--ext/Pod-Html/t/crossref3.t58
-rw-r--r--ext/Pod-Html/t/feature.t50
-rw-r--r--ext/Pod-Html/t/feature2.t47
-rw-r--r--ext/Pod-Html/t/htmldir1.t77
-rw-r--r--ext/Pod-Html/t/htmldir2.t76
-rw-r--r--ext/Pod-Html/t/htmldir3.t90
-rw-r--r--ext/Pod-Html/t/htmldir4.t62
-rw-r--r--ext/Pod-Html/t/htmldir5.t56
-rw-r--r--ext/Pod-Html/t/htmlescp.t30
-rw-r--r--ext/Pod-Html/t/htmllink.t30
-rw-r--r--ext/Pod-Html/t/htmlview.t30
-rw-r--r--ext/Pod-Html/t/lib/Testing.pm598
-rw-r--r--ext/Pod-Html/t/pod2html-lib.pl134
-rw-r--r--ext/Pod-Html/t/poderr.t29
-rw-r--r--ext/Pod-Html/t/podnoerr.t30
20 files changed, 1144 insertions, 399 deletions
diff --git a/ext/Pod-Html/testdir/perlpodspec-copy.pod b/ext/Pod-Html/corpus/perlpodspec-copy.pod
index 593a4e21aa..593a4e21aa 100644
--- a/ext/Pod-Html/testdir/perlpodspec-copy.pod
+++ b/ext/Pod-Html/corpus/perlpodspec-copy.pod
diff --git a/ext/Pod-Html/testdir/perlvar-copy.pod b/ext/Pod-Html/corpus/perlvar-copy.pod
index efb00a012d..efb00a012d 100644
--- a/ext/Pod-Html/testdir/perlvar-copy.pod
+++ b/ext/Pod-Html/corpus/perlvar-copy.pod
diff --git a/ext/Pod-Html/t/cache.t b/ext/Pod-Html/t/cache.t
index 3a48a3cb23..425a7b7b00 100644
--- a/ext/Pod-Html/t/cache.t
+++ b/ext/Pod-Html/t/cache.t
@@ -1,23 +1,31 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- die "Run me from outside the t/ directory, please" unless -d 't';
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
-# test the directory cache
-# XXX test --flush and %Pages being loaded/used for cross references
-
use strict;
-use Cwd;
-use Pod::Html;
-use Data::Dumper;
+use warnings;
use Test::More tests => 10;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
+
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my $args;
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
my $cwd = Pod::Html::_unixify(Cwd::cwd());
-my $infile = "t/cache.pod";
+my $infile = catfile('t', 'cache.pod');
my $outfile = "cacheout.html";
my $cachefile = "pod2htmd.tmp";
-my $tcachefile = "t/pod2htmd.tmp";
+my $tcachefile = catfile('t', 'pod2htmd.tmp');
unlink $cachefile, $tcachefile;
is(-f $cachefile, undef, "No cache file to start");
@@ -70,3 +78,4 @@ close $cache;
1 while unlink $tcachefile;
is(-f $cachefile, undef, "No cache file to end");
is(-f $tcachefile, undef, "No cache file to end");
+
diff --git a/ext/Pod-Html/t/crossref.t b/ext/Pod-Html/t/crossref.t
index 2505c9dd9e..5ba28de9e3 100644
--- a/ext/Pod-Html/t/crossref.t
+++ b/ext/Pod-Html/t/crossref.t
@@ -1,33 +1,44 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 1 if $output;
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my ($v, $d) = splitpath(cwd(), 1);
+my @dirs = splitdir($d);
+shift @dirs if $dirs[0] eq '';
+my $relcwd = join '/', @dirs;
- my ($v, $d) = splitpath(cwd(), 1);
- my @dirs = splitdir($d);
- shift @dirs if $dirs[0] eq '';
- my $relcwd = join '/', @dirs;
-
- convert_n_test("crossref", "cross references", {
- podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . File::Spec::Unix->catdir($relcwd, 'testdir/test.lib'),
+$args = {
+ podstub => "crossref",
+ description => "cross references",
+ expect => $expect_raw,
+ p2h => {
+ podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'),
podroot => catpath($v, '/', ''),
quiet => 1,
- } );
-}
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
@@ -67,15 +78,15 @@ __DATA__
<p><a href="#non-existent-section">&quot;non existent section&quot;</a></p>
-<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html">var-copy</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html">var-copy</a></p>
-<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
<p><code>var-copy</code></p>
<p><code>var-copy/$&quot;</code></p>
-<p><a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
+<p><a href="/[RELCURRENTWORKINGDIRECTORY]/corpus/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
<p><code>podspec-copy/First:</code></p>
diff --git a/ext/Pod-Html/t/crossref2.t b/ext/Pod-Html/t/crossref2.t
index a2bdfb7df4..5843330f22 100644
--- a/ext/Pod-Html/t/crossref2.t
+++ b/ext/Pod-Html/t/crossref2.t
@@ -1,32 +1,42 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 1 if $output;
-
- my $cwd = Pod::Html::_unixify(cwd());
-
- convert_n_test("crossref", "cross references",
- {
- podpath => 't:testdir/test.lib',
- podroot => $cwd,
- htmldir => $cwd,
- quiet => 1,
- }
- );
-}
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my $cwd = Pod::Html::_unixify(cwd());
+
+$args = {
+ podstub => "crossref",
+ description => "cross references",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't:corpus/test.lib',
+ podroot => $cwd,
+ htmldir => $cwd,
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
@@ -66,15 +76,15 @@ __DATA__
<p><a href="#non-existent-section">&quot;non existent section&quot;</a></p>
-<p><a href="../testdir/test.lib/var-copy.html">var-copy</a></p>
+<p><a href="../corpus/test.lib/var-copy.html">var-copy</a></p>
-<p><a href="../testdir/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
+<p><a href="../corpus/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
<p><code>var-copy</code></p>
<p><code>var-copy/$&quot;</code></p>
-<p><a href="../testdir/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
+<p><a href="../corpus/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
<p><code>podspec-copy/First:</code></p>
diff --git a/ext/Pod-Html/t/crossref3.t b/ext/Pod-Html/t/crossref3.t
index 50bf0f23e2..919cfdfd70 100644
--- a/ext/Pod-Html/t/crossref3.t
+++ b/ext/Pod-Html/t/crossref3.t
@@ -1,30 +1,42 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 1 if $output;
-
- my $cwd = cwd();
-
- convert_n_test("crossref", "cross references", {
- podpath => 't:testdir/test.lib',
- podroot => $cwd,
- htmlroot => $cwd,
- quiet => 1,
- } );
-}
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my $cwd = cwd();
+
+$args = {
+ podstub => "crossref",
+ description => "cross references",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't:corpus/test.lib',
+ podroot => $cwd,
+ htmlroot => $cwd,
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
@@ -64,15 +76,15 @@ __DATA__
<p><a href="#non-existent-section">&quot;non existent section&quot;</a></p>
-<p><a href="[ABSCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html">var-copy</a></p>
+<p><a href="[ABSCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html">var-copy</a></p>
-<p><a href="[ABSCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
+<p><a href="[ABSCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html#pod">&quot;$&quot;&quot; in var-copy</a></p>
<p><code>var-copy</code></p>
<p><code>var-copy/$&quot;</code></p>
-<p><a href="[ABSCURRENTWORKINGDIRECTORY]/testdir/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
+<p><a href="[ABSCURRENTWORKINGDIRECTORY]/corpus/test.lib/podspec-copy.html#First">&quot;First:&quot; in podspec-copy</a></p>
<p><code>podspec-copy/First:</code></p>
diff --git a/ext/Pod-Html/t/feature.t b/ext/Pod-Html/t/feature.t
index 134768b202..f44cadea14 100644
--- a/ext/Pod-Html/t/feature.t
+++ b/ext/Pod-Html/t/feature.t
@@ -1,28 +1,48 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-my $cwd = cwd();
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
-convert_n_test("feature", "misc pod-html features", {
- backlink => 1,
- css => 'style.css',
- header => 1, # no styling b/c of --ccs
- htmldir => catdir($cwd, 't'),
- noindex => 1,
- podpath => 't',
- podroot => $cwd,
- title => 'a title',
- quiet => 1,
+my $tdir = setup_testing_dir( {
+ debug => $debug,
} );
+my $cwd = cwd();
+
+$args = {
+ podstub => "feature",
+ description => "misc pod-html features",
+ expect => $expect_raw,
+ p2h => {
+ backlink => 1,
+ css => 'style.css',
+ header => 1, # no styling b/c of --ccs
+ htmldir => catdir($cwd, 't'),
+ noindex => 1,
+ podpath => 't',
+ podroot => $cwd,
+ title => 'a title',
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
+
__DATA__
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
diff --git a/ext/Pod-Html/t/feature2.t b/ext/Pod-Html/t/feature2.t
index 6e345441f2..2a0ba32c27 100644
--- a/ext/Pod-Html/t/feature2.t
+++ b/ext/Pod-Html/t/feature2.t
@@ -1,28 +1,49 @@
-#!/usr/bin/perl -w # -*- perl -*-
-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
+use warnings;
use Test::More tests => 2;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
+
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
my $cwd = cwd();
my $warn;
$SIG{__WARN__} = sub { $warn .= $_[0] };
-convert_n_test("feature2", "misc pod-html features 2", {
- backlink => 1,
- header => 1,
- podpath => '.',
- podroot => $cwd,
- norecurse => 1,
- verbose => 1,
- quiet => 1,
-} );
+$args = {
+ podstub => "feature2",
+ description => "misc pod-html features 2",
+ expect => $expect_raw,
+ p2h => {
+ backlink => 1,
+ header => 1,
+ podpath => '.',
+ podroot => $cwd,
+ norecurse => 1,
+ verbose => 1,
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
+
like($warn,
qr(
\Acaching\ directories\ for\ later\ use\n
diff --git a/ext/Pod-Html/t/htmldir1.t b/ext/Pod-Html/t/htmldir1.t
index 8ceea7f22a..c705f81a3f 100644
--- a/ext/Pod-Html/t/htmldir1.t
+++ b/ext/Pod-Html/t/htmldir1.t
@@ -1,51 +1,62 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions;
+use warnings;
use Test::More tests => 2;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-# XXX Separate tests that rely on test.lib from the others so they are the only
-# ones skipped (instead of all of them). This applies to htmldir{1,3,5}.t, and
-# crossref.t (as of 10/29/11).
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 2 if $output;
-
- my ($v, $d) = splitpath(cwd(), 1);
- my @dirs = splitdir($d);
- shift @dirs if $dirs[0] eq '';
- my $relcwd = join '/', @dirs;
-
- my $data_pos = tell DATA; # to read <DATA> twice
-
-
- convert_n_test("htmldir1", "test --htmldir and --htmlroot 1a", {
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my ($v, $d) = splitpath(cwd(), 1);
+my @dirs = splitdir($d);
+shift @dirs if $dirs[0] eq '';
+my $relcwd = join '/', @dirs;
+
+$args = {
+ podstub => "htmldir1",
+ description => "test --htmldir and --htmlroot 1a",
+ expect => $expect_raw,
+ p2h => {
podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" .
- File::Spec::Unix->catdir($relcwd, 'testdir/test.lib'),
+ File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'),
podroot => catpath($v, '/', ''),
htmldir => 't',
quiet => 1,
- } );
-
- seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
-
- convert_n_test("htmldir1", "test --htmldir and --htmlroot 1b", {
+ },
+ debug => $debug,
+};
+xconvert($args);
+
+$args = {
+ podstub => "htmldir1",
+ description => "test --htmldir and --htmlroot 1b",
+ expect => $expect_raw,
+ p2h => {
podpath => $relcwd,
podroot => catpath($v, '/', ''),
htmldir => catdir($relcwd, 't'),
htmlroot => '/',
quiet => 1,
- } );
-}
+ },
+ debug => $debug,
+};
+xconvert($args);
+
__DATA__
<?xml version="1.0" ?>
@@ -76,7 +87,7 @@ __DATA__
<p>Normal text, a <a>link</a> to nowhere,</p>
-<p>a link to <a href="/[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html">var-copy</a>,</p>
+<p>a link to <a href="/[RELCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html">var-copy</a>,</p>
<p><a href="/[RELCURRENTWORKINGDIRECTORY]/t/htmlescp.html">htmlescp</a>,</p>
diff --git a/ext/Pod-Html/t/htmldir2.t b/ext/Pod-Html/t/htmldir2.t
index cad50a403b..95b40facea 100644
--- a/ext/Pod-Html/t/htmldir2.t
+++ b/ext/Pod-Html/t/htmldir2.t
@@ -1,38 +1,66 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
+use warnings;
use Test::More tests => 3;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-my $cwd = cwd();
-my $data_pos = tell DATA; # to read <DATA> twice
-
-convert_n_test("htmldir2", "test --htmldir and --htmlroot 2a", {
- podpath => 't',
- htmldir => 't',
- quiet => 1,
-} );
-
-seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
-convert_n_test("htmldir2", "test --htmldir and --htmlroot 2b", {
- podpath => 't',
- quiet => 1,
+my $tdir = setup_testing_dir( {
+ debug => $debug,
} );
-seek DATA, $data_pos, 0; # to read <DATA> thrice (expected output is the same)
+$args = {
+ podstub => "htmldir2",
+ description => "test --htmldir and --htmlroot 2a",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't',
+ htmldir => 't',
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
+
+$args = {
+ podstub => "htmldir2",
+ description => "test --htmldir and --htmlroot 2b",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't',
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
-# this test makes sure paths are absolute unless --htmldir is specified
-convert_n_test("htmldir2", "test --htmldir and --htmlroot 2c", {
- podpath => 't',
- podroot => $cwd,
- norecurse => 1, # testing --norecurse, too
- quiet => 1,
-} );
+my $cwd = cwd();
+$args = {
+ podstub => "htmldir2",
+ description => "test --htmldir and --htmlroot 2c",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't',
+ podroot => $cwd,
+ norecurse => 1, # testing --norecurse, too
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
diff --git a/ext/Pod-Html/t/htmldir3.t b/ext/Pod-Html/t/htmldir3.t
index 4998f90db5..a586babd03 100644
--- a/ext/Pod-Html/t/htmldir3.t
+++ b/ext/Pod-Html/t/htmldir3.t
@@ -1,47 +1,61 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions;
+use warnings;
use Test::More tests => 2;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 2 if $output;
-
- my $cwd = cwd();
- my ($v, $d) = splitpath($cwd, 1);
- my @dirs = splitdir($d);
- shift @dirs if $dirs[0] eq '';
- my $relcwd = join '/', @dirs;
-
- my $data_pos = tell DATA; # to read <DATA> twice
-
- convert_n_test("htmldir3", "test --htmldir and --htmlroot 3a", {
- podpath => $relcwd,
- podroot => catpath($v, '/', ''),
- htmldir => catdir($cwd, 't', ''), # test removal trailing slash,
- quiet => 1,
- } );
-
- seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
-
- convert_n_test("htmldir3", "test --htmldir and --htmlroot 3b", {
- podpath => catdir($relcwd, 't'),
- podroot => catpath($v, '/', ''),
- htmldir => 't',
- outfile => 't/htmldir3.html',
- quiet => 1,
- } );
-}
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my $cwd = cwd();
+my ($v, $d) = splitpath($cwd, 1);
+my @dirs = splitdir($d);
+shift @dirs if $dirs[0] eq '';
+my $relcwd = join '/', @dirs;
+
+$args = {
+ podstub => "htmldir3",
+ description => "test --htmldir and --htmlroot 3a",
+ expect => $expect_raw,
+ p2h => {
+ podpath => $relcwd,
+ podroot => catpath($v, '/', ''),
+ htmldir => catdir($cwd, 't', ''), # test removal trailing slash,
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
+
+$args = {
+ podstub => "htmldir3",
+ description => "test --htmldir and --htmlroot 3b",
+ expect => $expect_raw,
+ p2h => {
+ podpath => catdir($relcwd, 't'),
+ podroot => catpath($v, '/', ''),
+ htmldir => 't',
+ outfile => 't/htmldir3.html',
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
@@ -70,7 +84,7 @@ __DATA__
<p>Normal text, a <a>link</a> to nowhere,</p>
-<p>a link to <a href="[RELCURRENTWORKINGDIRECTORY]/testdir/test.lib/var-copy.html">var-copy</a>,</p>
+<p>a link to <a href="[RELCURRENTWORKINGDIRECTORY]/corpus/test.lib/var-copy.html">var-copy</a>,</p>
<p><a href="[RELCURRENTWORKINGDIRECTORY]/t/htmlescp.html">htmlescp</a>,</p>
diff --git a/ext/Pod-Html/t/htmldir4.t b/ext/Pod-Html/t/htmldir4.t
index e63eef2c2d..8157167c3f 100644
--- a/ext/Pod-Html/t/htmldir4.t
+++ b/ext/Pod-Html/t/htmldir4.t
@@ -1,33 +1,57 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions ':ALL';
+use warnings;
use Test::More tests => 2;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-my $cwd = cwd();
-my $data_pos = tell DATA; # to read <DATA> twice
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
-convert_n_test("htmldir4", "test --htmldir and --htmlroot 4a", {
- podpath => 't',
- htmldir => 't',
- outfile => catfile('t', 'htmldir4.html'),
- quiet => 1,
+my $tdir = setup_testing_dir( {
+ debug => $debug,
} );
-seek DATA, $data_pos, 0; # to read <DATA> twice (expected output is the same)
+my $cwd = cwd();
-convert_n_test("htmldir4", "test --htmldir and --htmlroot 4b", {
- podpath => 't',
- podroot => $cwd,
- htmldir => catdir($cwd, 't'),
- norecurse => 1,
- quiet => 1,
-} );
+$args = {
+ podstub => "htmldir4",
+ description => "test --htmldir and --htmlroot 4a",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't',
+ htmldir => 't',
+ outfile => catfile('t', 'htmldir4.html'),
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
+
+$args = {
+ podstub => "htmldir4",
+ description => "test --htmldir and --htmlroot 4b",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't',
+ podroot => $cwd,
+ htmldir => catdir($cwd, 't'),
+ norecurse => 1,
+ quiet => 1,
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
diff --git a/ext/Pod-Html/t/htmldir5.t b/ext/Pod-Html/t/htmldir5.t
index 7b4d650c45..566176108b 100644
--- a/ext/Pod-Html/t/htmldir5.t
+++ b/ext/Pod-Html/t/htmldir5.t
@@ -1,36 +1,46 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
-}
-
-END {
- rem_test_dir();
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
-use Cwd;
-use File::Spec::Functions;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-SKIP: {
- my $output = make_test_dir();
- skip "$output", 1 if $output;
-
-
- my $cwd = catdir cwd(); # catdir converts path separators to that of the OS
- # running the test
- # XXX but why don't the other tests complain about
- # this?
-
- convert_n_test("htmldir5", "test --htmldir and --htmlroot 5", {
- podpath => 't:testdir/test.lib',
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+my $cwd = catdir cwd(); # catdir converts path separators to that of the OS
+ # running the test
+ # XXX but why don't the other tests complain about
+ # this?
+
+$args = {
+ podstub => "htmldir5",
+ description => "test --htmldir and --htmlroot 5",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't:corpus/test.lib',
podroot => $cwd,
htmldir => $cwd,
htmlroot => '/',
quiet => 1,
- } );
-}
+ },
+ debug => $debug,
+};
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
@@ -59,7 +69,7 @@ __DATA__
<p>Normal text, a <a>link</a> to nowhere,</p>
-<p>a link to <a href="../testdir/test.lib/var-copy.html">var-copy</a>,</p>
+<p>a link to <a href="../corpus/test.lib/var-copy.html">var-copy</a>,</p>
<p><a href="./htmlescp.html">htmlescp</a>,</p>
diff --git a/ext/Pod-Html/t/htmlescp.t b/ext/Pod-Html/t/htmlescp.t
index fd5207ab22..bae0e1a0de 100644
--- a/ext/Pod-Html/t/htmlescp.t
+++ b/ext/Pod-Html/t/htmlescp.t
@@ -1,13 +1,35 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
+use warnings;
use Test::More tests => 1;
-
-convert_n_test("htmlescp", "html escape");
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
+
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+$args = {
+ podstub => "htmlescp",
+ description => "html escape",
+ expect => $expect_raw,
+ debug => $debug,
+};
+
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
diff --git a/ext/Pod-Html/t/htmllink.t b/ext/Pod-Html/t/htmllink.t
index 033c93f16f..01787555e2 100644
--- a/ext/Pod-Html/t/htmllink.t
+++ b/ext/Pod-Html/t/htmllink.t
@@ -1,13 +1,35 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
+use warnings;
use Test::More tests => 1;
-
-convert_n_test("htmllink", "html links");
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
+
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+$args = {
+ podstub => "htmllink",
+ description => "html links",
+ expect => $expect_raw,
+ debug => 1,
+};
+
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
diff --git a/ext/Pod-Html/t/htmlview.t b/ext/Pod-Html/t/htmlview.t
index 00d9e7b01f..56dcaa8f27 100644
--- a/ext/Pod-Html/t/htmlview.t
+++ b/ext/Pod-Html/t/htmlview.t
@@ -1,16 +1,38 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-convert_n_test("htmlview", "html rendering", {
- quiet => 1,
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
} );
+$args = {
+ podstub => "htmlview",
+ description => "html rendering",
+ expect => $expect_raw,
+ p2h => {
+ quiet => 1,
+ },
+};
+
+xconvert($args);
+
__DATA__
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm
new file mode 100644
index 0000000000..81a779e665
--- /dev/null
+++ b/ext/Pod-Html/t/lib/Testing.pm
@@ -0,0 +1,598 @@
+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 @ISA = qw(Exporter);
+our @EXPORT_OK = qw(
+ setup_testing_dir
+ xconvert
+);
+use Cwd;
+use Pod::Html;
+use Config;
+use File::Basename;
+use File::Copy;
+use File::Path ( qw| make_path | );
+use File::Spec::Functions ':ALL';
+use File::Temp ( qw| tempdir | );
+use Data::Dumper;$Data::Dumper::Sortkeys=1;
+
+*ok = \&Test::More::ok;
+*is = \&Test::More::is;
+
+our @no_arg_switches = ( qw|
+ flush recurse norecurse
+ quiet noquiet verbose noverbose
+ index noindex backlink nobacklink
+ header noheader poderrors nopoderrors
+| );
+
+=head1 NAME
+
+Testing - Helper functions for testing Pod-Html
+
+=head1 SYNOPSIS
+
+ use Testing qw( setup_testing_dir xconvert );
+
+ my $tdir = setup_testing_dir( {
+ debug => $debug,
+ } );
+
+ $args = {
+ podstub => "htmldir1",
+ description => "test --htmldir and --htmlroot 1a",
+ expect => $expect_raw,
+ p2h => {
+ podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" .
+ File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'),
+ podroot => catpath($v, '/', ''),
+ htmldir => 't',
+ quiet => 1,
+ },
+ debug => $debug,
+ };
+ xconvert($args);
+
+=head1 DESCRIPTION
+
+This module exports, upon request only, 2 subroutines which are used in most
+of the files in the core distribution test suite for Pod-HTML
+(F<ext/Pod-Html/t/*.t>). In the future we may add additional subroutines,
+particularly to better diagnose problems with Pod-Html.
+
+=head2 Pod-Html's Testing Structure
+
+As of version 1.26 of this module (early 2021), the testing structure consists
+of 16 F<.pod> files and 18 F<.t> files located in two subdirectories,
+F<corpus/> and F<t/>. Let's analyze these by directory.
+
+=head3 Files in F<corpus/>
+
+There are currently 2 F<.pod> files in F<corpus/> both of which are old
+versions of F<pod/*.pod> files selected to give some complexity to the test
+suite. Since we don't actually attempt to make HTML out of their POD, we
+don't need to discuss them further.
+
+=head3 Files in F<t/>
+
+There are currently 14 F<.pod> files and 18 F<.t> files in F<t/>. Both of
+these numbers may change in the future.
+
+Currently there are 2 F<t/.t> files (F<t/anchorify.t> and F<t/eol.t>) which
+exercise certain functionality of F<Pod::Html> but which do not require
+F<t/*.pod> files as data input. These files do not make use of the
+subroutines exported by this module. We may add more test files like this in
+the future to ensure high test coverage, but don't need to discuss them
+further here.
+
+The remaining 16 F<t/*.t> test programs make use of the testing subroutines
+exported by this module. Most, but not all, of these test programs make use
+of the F<t/*.pod> files. Each such test program makes use of only 1
+F<t/*.pod> file at a time, though there are several cases where several,
+similarly named, test programs make use of the same F<t/*.pod> file for data
+input. For example,
+
+ t/crossref.t
+ t/crossref2.t
+ t/crossref3.t
+
+all make use of
+
+ t/crossref.pod
+
+Each F<t/*.pod> file consists solely of simple documentation in POD format.
+
+=head3 High-level description of programs which use F<.pod> files as input
+
+Each of the F<t/*.t> programs which makes use of a given F<t/*.pod> file
+slurps the text of a single such F<t/*.pod> file into memory. The test
+program holds text in a C<DATA> handle which serves as a B<template> for the
+HTML expected to be generated by running the F<t/*.pod> file through
+C<Pod::Html::pod2html()>. The HTML output by C<Pod::Html::pod2html()> can
+vary greatly, particularly with respect to links, depending on the arguments
+passed to that function. The HTML output will also be affected by the
+underlying operating system, I<e.g.,> with respect to path separators. Hence,
+we cannot hard-code the expected HTML output into the C<DATA> template or any
+place else. We have to allow C<Pod::Html::pod2html()> to massage the template
+data to get an "expected output" against which we match the "actual output"
+which come from running C<Pod::Html::pod2html()> over the text originally
+slurped into memory from the F<t/*.pod> file.
+
+Granted, there is a certain amount of circularity in this testing regimen. On
+a given operating system, with a given F<t/*.pod> file as raw input, a given
+POD parser invoked within C<Pod::Html::pod2html()> and a given set of
+arguments passed to C<pod2html()>, there can and should be only one possible
+HTML string generated as output. What we currently have in a given test
+program's C<DATA> handle is merely that HTML string retrofitted with certain
+template elements as needed to make the "got" and the "expected" identical.
+We're not testing whether we're generating "good" HTML. We're simply testing
+that we get consistent results out of C<pod2html()> year after year.
+
+=head3 How a test program works step-by-step
+
+Here we continue to focus on those test programs which make use of the testing
+functions exported by F<Testing> and which take a F<t/*.pod> file as input.
+
+We assume that we begin our tests from the top level of the Perl 5 core distribution and are using F<t/harness>. Hence, to run the test files we say:
+
+ cd t; ./perl harness ../ext/Pod-Html/t/*.t; cd -
+
+The program then slurps contents of the C<DATA> handle into memory.
+
+The program then calls C<setup_testing_dir()> from this module to create a
+temporary directory and populate it as needed. C<setup_testing_dir()> returns
+the absolute path to that directory, but at the point of return you are
+actually located two levels beneath the temporary directory in a directory whose relative path is
+F<ext/Pod-Html/>. (This is equivalent to being in F<toplevel/ext/Pod-Html/>
+for tests in versions of Pod-Html distributed with earlier versions of
+F<perl>.)
+
+Note that this means that at the end of the program you will have to
+switch back to your starting directory so that the tempdir can automatically
+be cleaned up. We automate this via an C<END> block.
+
+You then prepare arguments for our principal testing function, C<xconvert()>
+(which supersedes the former C<convert_n_test()>. These arguments take the
+form of a single hash reference. One customary but optional element in that
+hashref, C<p2h>, is itself a hashref of key-value pairs corresponding to
+switches passed to the F<pod2html> command-line utility or to
+C<Pod::Html::pod2html()>. The other elements in the hashref passed to
+C<xconvert()> include the stub of the basename of the F<t/*.pod> file being
+used, the text of that file (which we've already slurped into memory), the
+test description, and whether we want extra debugging output or not. The
+program then adds a key-value pair to indicate whether we're running via core
+distribution test harness or not.
+
+The hashref is then passed to C<xconvert()> which internally generates an
+expected HTML output string by massaging the text read in from the C<DATA>
+handle. C<xconvert()> reads in the relevant F<t/*.pod> file and passes it to
+C<Pod::Html::pod2html()>, which parses the POD and generates the actual HTML
+output. If "got" matches "expected", a PASS is recorded for this instance of
+C<xconvert()>.
+
+As the example of F<t/htmldir1.t> illustrates:
+
+=over 4
+
+=item *
+
+The user can define a variety of arguments to be passed through to C<Pod::Html::pod2html()>.
+
+ my ($v, $d) = splitpath(cwd(), 1);
+ my @dirs = splitdir($d);
+ shift @dirs if $dirs[0] eq '';
+ my $relcwd = join '/', @dirs;
+
+ $args = {
+ ...
+ p2h => {
+ podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" .
+ File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'),
+ podroot => catpath($v, '/', ''),
+ htmldir => 't',
+ quiet => 1,
+ },
+ ...
+ };
+
+=item *
+
+The user can try out a variety of different arguments in the C<p2h> element
+and end up with the same HTML output as predicted by the C<DATA> template by
+calling C<xconvert()> more than once per file.
+
+ $args = {
+ podstub => "htmldir1",
+ description => "test --htmldir and --htmlroot 1a",
+ expect => $expect_raw,
+ p2h => {
+ podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" .
+ File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'),
+ podroot => catpath($v, '/', ''),
+ htmldir => 't',
+ quiet => 1,
+ },
+ };
+ xconvert($args);
+
+ $args = {
+ podstub => "htmldir1",
+ description => "test --htmldir and --htmlroot 1b",
+ expect => $expect_raw,
+ p2h => {
+ podpath => $relcwd,
+ podroot => catpath($v, '/', ''),
+ htmldir => catdir($relcwd, 't'),
+ htmlroot => '/',
+ quiet => 1,
+ },
+ };
+ xconvert($args);
+
+Note that in the two "runs" above, the values for C<podstub> are the
+same, but the arguments to C<p2h> differ; we've distinguished the two runs
+by different values for C<description>.
+
+=back
+
+Note that all runs within an individual F<t/*.t> program share the same
+temporary directory. Since C<Pod::Html::pod2html()> typically caches its
+understanding of where F<.pod> files are located, there is a possibility that
+the contents of the cache may affect the generated HTML output in an adverse
+way. This possibility will be addressed in an upcoming version of this
+program.
+
+When all runs have been completed (as noted above), the C<END> block brings us
+back to the directory we started from to permit the temporary directory and
+its contents to be cleanly deleted.
+
+=head1 SUBROUTINES
+
+=head2 C<setup_testing_dir()>
+
+=over 4
+
+=item * Purpose
+
+Create and populate a temporary directory to hold all activity for a single F<t/*.t> program.
+
+=item * Arguments
+
+ $tdir = setup_testing_dir( {
+ startdir => $startdir,
+ debug => $debug,
+ } );
+
+Single hash reference with two possible elements.
+
+=over 4
+
+=item * C<debug>
+
+A Boolean which you will typically set at the start of your program. A
+Perl-true value prints out your location and creates a temporary directory
+which is B<not> cleaned up at the program's completion, thereby permitting you
+to examine the intermediate files created by the program.
+
+=back
+
+=item * Return Value
+
+String holding the absolute path of the temporary directory.
+
+=item * Comments
+
+The function C<chdir>s internally and leaves you in a directory called
+F<ext/Pod-Html> beneath the temporary directory found in the return value.
+
+The function is somewhat equivalent to testing helper function
+C<make_test_dir> in F<t/pod2html-lib.pl> in versions of Pod-Html shipped with
+versions of F<perl> up through 5.32.
+
+=back
+
+=cut
+
+sub setup_testing_dir {
+ my $args = shift;
+ my $cwd = cwd();
+ my $toptempdir = $args->{debug} ? tempdir() : tempdir( CLEANUP => 1 );
+ if ($args->{debug}) {
+ print STDERR "toptempdir: $toptempdir\n";
+ }
+ chdir $toptempdir or die "Unable to change to $toptempdir: $!";
+
+ my $ephdir = catdir($toptempdir, 'ext', 'Pod-Html');
+ my ($fromdir, $targetdir, $pod_glob, @testfiles);
+
+ # Copy ext/Pod-Html/t/*.pod files into position under tempdir
+ $fromdir = catdir($cwd, 't');
+ # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy
+ $pod_glob = catfile($fromdir, '*.pod');
+ @testfiles = glob($pod_glob);
+
+ $targetdir = catdir($ephdir, 't');
+ make_path($targetdir) or die("Cannot mkdir $targetdir for testing: $!");
+ for my $f (@testfiles) {
+ copy $f => $targetdir or die "Unable to copy: $!";
+ }
+
+ # Copy ext/Pod-Html/corpus/*.pod files into position under tempdir
+ $fromdir = catdir($cwd, 'corpus');
+ # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy
+ $pod_glob = catfile($fromdir, '*.pod');
+ @testfiles = glob($pod_glob);
+
+ $targetdir = catdir($ephdir, 'corpus', 'test.lib');
+ make_path($targetdir) or die "Could not make $targetdir for testing: $!";
+
+ my %copying = ();
+ for my $g (@testfiles) {
+ my $basename = basename($g);
+ my ($stub) = $basename =~ m{^(.*)\.pod};
+ $stub =~ s{^perl(.*)}{$1};
+ $copying{$stub} = {
+ source => $g,
+ target => catfile($targetdir, "${stub}.pod")
+ };
+ }
+
+ for my $k (keys %copying) {
+ copy $copying{$k}{source} => $copying{$k}{target}
+ or die "Unable to copy: $!";
+ }
+
+ # Move into tempdir/ext/Pod-Html
+ chdir $ephdir or die "Unable to change to $ephdir: $!";
+ return $toptempdir;
+}
+
+=head2 C<xconvert()>
+
+=over 4
+
+=item * Purpose
+
+Compare whether the HTML generated by C<Pod::Html::pod2html()>'s parsing of a
+F<.pod> file matches the expectation generated by parsing the C<DATA> block
+within the test file.
+
+=item * Arguments
+
+Single hash reference.
+
+ $args = {
+ podstub => "htmldir5",
+ description => "test --htmldir and --htmlroot 5",
+ expect => $expect_raw,
+ p2h => {
+ podpath => 't:corpus/test.lib',
+ podroot => $cwd,
+ htmldir => $cwd,
+ htmlroot => '/',
+ quiet => 1,
+ },
+ debug => $debug,
+ };
+ $args->{core} = 1 if $ENV{PERL_CORE};
+
+Elements are as follows:
+
+=over 4
+
+=item * C<podstub>
+
+String holding the stub (or stem) of the F<.pod> file being used as input.
+The stub is the basename of the file less the file extension or suffix.
+(Equivalent to the first argument passed to the former C<convert_and_test>
+test helper routine.) Required.
+
+=item * C<description>
+
+String holding the description (or name or label) in typical TAP syntax.
+(Equivalent to the second argument passed to the former C<convert_and_test>
+helper routine.) Required.
+
+=item * C<expect>
+
+String holding the "raw" expectations read in from the C<DATA> handle. Each
+run of C<xconvert()> within a given test file should have the same value for
+this key. Required.
+
+=item * C<p2h>
+
+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.
+
+=item * C<debug>
+
+Boolean, generally set once at the program's top. When Perl-true, displays
+extra debugging output, including turning on C<Pod::Html::pod2html()>'s
+C<verbose> option. Optional.
+
+=item * C<core>
+
+Boolean. This should be set to a Perl-true value when the file is to be run
+from the test harness rather than from the top-level of the repository.
+
+=back
+
+=item * Return Value
+
+Not explicitly defined, but should return a Perl-true value upon completion.
+
+=item * Comment
+
+This function essentially asks, "Are we getting the same HTML output the last time we tinkered with the code in this distribution?" Hence, it is dependent on the particular parsing and HTML composition functionality found within C<Pod::Html::pod2html()>, which is a somewhat customized subclass of F<Pod::Simple::XHTML>. If, in the future, we offer functionality based on other parsing classes, then the C<DATA> sections of the F<t/*.t> files will have to be revised and perhaps the guts of C<xconvert()> as well.
+
+This function is roughly equivalent to test helper function C<convert_n_test()> in earlier
+versions of Pod-Html.
+
+=back
+
+=cut
+
+sub xconvert {
+ my $args = shift;
+ for my $k ('podstub', 'description', 'expect') {
+ die("convert_n_test() must have $k element")
+ unless length($args->{$k});
+ }
+ my $podstub = $args->{podstub};
+ my $description = $args->{description};
+ my $debug = $args->{debug} // 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 ($vol, $dir) = splitpath($cwd, 1);
+ my @dirs = splitdir($dir);
+ shift @dirs if $dirs[0] eq '';
+ my $relcwd = join '/', @dirs;
+
+ my $new_dir = catdir $dir, "t";
+ my $infile = catpath $vol, $new_dir, "$podstub.pod";
+ my $outfile = catpath $vol, $new_dir, "$podstub.html";
+
+ my $args_table = _prepare_argstable( {
+ infile => $infile,
+ outfile => $outfile,
+ cwd => $cwd,
+ p2h => $args->{p2h},
+ } );
+ my @args_list = _prepare_argslist($args_table);
+ Pod::Html::pod2html( @args_list );
+
+ $cwd =~ s|\/$||;
+
+ my $expect = _set_expected_html($args->{expect}, $relcwd, $cwd);
+ my $result = _get_html($outfile);
+
+ _process_diff( {
+ expect => $expect,
+ result => $result,
+ description => $description,
+ podstub => $podstub,
+ outfile => $outfile,
+ debug => $debug,
+ } );
+
+ # pod2html creates these
+ unless ($debug) {
+ 1 while unlink $outfile;
+ 1 while unlink "pod2htmd.tmp";
+ }
+}
+
+sub _prepare_argstable {
+ my $args = shift;
+ 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}) {
+ for my $sw (keys %{$args->{p2h}}) {
+ if ($no_arg_switches{$sw}) {
+ $args_table{$sw} = undef;
+ }
+ else {
+ $args_table{$sw} = $args->{p2h}->{$sw};
+ }
+ }
+ }
+ return \%args_table;
+}
+
+sub _prepare_argslist {
+ my $args_table = shift;
+ my @args_list = ();
+ for my $k (keys %{$args_table}) {
+ if (defined $args_table->{$k}) {
+ push @args_list, "--" . $k . "=" . $args_table->{$k};
+ }
+ else {
+ push @args_list, "--" . $k;
+ }
+ }
+ return @args_list;
+}
+
+sub _set_expected_html {
+ my ($expect, $relcwd, $cwd) = @_;
+ $expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/;
+ $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$relcwd/g;
+ $expect =~ s/\[ABSCURRENTWORKINGDIRECTORY\]/$cwd/g;
+ if (ord("A") == 193) { # EBCDIC.
+ $expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/;
+ }
+ $expect =~ s/\n\n(some html)/$1/m;
+ $expect =~ s{(TESTING FOR AND BEGIN</h1>)\n\n}{$1}m;
+ return $expect;
+}
+
+sub _get_html {
+ my $outfile = shift;
+ local $/;
+
+ open my $in, '<', $outfile or die "cannot open $outfile: $!";
+ my $result = <$in>;
+ close $in;
+ return $result;
+}
+
+sub _process_diff {
+ my $args = shift;
+ die("process_diff() takes hash ref") unless ref($args) eq 'HASH';
+ my %keys_needed = map { $_ => 1 } (qw| expect result description podstub outfile |);
+ my %keys_seen = map { $_ => 1 } ( keys %{$args} );
+ my @keys_missing = ();
+ for my $kn (keys %keys_needed) {
+ push @keys_missing, $kn unless exists $keys_seen{$kn};
+ }
+ die("process_diff() arguments missing: @keys_missing") if @keys_missing;
+
+ my $diff = '/bin/diff';
+ -x $diff or $diff = '/usr/bin/diff';
+ -x $diff or $diff = undef;
+ my $diffopt = $diff ? $^O =~ m/(linux|darwin)/ ? '-u' : '-c'
+ : '';
+ $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};
+ };
+ }
+ else {
+ # This is fairly evil, but lets us get detailed failure modes
+ # anywhere that we've failed to identify a diff program.
+ is($args->{expect}, $args->{result}, $args->{description});
+ }
+ return 1;
+}
+
+=head1 AUTHORS
+
+The testing code reworked into its present form has many authors and dates
+back to the dawn of Perl 5, perhaps beyond. The documentation was written by
+James E Keenan in March 2021.
+
+=cut
+
+1;
diff --git a/ext/Pod-Html/t/pod2html-lib.pl b/ext/Pod-Html/t/pod2html-lib.pl
deleted file mode 100644
index 8725b0ae54..0000000000
--- a/ext/Pod-Html/t/pod2html-lib.pl
+++ /dev/null
@@ -1,134 +0,0 @@
-require Cwd;
-require Pod::Html;
-require Config;
-use File::Spec::Functions ':ALL';
-use File::Path 'remove_tree';
-use File::Copy;
-
-# make_test_dir and rem_test_dir dynamically create and remove testdir/test.lib.
-# it is created dynamically to pass t/filenames.t, which does not allow '.'s in
-# filenames as '.' is the directory separator on VMS. All tests that require
-# testdir/test.lib to be present are skipped if test.lib cannot be created.
-sub make_test_dir {
- if (-d 'testdir/test.lib') {
- warn "Directory 'test.lib' exists (it shouldn't yet) - removing it";
- rem_test_dir();
- }
- mkdir('testdir/test.lib') or return "Could not make test.lib directory: $!\n";
- copy('testdir/perlpodspec-copy.pod', 'testdir/test.lib/podspec-copy.pod')
- or return "Could not copy perlpodspec-copy: $!";
- copy('testdir/perlvar-copy.pod', 'testdir/test.lib/var-copy.pod')
- or return "Could not copy perlvar-copy: $!";
- return 0;
-}
-
-sub rem_test_dir {
- return unless -d 'testdir/test.lib';
- remove_tree('testdir/test.lib')
- or warn "Error removing temporary directory 'testdir/test.lib'";
-}
-
-sub convert_n_test {
- my($podfile, $testname, $p2h_args_ref) = @_;
- if (defined $p2h_args_ref) {
- die "3rd argument must be hashref"
- unless ref($p2h_args_ref) eq 'HASH'; # TEST ME
- }
-
- my $cwd = Pod::Html::_unixify( Cwd::cwd() );
- my ($vol, $dir) = splitpath($cwd, 1);
- my @dirs = splitdir($dir);
- shift @dirs if $dirs[0] eq '';
- my $relcwd = join '/', @dirs;
-
- my $new_dir = catdir $dir, "t";
- my $infile = catpath $vol, $new_dir, "$podfile.pod";
- my $outfile = catpath $vol, $new_dir, "$podfile.html";
-
- my %args_table = (
- infile => $infile,
- outfile => $outfile,
- podpath => 't',
- htmlroot => '/',
- podroot => $cwd,
- );
- my %no_arg_switches = map { $_ => 1 } ( qw|
- flush recurse norecurse
- quiet noquiet verbose noverbose
- index noindex backlink nobacklink
- header noheader poderrors nopoderrors
- | );
- if (defined $p2h_args_ref) {
- for my $sw (keys %{$p2h_args_ref}) {
- if ($no_arg_switches{$sw}) {
- $args_table{$sw} = undef;
- } else {
- $args_table{$sw} = $p2h_args_ref->{$sw};
- }
- }
- }
- my @args_list = ();
- for my $k (keys %args_table) {
- if (defined $args_table{$k}) {
- push @args_list, "--" . $k . "=" . $args_table{$k};
- } else {
- push @args_list, "--" . $k;
- }
- }
-
- Pod::Html::pod2html( @args_list );
-
- $cwd =~ s|\/$||;
-
- my ($expect, $result);
- {
- local $/;
- # expected
- $expect = <DATA>;
- $expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/;
- $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$relcwd/g;
- $expect =~ s/\[ABSCURRENTWORKINGDIRECTORY\]/$cwd/g;
- if (ord("A") == 193) { # EBCDIC.
- $expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/;
- }
- if (Pod::Simple->VERSION > 3.28) {
- $expect =~ s/\n\n(some html)/$1/m;
- $expect =~ s{(TESTING FOR AND BEGIN</h1>)\n\n}{$1}m;
- }
-
- # result
- open my $in, '<', $outfile or die "cannot open $outfile: $!";
- $result = <$in>;
- close $in;
- }
-
- my $diff = '/bin/diff';
- -x $diff or $diff = '/usr/bin/diff';
- -x $diff or $diff = undef;
- my $diffopt = $diff ? $^O =~ m/(linux|darwin)/ ? '-u' : '-c'
- : '';
- $diff = 'fc/n' if $^O =~ /^MSWin/;
- $diff = 'differences' if $^O eq 'VMS';
- if ($diff) {
- ok($expect eq $result, $testname) or do {
- my $expectfile = "${podfile}_expected.tmp";
- open my $tmpfile, ">", $expectfile or die $!;
- print $tmpfile $expect;
- close $tmpfile;
- open my $diff_fh, "-|", "$diff $diffopt $expectfile $outfile" or die $!;
- print STDERR "# $_" while <$diff_fh>;
- close $diff_fh;
- unlink $expectfile;
- };
- } else {
- # This is fairly evil, but lets us get detailed failure modes
- # anywhere that we've failed to identify a diff program.
- is($expect, $result, $testname);
- }
-
- # pod2html creates these
- 1 while unlink $outfile;
- 1 while unlink "pod2htmd.tmp";
-}
-
-1;
diff --git a/ext/Pod-Html/t/poderr.t b/ext/Pod-Html/t/poderr.t
index ae1a751f95..f058df7bd4 100644
--- a/ext/Pod-Html/t/poderr.t
+++ b/ext/Pod-Html/t/poderr.t
@@ -1,13 +1,36 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
+use warnings;
use Test::More tests => 1;
-convert_n_test("poderr", "pod error section");
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
+
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
+} );
+
+$args = {
+ podstub => "poderr",
+ description => "pod error section",
+ expect => $expect_raw,
+ debug => 1,
+};
+
+xconvert($args);
__DATA__
<?xml version="1.0" ?>
diff --git a/ext/Pod-Html/t/podnoerr.t b/ext/Pod-Html/t/podnoerr.t
index b7e7643bae..b333e4249a 100644
--- a/ext/Pod-Html/t/podnoerr.t
+++ b/ext/Pod-Html/t/podnoerr.t
@@ -1,16 +1,38 @@
-#!/usr/bin/perl -w # -*- perl -*-
+# -*- perl -*-
BEGIN {
- require "./t/pod2html-lib.pl";
+ use File::Spec::Functions ':ALL';
+ @INC = map { rel2abs($_) }
+ (qw| ./lib ./t/lib ../../lib |);
}
use strict;
+use warnings;
use Test::More tests => 1;
+use Testing qw( setup_testing_dir xconvert );
+use Cwd;
-convert_n_test("podnoerr", "pod error section", {
- nopoderrors => 1,
+my $debug = 0;
+my $startdir = cwd();
+END { chdir($startdir) or die("Cannot change back to $startdir: $!"); }
+my ($expect_raw, $args);
+{ local $/; $expect_raw = <DATA>; }
+
+my $tdir = setup_testing_dir( {
+ debug => $debug,
} );
+$args = {
+ podstub => "podnoerr",
+ description => "pod error section",
+ expect => $expect_raw,
+ p2h => {
+ nopoderrors => 1,
+ },
+};
+
+xconvert($args);
+
__DATA__
<?xml version="1.0" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">