In perl.git, the branch smoke-me/nicholas/run_multiple_progs has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/e1fc6a2e4ca24225b875bdcbc85c4d5a0f279640?hp=6d4a229953c4bfc47ffb730b8f1449f9a0a2a70e> - Log ----------------------------------------------------------------- commit e1fc6a2e4ca24225b875bdcbc85c4d5a0f279640 Author: Nicholas Clark <[email protected]> Date: Mon Jul 15 11:27:22 2013 +0200 Report useful file names and line numbers from run_multiple_progs(). Previously if tests in run_multiple_progs() failed the report gave the file name and line number of the ok() call in run_multiple_progs(). Now, where possible, report the file and line of the actual test program. If this information isn't available, report the error at the file and line which called run_multiple_progs(). This will improve error reporting from lib/charnames.t, lib/feature.t, lib/strict.t, lib/subs.t, lib/warnings.t and t/lib/croak.t M t/test.pl commit 7b58a969df4817e9112697654621d5a75f0dad79 Author: Nicholas Clark <[email protected]> Date: Mon Jul 15 11:13:48 2013 +0200 Remove a duplicate test separator "########\n" line from the pp_sys tests. The existing parser using split includes the second "########\n" as part of the extracted test program, which the Perl interpreter treats as a comment line. The parser refactoring in the next commit no longer adds the line to the extracted test program, causing the line numbers for the warnings to differ by one. The extra "########\n" was added as part of commit c521cf7c8af1697e in Dec 2010, along with the test program which follows it, and the (now) incorrect line number expectations. M t/lib/warnings/pp_sys commit 5c54c12062713e20a21d142cc4a694dd9de25f2d Author: Nicholas Clark <[email protected]> Date: Sun Jul 14 20:44:50 2013 +0200 Merge the file parsing code for run_multiple_progs() into _setup_one_file(). setup_multiple_progs() calls _setup_one_file() to parse each file in turn, and run_multiple_progs() calls it once if passed a file handle. M t/test.pl commit c868df68411cfbaa774b3cd9b35f234165ddd93e Author: Nicholas Clark <[email protected]> Date: Sun Jul 14 18:58:58 2013 +0200 Move file parsing code from t/lib/common.pl to t/test.pl Move the code that prepares input to run_multiple_progs() by parsing files into a subroutine setup_multiple_progs(). This will enable the parsing code in run_multiple_progs() to be merged, and the combined code to be altered to give improved diagnostics on test failure. M t/lib/common.pl M t/test.pl commit 46bbe6ebdaf0307d0d9c21ba5909bde4d34da62c Author: Nicholas Clark <[email protected]> Date: Sun Jul 14 17:29:59 2013 +0200 Refactor the setup code in t/lib/common.pl Eliminate the variable $line which has never been used. (The code was added by commit bd4dea8e97f4a8f5 in June 2001.) Use a non-capturing group in a regex. Check the return value of close and die if there is an error. Explicitly count the tests found. Avoid indirect object syntax for a method call. M t/lib/common.pl commit 07772745b13a4781dc7e05a98fa598bf0372ca09 Author: Nicholas Clark <[email protected]> Date: Mon Jul 15 09:48:02 2013 +0200 lib/warnings.t should actually run the test in t/lib/warnings/doop The file containing a single test for a warning in doop.c was added by commit 0453d815b8a74697 in June 1999. However, as the file does not contain an __END__ marker, the parser skips the entire contents of the file looking for the __END__, and then assumes that the file contains no tests. This has been true since the parser code was first implemented (in t/pragma/warning.t) in commit 8ebc5c0145d2e355 in Jan 1997. The simplest fix is to add an __END__ to the start of t/lib/warnings/doop Also add some sanity checking to ensure that this doesn't happen again. M t/lib/common.pl M t/lib/warnings/doop ----------------------------------------------------------------------- Summary of changes: t/lib/common.pl | 48 ++++++++----------------- t/lib/warnings/doop | 1 + t/lib/warnings/pp_sys | 5 ++- t/test.pl | 98 ++++++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 107 insertions(+), 45 deletions(-) diff --git a/t/lib/common.pl b/t/lib/common.pl index beb59a0..4ab00b1 100644 --- a/t/lib/common.pl +++ b/t/lib/common.pl @@ -21,38 +21,17 @@ my ($pragma_name) = $file =~ /([A-Za-z_0-9]+)\.t$/ $| = 1; -my @prgs = () ; -my @w_files = () ; +my @w_files; -if (@ARGV) - { print "ARGV = [@ARGV]\n" ; - @w_files = map { s#^#./lib/$pragma_name/#; $_ } @ARGV - } -else - { @w_files = sort glob(catfile(curdir(), "lib", $pragma_name, "*")) } - -my $files = 0; -foreach my $file (@w_files) { - - next if $file =~ /(~|\.orig|,v)$/; - next if $file =~ /perlio$/ && !(find PerlIO::Layer 'perlio'); - next if -d $file; - - open my $fh, '<', $file or die "Cannot open $file: $!\n" ; - my $line = 0; - while (<$fh>) { - $line++; - last if /^__END__/ ; - } - - { - local $/ = undef; - $files++; - @prgs = (@prgs, $file, split "\n########\n", <$fh>) ; - } - close $fh; +if (@ARGV) { + print "ARGV = [@ARGV]\n"; + @w_files = map { "./lib/$pragma_name/$_" } @ARGV; +} else { + @w_files = sort glob catfile(curdir(), "lib", $pragma_name, "*"); } +my ($tests, @prgs) = setup_multiple_progs(@w_files); + $^X = rel2abs($^X); @INC = map { rel2abs($_) } @INC; my $tempdir = tempfile; @@ -68,11 +47,12 @@ END { } } -local $/ = undef; - -my $tests = $::local_tests || 0; -$tests = scalar(@prgs)-$files + $tests if $tests !~ /\D/; -plan $tests; # If input is 'no_plan', pass it on unchanged +if ($::local_tests && $::local_tests =~ /\D/) { + # If input is 'no_plan', pass it on unchanged + plan $::local_tests; +} else { + plan $tests + ($::local_tests || 0); +} run_multiple_progs('../..', @prgs); diff --git a/t/lib/warnings/doop b/t/lib/warnings/doop index 5803b44..74c3e90 100644 --- a/t/lib/warnings/doop +++ b/t/lib/warnings/doop @@ -1,3 +1,4 @@ +__END__ # doop.c use utf8 ; $_ = "\x80 \xff" ; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index f0a5627..2e81916 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -154,7 +154,6 @@ write() on closed filehandle STDIN at - line 8. write() on closed filehandle STDIN at - line 11. (Are you trying to call write() on dirhandle STDIN?) ######## -######## # pp_sys.c [pp_leavewrite] use warnings 'unopened'; format STDIN = @@ -178,8 +177,8 @@ opendir FOO, "."; write STDIN; write FOO; EXPECT -write() on unopened filehandle FOO at - line 10. -write() on unopened filehandle FOO at - line 15. +write() on unopened filehandle FOO at - line 9. +write() on unopened filehandle FOO at - line 14. (Are you trying to call write() on dirhandle FOO?) ######## # pp_sys.c [pp_leavewrite] diff --git a/t/test.pl b/t/test.pl index e141b91..41efbb8 100644 --- a/t/test.pl +++ b/t/test.pl @@ -969,6 +969,68 @@ sub fresh_perl_like { # If the global variable $FATAL is true then OPTION fatal is the # default. +sub _setup_one_file { + my $fh = shift; + # Store the filename as a program that started at line 0. + # Real files count lines starting at line 1. + my @these = (0, shift); + my ($lineno, $current); + while (<$fh>) { + if ($_ eq "########\n") { + if (defined $current) { + push @these, $lineno, $current; + } + undef $current; + } else { + if (!defined $current) { + $lineno = $.; + } + $current .= $_; + } + } + if (defined $current) { + push @these, $lineno, $current; + } + ((scalar @these) / 2 - 1, @these); +} + +sub setup_multiple_progs { + my ($tests, @prgs); + foreach my $file (@_) { + next if $file =~ /(?:~|\.orig|,v)$/; + next if $file =~ /perlio$/ && !PerlIO::Layer->find('perlio'); + next if -d $file; + + open my $fh, '<', $file or die "Cannot open $file: $!\n" ; + my $found; + while (<$fh>) { + if (/^__END__/) { + ++$found; + last; + } + } + # This is an internal error, and should never happen. All bar one of + # the files had an __END__ marker to signal the end of their preamble, + # although for some it wasn't technically necessary as they have no + # tests. It might be possible to process files without an __END__ by + # seeking back to the start and treating the whole file as tests, but + # it's simpler and more reliable just to make the rule that all files + # must have __END__ in. This should never fail - a file without an + # __END__ should not have been checked in, because the regression tests + # would not have passed. + die "Could not find '__END__' in $file" + unless $found; + + my ($t, @p) = _setup_one_file($fh, $file); + $tests += $t; + push @prgs, @p; + + close $fh + or die "Cannot close $file: $!\n"; + } + return ($tests, @prgs); +} + sub run_multiple_progs { my $up = shift; my @prgs; @@ -977,18 +1039,31 @@ sub run_multiple_progs { # pass in a list of "programs" to run @prgs = @_; } else { - # The tests below t run in t and pass in a file handle. - my $fh = shift; - local $/; - @prgs = split "\n########\n", <$fh>; + # The tests below t run in t and pass in a file handle. In theory we + # can pass (caller)[1] as the second argument to report errors with + # the filename of our caller, as the handle is always DATA. However, + # line numbers in DATA count from the __END__ token, so will be wrong. + # Which is more confusing than not providing line numbers. So, for now, + # don't provide line numbers. No obvious clean solution - one hack + # would be to seek DATA back to the start and read to the __END__ token, + # but that feels almost like we should just open $0 instead. + + # Not going to rely on undef in list assignment. + my $dummy; + ($dummy, @prgs) = _setup_one_file(shift); } my $tmpfile = tempfile(); + my ($file, $line); PROGRAM: - for (@prgs){ - unless (/\n/) { - print "# From $_\n"; + while (defined ($line = shift @prgs)) { + $_ = shift @prgs; + unless ($line) { + $file = $_; + if (defined $file) { + print "# From $file\n"; + } next; } my $switch = ""; @@ -1148,7 +1223,14 @@ sub run_multiple_progs { } } - ok($ok, $name); + if (defined $file) { + _ok($ok, "at $file line $line", $name); + } else { + # We don't have file and line number data for the test, so report + # errors as coming from our caller. + local $Level = $Level + 1; + ok($ok, $name); + } foreach (@temps) { unlink $_ if $_; -- Perl5 Master Repository
