From 9bc8ceaf902621519bff2d02f9608bed79eda7ab Mon Sep 17 00:00:00 2001 From: Nicolas R Date: Mon, 5 Oct 2020 15:54:45 -0600 Subject: [PATCH] Avoid wait forever from t/pod/pod2usage2.t Fixes #10 We need to be sure to use the last version of several Pod modules in order to avoid issues. Also note that perldoc is by default not available on ubuntu containers and points to a fake binary. This is adding an extra workflow to check the two scenario. This is also fixing a warning from the windows workflow. --- .github/workflows/testsuite.yml | 37 ++++++++++++++- META.json | 2 + Makefile.PL | 4 ++ cpanfile | 2 + t/00-report-prereqs.dd | 2 + t/pod/pod2usage2.t | 79 ++++++++++++++++++++------------- 6 files changed, 95 insertions(+), 31 deletions(-) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 5de0c54..4a28694 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -18,6 +18,41 @@ jobs: runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - name: install perl-doc + run: | + sudo apt-get clean + sudo apt-get install -y perl-doc perl-doc-html + - name: perl -V + run: perl -V + - name: Install dependencies + uses: perl-actions/install-with-cpm@v1 + with: + cpanfile: "cpanfile" + - run: perl Makefile.PL + - run: make + - run: make test + - name: remove pod2usage + run: | + POD=$(which pod2usage) + echo "pod2usage: $POD" + sudo rm -f $POD ||: + - run: sudo make install + - run: which pod2usage + + # ------------------------------------------------------------------------ + + no-perl-doc: + needs: [ubuntu] + env: + PERL_USE_UNSAFE_INC: 0 + AUTHOR_TESTING: 1 + AUTOMATED_TESTING: 1 + RELEASE_TESTING: 1 + + runs-on: ubuntu-latest + steps: - uses: actions/checkout@v2 - name: perl -V @@ -111,7 +146,7 @@ jobs: - name: Set up Perl run: | choco install strawberryperl - echo "##[add-path]C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin" + echo "C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin" >> $GITHUB_PATH - name: perl -V run: perl -V - name: Install dependencies diff --git a/META.json b/META.json index 7042cf0..32b223c 100644 --- a/META.json +++ b/META.json @@ -53,6 +53,8 @@ "Cwd" : "0", "File::Basename" : "0", "File::Spec" : "0.82", + "Pod::Perldoc" : "3.28", + "Pod::Simple" : "3.40", "Pod::Text" : "4.00", "perl" : "5.006" } diff --git a/Makefile.PL b/Makefile.PL index 800c626..fcda832 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -20,6 +20,8 @@ my %WriteMakefileArgs = ( "Cwd" => 0, "File::Basename" => 0, "File::Spec" => "0.82", + "Pod::Perldoc" => "3.28", + "Pod::Simple" => "3.40", "Pod::Text" => "4.00" }, "TEST_REQUIRES" => { @@ -47,6 +49,8 @@ my %FallbackPrereqs = ( "ExtUtils::MakeMaker" => 0, "File::Basename" => 0, "File::Spec" => "0.82", + "Pod::Perldoc" => "3.28", + "Pod::Simple" => "3.40", "Pod::Text" => "4.00", "Test::More" => "0.60", "blib" => 0 diff --git a/cpanfile b/cpanfile index bfee93b..8560ae9 100644 --- a/cpanfile +++ b/cpanfile @@ -3,6 +3,8 @@ use warnings; on 'runtime' => sub { requires 'Pod::Text' => '4.00'; # to avoid issues with wrong test results + requires 'Pod::Simple' => '3.40'; # to avoid issues with wrong test results + requires 'Pod::Perldoc' => '3.28'; # to avoid issues with wrong test results requires 'Cwd'; requires 'File::Basename'; requires 'File::Spec' => '0.82'; diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd index 1771d00..e7f60af 100644 --- a/t/00-report-prereqs.dd +++ b/t/00-report-prereqs.dd @@ -28,6 +28,8 @@ do { my $x = { 'Cwd' => '0', 'File::Basename' => '0', 'File::Spec' => '0.82', + 'Pod::Perldoc' => '3.28', + 'Pod::Simple' => '3.40', 'Pod::Text' => '4.00', 'perl' => '5.006' } diff --git a/t/pod/pod2usage2.t b/t/pod/pod2usage2.t index ad35f84..8616422 100644 --- a/t/pod/pod2usage2.t +++ b/t/pod/pod2usage2.t @@ -19,24 +19,32 @@ BEGIN { sub getoutput { my ($code) = @_; - my $pid = open(TEST_IN, "-|"); - unless(defined $pid) { - die "Cannot fork: $!"; - } - if($pid) { + my $pid = open(my $in, "-|"); + die "Cannot fork: $!" unless defined $pid; + if ($pid) { # parent - my @out = ; - close(TEST_IN); + my @out = <$in>; + close($in); + my $exit = $?>>8; s/^/#/ for @out; + local $" = ""; + print "#EXIT=$exit OUTPUT=+++#@out#+++\n"; - return($exit, join("",@out)); + waitpid( $pid, 1 ); + + return ($exit, join("", @out) ); } # child - open(STDERR, ">&STDOUT"); + open (STDERR, ">&STDOUT"); + Test::More->builder->no_ending(1); - &$code; + local $SIG{ALRM} = sub { die "Alarm reached" }; + alarm(600); + + # this could hang + $code->(); print "--NORMAL-RETURN--\n"; exit 0; } @@ -72,17 +80,17 @@ ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbos #You naughty person, what did you say? # Usage: # frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# +# # Options: # -r | --recursive # Run recursively. -# +# # -f | --force # Just do it! -# +# # -n number # Specify number of frobs, default is 42. -# +# EOT ($exit, $text) = getoutput( sub { pod2usage( @@ -217,7 +225,7 @@ is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99") ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n"; #Usage: # This is a test for CPAN#33020 -# +# EOT # test with self @@ -241,13 +249,13 @@ ok (compare ($text, <<'EOT'), "Output test pod2usage with self") or diag "Got:\n # pod2usage($exit_status); # # pod2usage( { -message => $message_text , -# -exitval => $exit_status , -# -verbose => $verbose_level, +# -exitval => $exit_status , +# -verbose => $verbose_level, # -output => $filehandle } ); # # pod2usage( -msg => $message_text , -# -exitval => $exit_status , -# -verbose => $verbose_level, +# -exitval => $exit_status , +# -verbose => $verbose_level, # -output => $filehandle ); # # pod2usage( -verbose => 2, @@ -352,19 +360,30 @@ like ($text, qr/frobnicate - do what I mean/, "Output test pod2usage with relati { no warnings; *Pod::Usage::initialize = sub { 1; }; } -($exit, $text) = getoutput( sub { - my $devnull = File::Spec->devnull(); - open(SAVE_STDOUT, '>&', \*STDOUT); - open(STDOUT, '>', $devnull); - pod2usage({ -verbose => 2, -input => $0, -output => \*STDOUT, -exit => 0, -message => 'Special perldoc case', -perldocopt => '-i' }); - open(STDOUT, '>&', \*SAVE_STDOUT); - } ); -is ($exit, 0, "Exit status pod2usage with special perldoc case"); -# output went to devnull -like ($text, qr/^\s*$/s, "Output test pod2usage with special perldoc case") or diag "Got:\n$text\n"; + +SKIP: { + my $perldoc = $^X . 'doc'; + skip "Missing perldoc binary", 2 unless -x $perldoc; + + my $out = qx[$perldoc 2>&1] || ''; + skip "Need perl-doc package", 2 if $out =~ qr[You need to install the perl-doc package to use this program]; + + ($exit, $text) = getoutput( sub { + require Pod::Perldoc; + my $devnull = File::Spec->devnull(); + open(SAVE_STDOUT, '>&', \*STDOUT); + open(STDOUT, '>', $devnull); + pod2usage({ -verbose => 2, -input => $0, -output => \*STDOUT, -exit => 0, -message => 'Special perldoc case', -perldocopt => '-i' }); + open(STDOUT, '>&', \*SAVE_STDOUT); + } ); + is ($exit, 0, "Exit status pod2usage with special perldoc case"); + # output went to devnull + like ($text, qr/^\s*$/s, "Output test pod2usage with special perldoc case") or diag "Got:\n$text\n"; + +} # bad regexp syntax -($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION{BLAH') } ); +($exit, $text) = getoutput( sub { pod2usage( -verbose => 99, -sections => 'DESCRIPTION{BLAH') } ); like ($text, qr/Bad regular expression/, "Output test pod2usage with bad section regexp"); } # end SKIP