>From 198be1d4be1e634fbcc6dd744f25ef00f42f260a Mon Sep 17 00:00:00 2001
Message-Id: <address@hidden>
From: Stefano Lattarini <address@hidden>
Date: Thu, 2 Feb 2012 14:51:59 +0100
Subject: [PATCH] tap/perl: handle missing or non-executable scripts better

This change improves how our Perl-based TAP driver handles
non-runnable test scripts (meaning they might be not executable,
or not readable, or even not exist).  In particular, it makes the
driver deterministically display a clear "ERROR" result instead
of possibly dying with diagnostic from 'TAP::Parser' internals,
and prevents it from displaying spurious "missing TAP plan" errors.

Moreover, with this change, some testsuite failures present only
with newer perl versions (e.g., 5.14) are fixed.  See automake
bug#10418.

* tests/tap-bad-prog.tap: When testing the perl implementation of
the TAP driver, and when the perl interpreter offers a good-enough
'IPC::Open3::open3' function, expect it not to display spurious
"missing TAP plan" diagnostic if the error is actually due to a
non-runnable test script.
* lib/tap-driver.pl (start): Removed, broken up into ...
(setup_io): ... this ...
(setup_parser): ... and this, which now tries to catch and report
errors in launching the test scripts.
(finish): New, used by both 'main' and 'setup_parser'.
(main): Adjust.
---
 lib/tap-driver.pl      |   39 ++++++++++++++++++++++++++++++---------
 tests/tap-bad-prog.tap |   33 ++++++++++++++++++++++++++++++---
 2 files changed, 60 insertions(+), 12 deletions(-)

diff --git a/lib/tap-driver.pl b/lib/tap-driver.pl
index b6566ad..77d3b95 100755
--- a/lib/tap-driver.pl
+++ b/lib/tap-driver.pl
@@ -1,5 +1,5 @@
 #! /usr/bin/env perl
-# Copyright (C) 2011 Free Software Foundation, Inc.
+# Copyright (C) 2011, 2012 Free Software Foundation, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -32,7 +32,7 @@ use strict;
 use Getopt::Long ();
 use TAP::Parser;
 
-my $VERSION = '2011-09-07.15'; # UTC
+my $VERSION = '2012-02-01.18'; # UTC
 
 my $ME = "tap-driver.pl";
 
@@ -122,6 +122,7 @@ sub colored ($$);
 sub copy_in_global_log ();
 sub decorate_result ($);
 sub extract_tap_comment ($);
+sub finish ();
 sub get_global_test_result ();
 sub get_test_exit_message ();
 sub get_test_results ();
@@ -132,7 +133,8 @@ sub is_null_string ($);
 sub main (@);
 sub must_recheck ();
 sub report ($;$);
-sub start (@);
+sub setup_io ();
+sub setup_parser (@);
 sub stringify_result_obj ($);
 sub testsuite_error ($);
 sub trap_perl_warnings_and_errors ();
@@ -244,7 +246,7 @@ sub trap_perl_warnings_and_errors ()
     }
 }
 
-sub start (@)
+sub setup_io ()
 {
   # Redirect stderr and stdout to a temporary log file.  Save the
   # original stdout stream, since we need it to print testsuite
@@ -257,7 +259,20 @@ sub start (@)
   trap_perl_warnings_and_errors;
   open STDOUT, ">&LOG" or die "$ME: redirecting stdout: $!\n";
   open STDERR, ">&LOG" or die "$ME: redirecting stderr: $!\n";
-  $parser = TAP::Parser->new ({ exec => address@hidden, merge => $cfg{merge} });
+}
+
+sub setup_parser (@)
+{
+  local $@ = '';
+  eval { $parser = TAP::Parser->new ({exec => address@hidden, merge => $cfg{merge}}) };
+  if ($@ ne '')
+    {
+      # Don't use the error message in $@ as set by TAP::Parser, since
+      # currently it's both too generic (at the point of being basically
+      # useless) and quite long.
+      report "ERROR", "- couldn't execute test script";
+      finish;
+    }
 }
 
 sub get_test_exit_message ()
@@ -460,9 +475,17 @@ sub extract_tap_comment ($)
   return "";
 }
 
+sub finish ()
+{
+  write_test_results;
+  close LOG or die "$ME: closing $log_file: $!\n";
+  exit 0;
+}
+
 sub main (@)
 {
-  start @_;
+  setup_io;
+  setup_parser @_;
 
   while (defined (my $cur = $parser->next))
     {
@@ -510,9 +533,7 @@ sub main (@)
           testsuite_error $msg if $msg;
         }
     }
-  write_test_results;
-  close LOG or die "$ME: closing $log_file: $!\n";
-  exit 0;
+  finish;
 }
 
 # ----------- #
diff --git a/tests/tap-bad-prog.tap b/tests/tap-bad-prog.tap
index 212633f..eec6a26 100755
--- a/tests/tap-bad-prog.tap
+++ b/tests/tap-bad-prog.tap
@@ -23,7 +23,7 @@ am_parallel_tests=yes
 
 fetch_tap_driver
 
-plan_ 5
+plan_ 6
 
 cat >> configure.in <<END
 AC_OUTPUT
@@ -79,8 +79,35 @@ else
 fi
 
 # Check that no spurious test results is reported.  This is lower-priority
-# (and in fact the check currently fails.
-command_ok_ 'no spurious results' -D TODO -r 'still get "missing plan"' \
+# (and in fact the check currently fails for our awk-based driver).
+directive=
+if test $am_tap_implementation = shell; then
+  directive=TODO
+else
+  # Older versions of IPC::Open3 (e.g., version 1.05 on perl 5.12.4 or
+  # version 1.0103 on perl 5.6.2) fails to properly trap errors in exec(2)
+  # calls in the child process; hence, the TAP driver cannot be properly
+  # informed of such error.
+  if $PERL -w -e '
+    use IPC::Open3 qw/open3/;
+    $@ = "";
+    eval { open3(*STDIN, *STDOUT, *STDERR, "am--no-such-command") };
+    $@ =~ m/\bopen3:.*am--no-such-command/
+      or die "Bad \$@ value: \"address@hidden"\n";
+  '; then
+    : # OK. IPC::Open3 should be good enough.
+  else
+    for s in '"missing plan" message' 'results'; do
+      skip_ -r "IPC::Open3 not good enough" "no spurious $s"
+    done
+    Exit 0
+  fi
+fi
+
+command_ok_ 'no spurious "missing plan" message' \
+    -D "$directive" -- not grep 'missing.* plan' stdout
+command_ok_ 'no spurious results' \
+  -D "$directive" -r 'still get "missing plan"' \
   count_test_results total=3 pass=0 fail=0 xpass=0 xfail=0 skip=0 error=3
 
 :
-- 
1.7.7.3