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.
Dual-Life · Oct 5, 2020 · 9bc8cea · 9bc8cea
1 parent a11ba16
commit 9bc8cea
Show file tree

Hide file tree

Showing 6 changed files with 95 additions and 31 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 = <TEST_IN>;
-    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