Start using the corpus files

.gitignore

@@ -17,3 +17,4 @@ nytprof.*
 nytprof
 podman.out*
 *.swp
+xt/got

MANIFEST

@@ -1,5 +1,9 @@
 Changes
 CONTRIBUTING
+corpus/fetch_pages.pl
+corpus/gh-55-encoding-first.pod
+corpus/gh-55-encoding-second.pod
+corpus/gh-55-no-encoding.pod
 corpus/gh-56-1.pod
 corpus/Header.pm
 corpus/mandoc/Perldoc.man
@@ -35,3 +39,4 @@ t/02_url_pod_output.t
 t/lib/TestUtils.pm
 t/man/_get_columns.t
 t/pod.t
+util/perldoc-bug

MANIFEST.SKIP

@@ -18,5 +18,9 @@ MYMETA*
 \.old$
 \.github/
 
+#
+corpus/perl(?:func|op|var)/
+xt/
+
 # This doesn't test anything, but maybe I'm wrong
 t/01_about_verbose.t

xt/99_corpus.t

@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+foreach my $tuple ( make_tuples() ) {
+	my( $source_file, $expected_file, $translator ) = $tuple->@*;
+	}
+
+
+sub get_sources {
+
+	}
+
+sub get_outputs {
+
+	}
+
+sub make_tuples {
+
+	}

xt/corpus-util.pl

@@ -0,0 +1,187 @@
+#!perl
+use v5.36;
+use utf8;
+use experimental qw(signatures);
+use open qw(:std :utf8);
+
+use Config qw(%Config);
+use File::Basename;
+use File::Path qw(make_path);
+use File::Spec::Functions qw(catfile);
+use Text::Diff;
+
+$|++;
+
+my $reference_perldoc;
+
+run(@ARGV) unless caller;
+
+sub run (@args) {
+	state $dispatch = {
+		got      => sub { got(@_) },
+		expected => sub { expected(@_) },
+		compare  => sub { compare() },
+		help     => sub { help() },
+		};
+
+	my $mode = shift @args;
+	$mode //= 'help';
+
+	$reference_perldoc = $args[0] // 'perldoc';
+
+	die join "\n\t", "Unknown mode <$mode>. Expected one of:\n",
+		sort keys $dispatch->%* unless exists $dispatch->{$mode};
+
+	$dispatch->{$mode}->(@args)
+	}
+
+sub compare {
+	state $mode = 'compare';
+	my_chdir();
+
+	foreach my $name ( get_names() ) {
+		my $expected_glob = catfile 'expected', $name, '*';
+		my @expected_files = glob $expected_glob;
+
+		foreach my $expected_file ( @expected_files ) {
+			my $got_file = $expected_file =~ s/\Aexpected/got/r;
+			compare_files( $got_file, $expected_file );
+			}
+		}
+	}
+
+sub compare_files ($got_file, $expected_file) {
+	state $rc = require Text::Diff;
+	state $r2 = require Term::ANSIColor;
+	state $r3 = require Encode;
+
+	my $ok = Term::ANSIColor::colored(['green'], "✔");
+	my $not_ok = Term::ANSIColor::colored(['red'], "✘✘✘");
+
+	if( ! -e $expected_file ) {
+	 	say "$not_ok expected file <$expected_file> is missing";
+		return;
+		}
+	elsif( ! -e $got_file ) {
+		say "$not_ok got file <$got_file> is missing";
+		return;
+		}
+	else {
+		my $diff = Encode::decode(
+			'UTF-8',
+			Text::Diff::diff $got_file, $expected_file
+			);
+		my $status = length $diff ? $not_ok : $ok;
+		printf "$status %s => %s\n", $got_file, $expected_file;
+		if( length $diff ) {
+			say $diff =~ s/^/    /gmr;
+			}
+		}
+	}
+
+sub expected {
+	state $mode = 'expected';
+	my_chdir();
+
+	reference_perldoc();
+
+	foreach my $name ( get_names() ) {
+		make_path catfile( $mode, $name );
+		convert_files( $name, $mode );
+		}
+	}
+
+sub got {
+	state $mode = 'got';
+	my_chdir();
+
+	$reference_perldoc = '../perldoc';
+	$ENV{PERL5LIB} = '../lib';
+
+	reference_perldoc();
+
+	foreach my $name ( get_names() ) {
+		make_path catfile( $mode, $name );
+		convert_files( $name, $mode );
+		}
+	}
+
+sub help {
+	require Pod::Usage;
+	Pod::Usage::pod2usage();
+	}
+
+sub convert_files {
+	state @corpus = get_corpus();
+	my( $name, $mode ) = @_;
+
+	CORPUS: foreach my $original ( @corpus ) {
+		my $output_file = basename($original) =~ s/\.pod\z/\.$name/r;
+		my $output_path = catfile $mode, $name, $output_file;
+
+		say STDERR "$original -> $output_path";
+
+		my $output = `$^X $reference_perldoc -o $name $original`;
+		open my $fh, '>:raw', $output_path or do {
+			say STDERR "Could not open $output_path: $!";
+			next CORPUS;
+			};
+		print {$fh} $output;
+		close $fh;
+		}
+	}
+
+sub get_corpus {
+	glob 'corpus/*.pod corpus/**/*.pod'
+	}
+
+sub get_names {
+	map { basename($_) } glob "expected/*";
+	}
+
+sub my_chdir {
+	require FindBin;
+	chdir $FindBin::Bin or die "Could not change to <$FindBin::Bin>: $!";
+	}
+
+sub reference_perldoc {
+	print "Reference perldoc:\n\t";
+	system {$reference_perldoc} $reference_perldoc, '-V';
+	print "\n";
+	}
+
+=encoding utf8
+
+=head1 NAME
+
+corpus-util.pl -
+
+=head1 SYNOPSIS
+
+Output the docs:
+
+	% corpus-util.pl help
+
+Recreate the expected output using the first perldoc in the path:
+
+	% corpus-util.pl expected
+
+Recreate the expected output using the specified perldoc:
+
+	% corpus-util.pl expected /full/path/to/reference/perldoc
+
+Recreate the expected output using the specified perldoc and perl:
+
+	% corpus-util.pl expected /full/path/to/reference/perldoc
+
+Generate the output using the repo perldoc
+
+	% corpus-util.pl got
+
+Compare the stuff generated by C<got> to the stuff generated by C<expected>
+
+	% corpus-util.pl compare
+
+=head1 DESCRIPTION
+
+=cut

xt/corpus/fetch_pages.pl

@@ -0,0 +1,61 @@
+#!perl
+use v5.26;
+
+=head1 NAME
+
+fetch-pages.pl - grab particular perl documentation pages
+
+=head1 SYNOPSIS
+
+	% perl fetch_pages.pl
+	5.40.0    perlfunc/perlfunc-5.40.0.pod    https://fastapi.metacpan.org/source/5.40.0/pod/perlfunc.pod
+	5.40.0    perlop/perlop-5.40.0.pod    https://fastapi.metacpan.org/source/5.40.0/pod/perlop.pod
+	5.40.0    perlvar/perlvar-5.40.0.pod    https://fastapi.metacpan.org/source/5.40.0/pod/perlvar.pod
+
+=head1 DESCRIPTION
+
+To ensure that Pod::Perldoc works for all the docs, we grab the historical
+versions of docs to test against. Other tests can then use these pages.
+
+This program requires Mojolicious,
+
+	% cpan Mojolicious
+
+=cut
+
+use File::Path qw(make_path);
+
+my @sections = qw(func op var);
+
+make_path( $_ ) for( map { "perl$_" } @sections );
+
+use Mojo::UserAgent;
+
+my $ua = Mojo::UserAgent->new;
+
+my $tx = $ua->get( 'https://metacpan.org/dist/perl/view/pod/perl.pod' );
+
+my $version_pattern = qr/5\.\d*[02468]\.\d+/;
+
+my $versions = $tx
+    ->res
+    ->dom
+    ->at( 'select' )
+    ->find( 'option' )
+    ->map( attr => 'value' )
+    ->grep( qr/$version_pattern/ )
+    ->map( sub { m/($version_pattern)/ && $1 } )
+    ;
+
+foreach my $version ( $versions->to_array->@* ) {
+    state $base = 'https://fastapi.metacpan.org/source/%s/pod/perl%s.pod';
+
+    foreach my $page ( @sections ) {
+        my $url = sprintf $base, $version, $page;
+        my $file = sprintf 'perl%s/perl%s-%s.pod', $page, $page, $version;
+        next if -e $file;
+        say join "    ", $version, $file, $url;
+        $ua->get( $url )->result->save_to( $file );
+        }
+    }
+

xt/corpus/gh-55-encoding-first.pod

@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+1;
+
+=encoding utf8
+
+=pod
+
+=head1 blahblah
+
+Blah blah blah.  The following forumula should not be folded:
+S< a + b + c + d + e + f + g + h + i >
+but it is.
+
+=cut

xt/corpus/gh-55-encoding-second.pod

@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+1;
+
+=pod
+
+=encoding utf8
+
+=head1 blahblah
+
+Blah blah blah.  The following forumula should not be folded:
+S< a + b + c + d + e + f + g + h + i >
+but it is.
+
+=cut

xt/corpus/gh-55-no-encoding.pod

@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+1;
+
+=pod
+
+=encoding utf8
+
+=head1 blahblah
+
+Blah blah blah.  The following forumula should not be folded:
+S< a +     b +     c +     d +     e +     f +     g +     h +     i >
+but it is.
+
+=cut

xt/corpus/gh-56-1.pod

@@ -0,0 +1,14 @@
+=pod
+
+=head1 Test Heading
+
+This paragraph has a B<very long
+very long very long very long very long very long very long very long
+very long very long very long very long very long very long very long
+very long very long very long very long very long very long very long
+very long very long very long very long very long very long very long
+very long very long very long very long very long very long very long
+very long very long very long very long very long very long very long
+very long bold string which should stop here> and continue in normal text.
+
+=cut

xt/corpus/mandoc/Perldoc.man

@@ -0,0 +1,34 @@
+Pod::Perldoc(3)       User Contributed Perl Documentation      Pod::Perldoc(3)
+
+
+NNAAMMEE
+       Pod::Perldoc - Look up Perl documentation in Pod format.
+
+SSYYNNOOPPSSIISS
+           use Pod::Perldoc ();
+
+           Pod::Perldoc->run();
+
+DDEESSCCRRIIPPTTIIOONN
+       The guts of perldoc utility.
+
+SSEEEE AALLSSOO
+       perldoc
+
+CCOOPPYYRRIIGGHHTT AANNDD DDIISSCCLLAAIIMMEERRSS
+       Copyright (c) 2002-2007 Sean M. Burke.
+
+       This library is free software; you can redistribute it and/or modify it
+       under the same terms as Perl itself.
+
+       This program is distributed in the hope that it will be useful, but
+       without any warranty; without even the implied warranty of
+       merchantability or fitness for a particular purpose.
+
+AAUUTTHHOORR
+       Current maintainer: Mark Allen "<mallen@cpan.org>"
+
+       Past contributions from: brian d foy "<bdfoy@cpan.org>" Adriano R.
+       Ferreira "<ferreira@cpan.org>", Sean M. Burke "<sburke@cpan.org>"
+
+perl v5.38.2                      2023-12-07                   Pod::Perldoc(3)