In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7932398d3c914f9efb997b9a2fde8ae76772602a?hp=977193dd5da782ebbd7faad9466da2a28ea053f4>
- Log ----------------------------------------------------------------- commit 7932398d3c914f9efb997b9a2fde8ae76772602a Merge: 977193d 4173236 Author: Nicholas Clark <[email protected]> Date: Mon Jul 22 10:09:50 2013 +0200 Merge the work which improves test diagnostics from run_multiple_progs(). commit 417323690fc1ca1b91829e3eb41b21b7874a7dba 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 f03aef051fa2e50249e8ba218234325ac3eed89b 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 9f5237acc201488cbde2c3630d8f4ad8d8d5cb3f 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 fdb35a6344fc7c623305e4e675f396e98a1b900e 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 375f99fd797c34dd5b50e63b857aac456a8b276d 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 f9b950a22dcff51aab6668aa7e5d67e5d8566495 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
