diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2003-11-30 20:31:59 +0000 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2003-11-30 20:31:59 +0000 |
commit | e4fc8a1e010cc9cb02abe6e5d8d39a15decdcd55 (patch) | |
tree | 5876db4ca716cddd7393b89cb6fbf3964e5e2055 | |
parent | 767bb2e0924772d5c7f107cbef61877d1bc39810 (diff) | |
download | perl-e4fc8a1e010cc9cb02abe6e5d8d39a15decdcd55.tar.gz |
Upgrade to Test::Harness 2.38.
Introduce the prove(1) utility.
(The prove-switches test is disabled for now.)
p4raw-id: //depot/perl@21826
-rw-r--r-- | MANIFEST | 17 | ||||
-rwxr-xr-x | installperl | 7 | ||||
-rw-r--r-- | lib/Test/Harness.pm | 137 | ||||
-rw-r--r-- | lib/Test/Harness/Assert.pm | 12 | ||||
-rw-r--r-- | lib/Test/Harness/Changes | 154 | ||||
-rw-r--r-- | lib/Test/Harness/Iterator.pm | 2 | ||||
-rw-r--r-- | lib/Test/Harness/Straps.pm | 142 | ||||
-rw-r--r-- | lib/Test/Harness/bin/prove | 322 | ||||
-rw-r--r-- | lib/Test/Harness/t/00compile.t | 2 | ||||
-rw-r--r-- | lib/Test/Harness/t/assert.t | 2 | ||||
-rw-r--r-- | lib/Test/Harness/t/callback.t | 4 | ||||
-rw-r--r-- | lib/Test/Harness/t/inc_taint.t | 28 | ||||
-rw-r--r-- | lib/Test/Harness/t/pod.t | 29 | ||||
-rw-r--r-- | lib/Test/Harness/t/prove-switches.t | 63 | ||||
-rw-r--r-- | lib/Test/Harness/t/strap-analyze.t | 5 | ||||
-rw-r--r-- | lib/Test/Harness/t/strap.t | 14 | ||||
-rw-r--r-- | lib/Test/Harness/t/test-harness.t | 48 | ||||
-rw-r--r-- | t/lib/Dev/Null.pm | 17 | ||||
-rw-r--r-- | t/lib/sample-tests/inc_taint | 7 | ||||
-rw-r--r-- | t/lib/sample-tests/taint_warn | 11 | ||||
-rw-r--r-- | utils.lst | 1 | ||||
-rw-r--r-- | utils/Makefile | 8 | ||||
-rw-r--r-- | utils/prove.PL | 49 |
23 files changed, 935 insertions, 146 deletions
@@ -1591,13 +1591,16 @@ lib/Test/Harness/Changes Test::Harness lib/Test/Harness/Iterator.pm Test::Harness::Iterator (internal use only) lib/Test/Harness.pm A test harness lib/Test/Harness/Straps.pm Test::Harness::Straps +lib/Test/Harness/bin/prove The prove harness utility lib/Test/Harness/t/00compile.t Test::Harness test lib/Test/Harness/t/assert.t Test::Harness::Assert test lib/Test/Harness/t/base.t Test::Harness test lib/Test/Harness/t/callback.t Test::Harness test +lib/Test/Harness/t/inc_taint.t Test::Harness test lib/Test/Harness/t/nonumbers.t Test::Harness test lib/Test/Harness/t/ok.t Test::Harness test lib/Test/Harness/t/pod.t Test::Harness test +lib/Test/Harness/t/prove-switches.t Test::Harness::Straps test lib/Test/Harness/t/strap-analyze.t Test::Harness::Straps test lib/Test/Harness/t/strap.t Test::Harness::Straps test lib/Test/Harness/t/test-harness.t Test::Harness test @@ -2583,6 +2586,7 @@ t/japh/abigail.t Obscure tests t/lib/1_compile.t See if the various libraries and extensions compile t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t +t/lib/Dev/Null.pm Module for testing Test::Harness t/lib/Devel/switchd.pm Module for t/run/switchd.t t/lib/dprof/test1_t Perl code profiler tests t/lib/dprof/test1_v Perl code profiler tests @@ -2622,28 +2626,30 @@ t/lib/sample-tests/bailout Test data for Test::Harness t/lib/sample-tests/bignum Test data for Test::Harness t/lib/sample-tests/combined Test data for Test::Harness t/lib/sample-tests/descriptive Test data for Test::Harness -t/lib/sample-tests/die Test data for Test::Harness t/lib/sample-tests/die_head_end Test data for Test::Harness t/lib/sample-tests/die_last_minute Test data for Test::Harness +t/lib/sample-tests/die Test data for Test::Harness t/lib/sample-tests/duplicates Test data for Test::Harness t/lib/sample-tests/head_end Test data for Test::Harness t/lib/sample-tests/head_fail Test data for Test::Harness +t/lib/sample-tests/inc_taint Test data for Test::Harness t/lib/sample-tests/lone_not_bug Test data for Test::Harness t/lib/sample-tests/no_nums Test data for Test::Harness t/lib/sample-tests/no_output Test data for Test::Harness t/lib/sample-tests/out_of_order Test data for Test::Harness t/lib/sample-tests/segfault Test data for Test::Harness t/lib/sample-tests/shbang_misparse Test data for Test::Harness -t/lib/sample-tests/simple Test data for Test::Harness t/lib/sample-tests/simple_fail Test data for Test::Harness -t/lib/sample-tests/skip Test data for Test::Harness -t/lib/sample-tests/skipall Test data for Test::Harness +t/lib/sample-tests/simple Test data for Test::Harness t/lib/sample-tests/skipall_nomsg Test data for Test::Harness +t/lib/sample-tests/skipall Test data for Test::Harness t/lib/sample-tests/skip_nomsg Test data for Test::Harness +t/lib/sample-tests/skip Test data for Test::Harness t/lib/sample-tests/switches Test data for Test::Harness t/lib/sample-tests/taint Test data for Test::Harness -t/lib/sample-tests/todo Test data for Test::Harness +t/lib/sample-tests/taint_warn Test data for Test::Harness t/lib/sample-tests/todo_inline Test data for Test::Harness +t/lib/sample-tests/todo Test data for Test::Harness t/lib/sample-tests/too_many Test data for Test::Harness t/lib/sample-tests/vms_nit Test data for Test::Harness t/lib/sample-tests/with_comments Test data for Test::Harness @@ -2928,6 +2934,7 @@ utils/perldoc.PL A simple tool to find & display perl's documentation utils/perlivp.PL installation verification procedure utils/piconv.PL iconv(1), reinvented in perl utils/pl2pm.PL A pl to pm translator +utils/prove.PL The prove harness utility utils/splain.PL Stand-alone version of diagnostics.pm utils/xsubpp.PL External subroutine preprocessor uts/sprintf_wrap.c sprintf wrapper for UTS diff --git a/installperl b/installperl index bd10643b1e..455ab554ac 100755 --- a/installperl +++ b/installperl @@ -801,9 +801,10 @@ sub installlib { # .exists files, .PL files, and test files. return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$} || $dir =~ m{/t(?:/|$)}; - # ignore the cpan script in lib/CPAN/bin and the instmodsh and xsubpp - # scripts in lib/ExtUtils (they're installed later with other utils) - return if $name =~ /^(?:cpan|instmodsh|xsubpp)\z/; + # ignore the cpan script in lib/CPAN/bin, the instmodsh and xsubpp + # scripts in lib/ExtUtils, and the prove script in lib/Test/Harness + # (they're installed later with other utils) + return if $name =~ /^(?:cpan|instmodsh|xsubpp|prove)\z/; # ignore the Makefiles return if $name =~ /^makefile$/i; # ignore the test extensions diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 7fd48e6bdf..ee494711ca 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -1,5 +1,5 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Harness.pm,v 1.54 2003/08/15 01:05:00 andy Exp $ +# $Id: Harness.pm,v 1.76 2003/11/25 04:41:03 andy Exp $ package Test::Harness; @@ -11,19 +11,39 @@ use Benchmark; use Config; use strict; -use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest - $Columns $verbose $switches $ML $Strap - @ISA @EXPORT @EXPORT_OK $Last_ML_Print - ); +use vars qw( + $VERSION + @ISA @EXPORT @EXPORT_OK + $Verbose $Switches $Debug + $verbose $switches $debug + $Have_Devel_Corestack + $Curtest + $Columns + $ML $Last_ML_Print + $Strap +); + +=head1 NAME + +Test::Harness - Run Perl standard test scripts with statistics + +=head1 VERSION + +Version 2.38 + + $Header: /home/cvs/test-harness/lib/Test/Harness.pm,v 1.76 2003/11/25 04:41:03 andy Exp $ + +=cut + +$VERSION = '2.38'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; *switches = *Switches; +*debug = *Debug; $Have_Devel_Corestack = 0; -$VERSION = '2.30'; - $ENV{HARNESS_ACTIVE} = 1; END { @@ -45,15 +65,11 @@ $Strap = Test::Harness::Straps->new; @EXPORT_OK = qw($verbose $switches); $Verbose = $ENV{HARNESS_VERBOSE} || 0; +$Debug = $ENV{HARNESS_DEBUG} || 0; $Switches = "-w"; $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; $Columns--; # Some shells have trouble with a full line of text. - -=head1 NAME - -Test::Harness - run perl standard test scripts with statistics - =head1 SYNOPSIS use Test::Harness; @@ -163,13 +179,15 @@ emitted if the test script is skipped completely: =item B<Todo tests> -If the standard output line contains the substring C< # TODO> after +If the standard output line contains the substring C< # TODO > after C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text afterwards is the thing that has to be done before this test will succeed. not ok 13 # TODO harness the power of the atom +Note that the TODO must have a space after it. + =begin _deprecated Alternatively, you can specify a list of what tests are todo as part @@ -220,17 +238,15 @@ test script, please use a comment. =back - =head2 Taint mode -Test::Harness will honor the C<-T> in the #! line on your test files. So -if you begin a test with: +Test::Harness will honor the C<-T> or C<-t> in the #! line on your +test files. So if you begin a test with: #!perl -T the test will be run with taint mode on. - =head2 Configuration variables. These variables can be used to configure the behavior of @@ -238,24 +254,25 @@ Test::Harness. They are exported on request. =over 4 -=item B<$Test::Harness::verbose> +=item B<$Test::Harness::Verbose> -The global variable $Test::Harness::verbose is exportable and can be -used to let runtests() display the standard output of the script -without altering the behavior otherwise. +The global variable C<$Test::Harness::Verbose> is exportable and can be +used to let C<runtests()> display the standard output of the script +without altering the behavior otherwise. The F<prove> utility's C<-v> +flag will set this. =item B<$Test::Harness::switches> -The global variable $Test::Harness::switches is exportable and can be +The global variable C<$Test::Harness::switches> is exportable and can be used to set perl command line options used for running the test -script(s). The default value is C<-w>. +script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>. =back =head2 Failure -It will happen, your tests will fail. After you mop up your ego, you +It will happen: your tests will fail. After you mop up your ego, you can begin examining the summary report: t/base..............ok @@ -288,7 +305,7 @@ If the test exited with non-zero, this is its exit status. =item B<Wstat> -The wait status of the test I<umm, I need a better explanation here>. +The wait status of the test. =item B<Total> @@ -388,9 +405,9 @@ sub _globdir { my($total, $failed) = _run_all_tests(@test_files); -Runs all the given @test_files (as runtests()) but does it quietly (no -report). $total is a hash ref summary of all the tests run. Its keys -and values are this: +Runs all the given C<@test_files> (as C<runtests()>) but does it +quietly (no report). $total is a hash ref summary of all the tests +run. Its keys and values are this: bonus Number of individual todo tests unexpectedly passed max Number of individual tests ran @@ -404,8 +421,8 @@ and values are this: tests Number of test files originally given skipped Number of test files skipped -If $total->{bad} == 0 and $total->{max} > 0, you've got a successful -test. +If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've +got a successful test. $failed is a hash ref of all the test scripts which failed. Each key is the name of a test script, each value is another hash representing @@ -419,7 +436,7 @@ how that script failed. Its keys are these: percent Percentage of tests which failed canon List of tests which failed (as string). -Needless to say, $failed should be empty if everything passed. +C<$failed> should be empty if everything passed. B<NOTE> Currently this function is still noisy. I'm working on it. @@ -451,16 +468,21 @@ sub _run_all_tests { my $width = _leader_width(@tests); foreach my $tfile (@tests) { + if ( $Test::Harness::Debug ) { + print "# Running: ", $Strap->_command_line($tfile), "\n"; + } + $Last_ML_Print = 0; # so each test prints at least once my($leader, $ml) = _mk_leader($tfile, $width); local $ML = $ml; + print $leader; $tot{files}++; $Strap->{_seen_header} = 0; my %results = $Strap->analyze_file($tfile) or - do { warn "$Strap->{error}\n"; next }; + do { warn $Strap->{error}, "\n"; next }; # state of the current test. my @failed = grep { !$results{details}[$_-1]{ok} } @@ -587,12 +609,12 @@ sub _run_all_tests { my($leader, $ml) = _mk_leader($test_file, $width); -Generates the 't/foo........' $leader for the given $test_file as well +Generates the 't/foo........' $leader for the given C<$test_file> as well as a similar version which will overwrite the current line (by use of -\r and such). $ml may be empty if Test::Harness doesn't think you're +\r and such). C<$ml> may be empty if Test::Harness doesn't think you're on TTY. -The $width is the width of the "yada/blah.." string. +The C<$width> is the width of the "yada/blah.." string. =cut @@ -966,8 +988,7 @@ __END__ C<&runtests> is exported by Test::Harness by default. -C<$verbose> and C<$switches> are exported upon request. - +C<$verbose>, C<$switches> and C<$debug> are exported upon request. =head1 DIAGNOSTICS @@ -1027,6 +1048,13 @@ C<perlcc> before running it. B<NOTE> This currently only works when sitting in the perl source directory! +=item C<HARNESS_DEBUG> + +If true, Test::Harness will print debugging information about itself as +it runs the tests. This is different from C<HARNESS_VERBOSE>, which prints +the output from the test being run. Setting C<$Test::Harness::Debug> will +override this, or you can use the C<-d> switch in the F<prove> utility. + =item C<HARNESS_FILELEAK_IN_DIR> When set to the name of a directory, harness will check after each @@ -1052,9 +1080,17 @@ somewhat messy output). =item C<HARNESS_OK_SLOW> -If true, the C<ok> messages are printed out only every second. -This reduces output and therefore may for example help testing -over slow connections. +If true, the C<ok> messages are printed out only every second. This +reduces output and may help increase testing speed over slow +connections, or with very large numbers of tests. + +=item C<HARNESS_PERL> + +Usually your tests will be run by C<$^X>, the currently-executing Perl. +However, you may want to have it run by a different executable, such as +a threading perl, or a different version. + +If you're using the F<prove> utility, you can use the C<--perl> switch. =item C<HARNESS_PERL_SWITCHES> @@ -1065,7 +1101,8 @@ run all tests with all warnings enabled. =item C<HARNESS_VERBOSE> If true, Test::Harness will output the verbose results of running -its tests. Setting $Test::Harness::verbose will override this. +its tests. Setting C<$Test::Harness::verbose> will override this, +or you can use the C<-v> switch in the F<prove> utility. =back @@ -1165,4 +1202,22 @@ Clean up how the summary is printed. Get rid of those damned formats. HARNESS_COMPILE_TEST currently assumes it's run from the Perl source directory. +Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>. +You can also mail bugs, fixes and enhancements to +C<< <bug-test-harness@rt.cpan.org> >>. + +=head1 AUTHORS + +Original code by Michael G Schwern, maintained by Andy Lester. + +=head1 COPYRIGHT + +Copyright 2003 by Michael G Schwern C<< <schwern@pobox.com> >>, + Andy Lester C<< <andy@petdance.com> >>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L<http://www.perl.com/perl/misc/Artistic.html>. + =cut diff --git a/lib/Test/Harness/Assert.pm b/lib/Test/Harness/Assert.pm index 5321def403..09912bacad 100644 --- a/lib/Test/Harness/Assert.pm +++ b/lib/Test/Harness/Assert.pm @@ -1,4 +1,4 @@ -# $Id: Assert.pm,v 1.2 2002/04/26 05:12:27 schwern Exp $ +# $Id: Assert.pm,v 1.3 2003/09/11 15:57:29 andy Exp $ package Test::Harness::Assert; @@ -6,7 +6,7 @@ use strict; require Exporter; use vars qw($VERSION @EXPORT @ISA); -$VERSION = '0.01'; +$VERSION = '0.02'; @ISA = qw(Exporter); @EXPORT = qw(assert); @@ -30,11 +30,9 @@ A simple assert routine since we don't have Carp::Assert handy. B<For internal use by Test::Harness ONLY!> -=head2 Functions +=head1 FUNCTIONS -=over 4 - -=item B<assert> +=head2 C<assert()> assert( EXPR, $name ); @@ -57,7 +55,7 @@ sub assert ($;$) { =head1 AUTHOR -Michael G Schwern E<lt>schwern@pobox.comE<gt> +Michael G Schwern C<< <schwern@pobox.com> >> =head1 SEE ALSO diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index ea124e2c51..e3c223ae44 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,153 @@ Revision history for Perl extension Test::Harness +2.38 Mon Nov 24 22:36:18 CST 2003 + Released. See changes below. + +2.37_03 Tue Nov 18 23:51:38 CST 2003 + [ENHANCEMENTS] + * prove -V now shows the Perl version being used. + * Now there's a HARNESS_DEBUG flag that shows diagnostics as the + harness runs the tests. This is different from HARNESS_VERBOSE, + which shows test output, but not information about the harness + itself. + * Added _command_line() to the Strap API. + + [FIXES] + * Bad interaction with Module::Build: The strap was only checking + $ENV{HARNESS_PERL_SWITCHES} for definedness, but not emptiness. + It now also strips any leading or trailing whitesapce from the + switches. + * Test::Harness and prove only quote those parms that actually need + to be quoted: Have some whitespace and aren't already quoted. + +2.36 Fri Nov 14 09:24:44 CST 2003 + [FIXES] + * t/prove-includes.t properly ignores PROVE_SWITCHES that you may + already have set. + +2.35_02 Thu Nov 13 09:57:36 CST 2003 + [ENHANCEMENTS] + * prove's --blib now works just like the blib pragma. + +2.35_01 Wed Nov 12 23:08:45 CST 2003 + [FIXES] + * Fixed taint-handling and path preservation under MacOS. Thanks to + Schwern for the patch and the tests. + + * Preserves case of -t or -T in the shebang line of the test. + + [ENHANCEMENTS] + * Added -t to prove analogous to Perl's -t. Removed the --taint + switch. + + * prove can take default options from the PROVE_SWITCHES variable. + + * Added HARNESS_PERL to allow you to specify the Perl interpreter + to run the tests as. + + * prove's --perl switch sets the HARNESS_PERL on the fly for you. + + * Quotes the switches and filename in the subprogram. This helps + with filenames with spaces that are subject to shell mangling. + + +2.34 Sat Nov 8 22:09:15 CST 2003 + [FIXES] + * Allowed prove to run on Perl versions < 5.6.0. + + [ENHANCEMENTS] + * Command-line switches to prove may now be stacked. + * Added check for proper Pod::Usage version. + * "make clean" does a better job of cleaning up after itself. + + +2.32 Fri Nov 7 09:41:21 CST 2003 + Test::Harness now includes a powerful development tool to help + programmers work with automated tests. The prove utility runs + test files against the harness, like a "make test", but with many + advantages: + + * prove is designed as a development tool + Perl users typically run the test harness through a makefile via + "make test". That's fine for module distributions, but it's + suboptimal for a test/code/debug development cycle. + + * prove is granular + prove lets your run against only the files you want to check. + Running "prove t/live/ t/master.t" checks every *.t in t/live, plus + t/master.t. + + * prove has an easy verbose mode + To get full test program output from "make test", you must set + "HARNESS_VERBOSE" in the environment. prove has a "-v" option. + + * prove can run under taint mode + prove's "-T" runs your tests under "perl -T". + + * prove can shuffle tests + You can use prove's "--shuffle" option to try to excite problems + that don't show up when tests are run in the same order every time. + + * Not everything is a module + More and more users are using Perl's testing tools outside the + context of a module distribution, and may not even use a makefile at + all. + + Prove requires Pod::Usage, which is standard after Perl 5.004. + + I'm very excited about prove, and hope that developers will begin + adopting it to their coding cycles. I welcome your comments at + andy@petdance.com. + + There are also some minor bug fixes in Test::Harness itself, listed + below in the 2.31_* notes. + + +2.31_05 Thu Nov 6 14:56:22 CST 2003 + [FIXES] + - If a MacPerl script had a shebang with -T, the -T wouldn't get + passed as a switch. + - Removed the -T on three *.t files, which didn't need them, and + which were causing problems. + - Conditionally installs bin/prove, depending on whether Pod::Usage + is available, which prove needs. + - Removed old leftover code from Makefile.PL. + +2.31_04 Mon Nov 3 23:36:06 CST 2003 + Minor tweaks here and there, almost ready to release. + +2.31_03 Mon Nov 3 08:50:36 CST 2003 + [FEATURES] + - prove is almost feature-complete. Removed the handling of + --exclude for excluding certain tests. It may go back in the + future. + - prove -d is now debug. Dry is prove -D. + +2.31_02 Fri Oct 31 23:46:03 CST 2003 + [FEATURES] + - Added many more switches to prove: -d for dry run, and -b for + blib. + + [FIXES] + - T:H:Straps now recognizes MSWin32 in $^0. + - RT#3811: Could do regex matching on garbage in _is_test(). + Fixed by Yves Orton + - RT#3827: Strips backslashes from and normalizes @INC entries + for Win32. Fixed by Yves Orton. + + [INTERNALS] + - Added $self->{_is_macos} to the T:H:Strap object. + - t/test-harness.t sorts its test results, rather than relying on + internal key order. + +2.31_01 + [FEATURES] + - Added "prove" script to run a test or set of tests through the + harness. Thanks to Curtis Poe for the foundation. + + [DOCUMENTATION] + - Fixed POD problem in Test::Harness::Assert + 2.30 Thu Aug 14 20:04:00 CDT 2003 No functional changes in this version. It's only to make some doc tweaks, and bump up the version number in T:H:Straps. @@ -9,10 +157,10 @@ Revision history for Perl extension Test::Harness - Incorporated the TODO file into Harness.pm proper. - Cleaned up formatting in Test::Harness::Straps. -2.29 Wed Jul 17 14:08:00 CDT 2003 +2.29 Wed Jul 17 14:08:00 CDT 2003 - Released as 2.29. -2.28_91 Sun Jul 13 00:10:00 CDT 2003 +2.28_91 Sun Jul 13 00:10:00 CDT 2003 [ENHANCEMENTS] - Added support for HARNESS_OK_SLOW. This will make a significant speedup for slower connections. @@ -25,7 +173,7 @@ Revision history for Perl extension Test::Harness - Fixed the prototype for the canonfailed() function, not that it matters since it's never called without parens. -2.28_90 Sat Jul 05 20:21:00 CDT 2003 +2.28_90 Sat Jul 05 20:21:00 CDT 2003 [ENHANCEMENTS] - Now, when you run a test harnessed, the numbers don't fly by one at a time, one update per second. This significantly speeds diff --git a/lib/Test/Harness/Iterator.pm b/lib/Test/Harness/Iterator.pm index 5e227939a0..8939f86a4a 100644 --- a/lib/Test/Harness/Iterator.pm +++ b/lib/Test/Harness/Iterator.pm @@ -12,13 +12,11 @@ Test::Harness::Iterator - Internal Test::Harness Iterator =head1 SYNOPSIS use Test::Harness::Iterator; - use Test::Harness::Iterator; my $it = Test::Harness::Iterator->new(\*TEST); my $it = Test::Harness::Iterator->new(\@array); my $line = $it->next; - =head1 DESCRIPTION B<FOR INTERNAL USE ONLY!> diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 94fd363490..6d332ba3d8 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -1,12 +1,12 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Straps.pm,v 1.18 2003/08/15 01:29:23 andy Exp $ +# $Id: Straps.pm,v 1.34 2003/11/23 00:02:11 andy Exp $ package Test::Harness::Straps; use strict; use vars qw($VERSION); use Config; -$VERSION = '0.15'; +$VERSION = '0.18'; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -89,8 +89,9 @@ Initialize the internal state of a strap to make it ready for parsing. sub _init { my($self) = shift; - $self->{_is_vms} = $^O eq 'VMS'; - $self->{_is_win32} = $^O eq 'Win32'; + $self->{_is_vms} = ( $^O eq 'VMS' ); + $self->{_is_win32} = ( $^O =~ /^(MS)?Win32$/ ); + $self->{_is_macos} = ( $^O eq 'MacOS' ); } =head1 Analysis @@ -261,14 +262,9 @@ sub analyze_file { local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; - my $cmd = $self->{_is_vms} ? "MCR $^X" : - $self->{_is_win32} ? Win32::GetShortPathName($^X) - : $^X; - - my $switches = $self->_switches($file); - # *sigh* this breaks under taint, but open -| is unportable. - unless( open(FILE, "$cmd $switches $file|") ) { + my $line = $self->_command_line($file); + unless( open(FILE, "$line|") ) { print "can't run $file. $!\n"; return; } @@ -298,6 +294,53 @@ else { *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) } } +=head2 C<_command_line( $file )> + + my $command_line = $self->_command_line(); + +Returns the full command line that will be run to test I<$file>. + +=cut + +sub _command_line { + my $self = shift; + my $file = shift; + + my $command = $self->_command(); + my $switches = $self->_switches($file); + + $file = qq["$file"] if ($file =~ /\s/) && ($file !~ /^".*"$/); + my $line = "$command $switches $file"; + + return $line; +} + + +=head2 C<_command> + + my $command = $self->_command(); + +Returns the command that runs the test. Combine this with _switches() +to build a command line. + +Typically this is C<$^X>, but you can set C<$ENV{HARNESS_COMMAND}> +to use a different Perl than what you're running the harness under. +This might be to run a threaded Perl, for example. + +You can also overload this method if you've built your own strap subclass, +such as a PHP interpreter for a PHP-based strap. + +=cut + +sub _command { + my $self = shift; + + return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL}; + return "MCR $^X" if $self->{_is_vms}; + return Win32::GetShortPathName($^X) if $self->{_is_win32}; + return $^X; +} + =head2 C<_switches> @@ -310,28 +353,56 @@ Formats and returns the switches necessary to run the test. sub _switches { my($self, $file) = @_; + my @existing_switches = $self->_cleaned_switches( $Test::Harness::Switches, $ENV{HARNESS_PERL_SWITCHES} ); + my @derived_switches; + local *TEST; open(TEST, $file) or print "can't open $file. $!\n"; - my $first = <TEST>; - my $s = $Test::Harness::Switches || ''; - $s .= " $ENV{'HARNESS_PERL_SWITCHES'}" - if exists $ENV{'HARNESS_PERL_SWITCHES'}; - - if ($first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/) { - # When taint mode is on, PERL5LIB is ignored. So we need to put - # all that on the command line as -Is. - $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC; + my $shebang = <TEST>; + close(TEST) or print "can't close $file. $!\n"; + + my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ ); + push( @derived_switches, "-$1" ) if $taint; + + # When taint mode is on, PERL5LIB is ignored. So we need to put + # all that on the command line as -Is. + # MacPerl's putenv is broken, so it will not see PERL5LIB, tainted or not. + if ( $taint || $self->{_is_macos} ) { + my @inc = $self->_filtered_INC; + push @derived_switches, map { "-I$_" } @inc; } - elsif ($^O eq 'MacOS') { - # MacPerl's putenv is broken, so it will not see PERL5LIB. - $s .= join " ", map {qq["-I$_"]} $self->_filtered_INC; + + # Quote all switches to prevent shell interference, or VMS downcasing + for ( @derived_switches ) { + $_ = qq["$_"] if /\s/ && !/^".*"$/; } + return join( " ", @existing_switches, @derived_switches ); +} - close(TEST) or print "can't close $file. $!\n"; +=head2 C<_cleaned_switches> - return $s; -} + my @switches = $self->_cleaned_switches( @switches_from_user ); +Returns only defined, non-blank, trimmed switches from the parms passed. + +=cut + +sub _cleaned_switches { + my $self = shift; + + local $_; + + my @switches; + for ( @_ ) { + my $switch = $_; + next unless defined $switch; + $switch =~ s/^\s+//; + $switch =~ s/\s+$//; + push( @switches, $switch ) if $switch ne ""; + } + + return @switches; +} =head2 C<_INC2PERL5LIB> @@ -363,13 +434,19 @@ sub _filtered_INC { my($self, @inc) = @_; @inc = @INC unless @inc; - # VMS has a 255-byte limit on the length of %ENV entries, so - # toss the ones that involve perl_root, the install location - # for VMS if( $self->{_is_vms} ) { + # VMS has a 255-byte limit on the length of %ENV entries, so + # toss the ones that involve perl_root, the install location @inc = grep !/perl_root/i, @inc; + + } elsif ( $self->{_is_win32} ) { + # Lose any trailing backslashes in the Win32 paths + s/[\\\/+]$// foreach @inc; } + my %dupes; + @inc = grep !$dupes{$_}++, @inc; + return @inc; } @@ -501,8 +578,8 @@ sub _is_test { # We pulverize the line down into pieces in three parts. if( my($not, $num, $extra) = $line =~ /$Report_Re/ox ) { - my($name, $control) = split /(?:[^\\]|^)#/, $extra if $extra; - my($type, $reason) = $control =~ /^\s*(\S+)(?:\s+(.*))?$/ if $control; + my ($name, $control) = $extra ? split(/(?:[^\\]|^)#/, $extra) : (); + my ($type, $reason) = $control ? $control =~ /^\s*(\S+)(?:\s+(.*))?$/ : (); $test->{number} = $num; $test->{ok} = $not ? 0 : 1; @@ -520,7 +597,7 @@ sub _is_test { return $YES; } else{ - # Sometimes the "not " and "ok" will be on seperate lines on VMS. + # Sometimes the "not " and "ok" will be on separate lines on VMS. # We catch this and remember we saw it. if( $line =~ /^not\s+$/ ) { $self->{saw_lone_not} = 1; @@ -663,5 +740,4 @@ L<Test::Harness> =cut - 1; diff --git a/lib/Test/Harness/bin/prove b/lib/Test/Harness/bin/prove new file mode 100644 index 0000000000..e9a463f59a --- /dev/null +++ b/lib/Test/Harness/bin/prove @@ -0,0 +1,322 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::Harness; +use Getopt::Long; +use Pod::Usage 1.12; +use File::Spec; + +use vars qw( $VERSION ); +$VERSION = "1.04"; + +my @ext = (); +my $shuffle = 0; +my $dry = 0; +my $blib = 0; +my $recurse = 0; +my @includes = (); +my @switches = (); + +# Allow cuddling the paths with the -I +@ARGV = map { /^(-I)(.+)/ ? ($1,$2) : $_ } @ARGV; + +# Stick any default switches at the beginning, so they can be overridden +# by the command line switches. +unshift @ARGV, split( " ", $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES}; + +Getopt::Long::Configure( "no_ignore_case" ); +Getopt::Long::Configure( "bundling" ); +GetOptions( + 'b|blib' => \$blib, + 'd|debug' => \$Test::Harness::debug, + 'D|dry' => \$dry, + 'h|help|?' => sub {pod2usage({-verbose => 1, -input => \*DATA}); exit}, + 'H|man' => sub {pod2usage({-verbose => 2, -input => \*DATA}); exit}, + 'I=s@' => \@includes, + 'r|recurse' => \$recurse, + 's|shuffle' => \$shuffle, + 't' => sub { unshift @switches, "-t" }, # Always want -t up front + 'T' => sub { unshift @switches, "-T" }, # Always want -T up front + 'v|verbose' => \$Test::Harness::verbose, + 'V|version' => sub { print_version(); exit; }, + 'ext=s@' => \@ext, +) or exit 1; + +# Build up extensions regex +@ext = map { split /,/ } @ext; +s/^\.// foreach @ext; +@ext = ("t") unless @ext; +my $ext_regex = join( "|", map { quotemeta } @ext ); +$ext_regex = qr/\.($ext_regex)$/; + +# Handle blib includes +if ( $blib ) { + my @blibdirs = blibdirs(); + if ( @blibdirs ) { + unshift @includes, @blibdirs; + } else { + warn "No blib directories found.\n"; + } +} + +# Build up TH switches +push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes ); +$Test::Harness::Switches = join( " ", @switches ); +print "# \$Test::Harness::Switches: $Test::Harness::Switches\n" if $Test::Harness::debug; + +my @tests; +@ARGV = File::Spec->curdir unless @ARGV; +push( @tests, -d $_ ? all_in( $_ ) : $_ ) for @ARGV; + +if ( @tests ) { + shuffle(@tests) if $shuffle; + if ( $dry ) { + print join( "\n", @tests, "" ); + } else { + print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug; + runtests(@tests); + } +} + +sub all_in { + my $start = shift; + + my @hits = (); + + local *DH; + if ( opendir( DH, $start ) ) { + while ( my $file = readdir DH ) { + next if $file eq File::Spec->updir || $file eq File::Spec->curdir; + next if $file eq ".svn"; + next if $file eq "CVS"; + + my $currfile = File::Spec->catfile( $start, $file ); + if ( -d $currfile ) { + push( @hits, all_in( $currfile ) ) if $recurse; + } else { + push( @hits, $currfile ) if $currfile =~ $ext_regex; + } + } + } else { + warn "$start: $!\n"; + } + + return @hits; +} + +sub shuffle { + # Fisher-Yates shuffle + my $i = @_; + while ($i) { + my $j = rand $i--; + @_[$i, $j] = @_[$j, $i]; + } +} + +sub print_version { + printf( "prove v%s, using Test::Harness v%s and Perl v%vd\n", + $VERSION, $Test::Harness::VERSION, $^V ); +} + +# Stolen directly from blib.pm +sub blibdirs { + my $dir = File::Spec->curdir; + if ($^O eq 'VMS') { + ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--; + } + my $archdir = "arch"; + if ( $^O eq "MacOS" ) { + # Double up the MP::A so that it's not used only once. + $archdir = $MacPerl::Architecture = $MacPerl::Architecture; + } + + my $i = 5; + while ($i--) { + my $blib = File::Spec->catdir( $dir, "blib" ); + my $blib_lib = File::Spec->catdir( $blib, "lib" ); + my $blib_arch = File::Spec->catdir( $blib, $archdir ); + + if ( -d $blib && -d $blib_arch && -d $blib_lib ) { + return ($blib_arch,$blib_lib); + } + $dir = File::Spec->catdir($dir, File::Spec->updir); + } + warn "$0: Cannot find blib\n"; + return; +} + +__END__ + +=head1 NAME + +prove -- A command-line tool for running tests against Test::Harness + +=head1 SYNOPSIS + +prove [options] [files/directories] + +Options: + + -b, --blib Adds blib/lib to the path for your tests, a la "use blib". + -d, --debug Includes extra debugging information. + -D, --dry Dry run: Show the tests to run, but don't run them. + --ext=x Extensions (defaults to .t) + -h, --help Display this help + -H, --man Longer manpage for prove + -I Add libraries to @INC, as Perl's -I + -r, --recurse Recursively descend into directories. + -s, --shuffle Run the tests in a random order. + -T Enable tainting checks + -t Enable tainting warnings + -v, --verbose Display standard output of test scripts while running them. + -V, --version Display version info + +Single-character options may be stacked. Default options may be set by +specifying the PROVE_SWITCHES environment variable. + +=head1 OVERVIEW + +F<prove> is a command-line interface to the test-running functionality +of C<Test::Harness>. With no arguments, it will run all tests in the +current directory. + +Shell metacharacters may be used with command lines options and will be exanded +via C<glob>. + +=head1 PROVE VS. "MAKE TEST" + +F<prove> has a number of advantages over C<make test> when doing development. + +=over 4 + +=item * F<prove> is designed as a development tool + +Perl users typically run the test harness through a makefile via +C<make test>. That's fine for module distributions, but it's +suboptimal for a test/code/debug development cycle. + +=item * F<prove> is granular + +F<prove> lets your run against only the files you want to check. +Running C<prove t/live/ t/master.t> checks every F<*.t> in F<t/live>, +plus F<t/master.t>. + +=item * F<prove> has an easy verbose mode + +F<prove> has a C<-v> option to see the raw output from the tests. +To do this with C<make test>, you must set C<HARNESS_VERBOSE=1> in +the environment. + +=item * F<prove> can run under taint mode + +F<prove>'s C<-T> runs your tests under C<perl -T>, and C<-t> runs them +under C<perl -t>. + +=item * F<prove> can shuffle tests + +You can use F<prove>'s C<--shuffle> option to try to excite problems +that don't show up when tests are run in the same order every time. + +=item * F<prove> doesn't rely on a make tool + +Not everyone wants to write a makefile, or use L<ExtUtils::MakeMaker> +to do so. F<prove> has no external dependencies. + +=item * Not everything is a module + +More and more users are using Perl's testing tools outside the +context of a module distribution, and may not even use a makefile +at all. + +=back + +=head1 COMMAND LINE OPTIONS + +=head2 -b, --blib + +Adds blib/lib to the path for your tests, a la "use blib". + +=head2 -d, --debug + +Include debug information about how F<prove> is being run. This +option doesn't show the output from the test scripts. That's handled +by -v,--verbose. + +=head2 -D, --dry + +Dry run: Show the tests to run, but don't run them. + +=head2 --ext=extension + +Specify extensions of the test files to run. By default, these are .t, +but you may have other non-.t test files, most likely .sh shell scripts. +The --ext is repeatable. + +=head2 -I + +Add libraries to @INC, as Perl's -I + +=head2 -r, --recurse + +Descends into subdirectories of any directories specified, looking for tests. + +=head2 -s, --shuffle + +Sometimes tests are accidentally dependent on tests that have been +run before. This switch will shuffle the tests to be run prior to +running them, thus ensuring that hidden dependencies in the test +order are likely to be revealed. The author hopes the run the +algorithm on the preceding sentence to see if he can produce something +slightly less awkward. + +=head2 -t + +Runs test programs under perl's -t taint warning mode. + +=head2 -T + +Runs test programs under perl's -T taint mode. + +=head2 -v, --verbose + +Display standard output of test scripts while running them. + +=head2 -V, --version + +Display version info. + +=head1 BUGS + +Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>. +You can also mail bugs, fixes and enhancements to +C<< <bug-test-harness@rt.cpan.org> >>. + +=head1 TODO + +=over 4 + +=item * + +Shuffled tests must be recreatable + +=item * + +Add a flag to run prove under Devel::Cover + +=back + +=head1 AUTHORS + +Andy Lester C<< <andy@petdance.com> >> + +=head1 COPYRIGHT + +Copyright 2003 by Andy Lester C<< <andy@petdance.com> >>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L<http://www.perl.com/perl/misc/Artistic.html>. + +=cut diff --git a/lib/Test/Harness/t/00compile.t b/lib/Test/Harness/t/00compile.t index 6ea2ce66b1..5b795a7e94 100644 --- a/lib/Test/Harness/t/00compile.t +++ b/lib/Test/Harness/t/00compile.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w BEGIN { if($ENV{PERL_CORE}) { diff --git a/lib/Test/Harness/t/assert.t b/lib/Test/Harness/t/assert.t index 11a4ed78a7..ec5239ec9b 100644 --- a/lib/Test/Harness/t/assert.t +++ b/lib/Test/Harness/t/assert.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Harness/t/callback.t b/lib/Test/Harness/t/callback.t index 646e81f398..c3a7fb9d26 100644 --- a/lib/Test/Harness/t/callback.t +++ b/lib/Test/Harness/t/callback.t @@ -53,7 +53,9 @@ $strap->{callback} = sub { push @out, $type; }; -while( my($test, $expect) = each %samples ) { +for my $test ( sort keys %samples ) { + my $expect = $samples{$test}; + local @out = (); $strap->analyze_file(File::Spec->catfile($SAMPLE_TESTS, $test)); diff --git a/lib/Test/Harness/t/inc_taint.t b/lib/Test/Harness/t/inc_taint.t new file mode 100644 index 0000000000..f1c8145e95 --- /dev/null +++ b/lib/Test/Harness/t/inc_taint.t @@ -0,0 +1,28 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use Test::Harness; +use Test::More tests => 1; +use Dev::Null; + +push @INC, 'we_added_this_lib'; + +tie *NULL, 'Dev::Null' or die $!; +select NULL; +my($tot, $failed) = Test::Harness::_run_all_tests( + $ENV{PERL_CORE} + ? 'lib/sample-tests/inc_taint' + : 't/sample-tests/inc_taint' +); +select STDOUT; + +ok( Test::Harness::_all_ok($tot), 'tests with taint on preserve @INC' ); diff --git a/lib/Test/Harness/t/pod.t b/lib/Test/Harness/t/pod.t index 6a299a6273..38d72b1492 100644 --- a/lib/Test/Harness/t/pod.t +++ b/lib/Test/Harness/t/pod.t @@ -1,23 +1,14 @@ BEGIN { - eval "use Test::More"; - if ($@) { - print "1..0 # SKIPPED: Test::More not installed.\n"; - exit; + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } -use File::Spec; -use File::Find; -use strict; - -eval "use Test::Pod 0.95"; - -if ($@) { - plan skip_all => "Test::Pod v0.95 required for testing POD"; -} else { - my @files; - my $blib = File::Spec->catfile(qw(blib lib)); - find( sub {push @files, $File::Find::name if /\.p(l|m|od)$/}, $blib); - plan tests => scalar @files; - Test::Pod::pod_file_ok($_) foreach @files; -} +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/lib/Test/Harness/t/prove-switches.t b/lib/Test/Harness/t/prove-switches.t new file mode 100644 index 0000000000..1df12db152 --- /dev/null +++ b/lib/Test/Harness/t/prove-switches.t @@ -0,0 +1,63 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use File::Spec; +use Test::More; +plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE}; +plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; + +plan tests => 3; +local $/ = undef; + +my $blib = File::Spec->catfile( File::Spec->curdir, "blib" ); +my $blib_lib = File::Spec->catfile( $blib, "lib" ); +my $blib_arch = File::Spec->catfile( $blib, "arch" ); +my $prove = File::Spec->catfile( $blib, "script", "prove" ); + +CAPITAL_TAINT: { + local $ENV{PROVE_SWITCHES}; + my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/; + my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); + array_match_ok( \@actual, \@expected, "Capital taint flags OK" ); +} + +LOWERCASE_TAINT: { + local $ENV{PROVE_SWITCHES}; + my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/; + my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); + array_match_ok( \@actual, \@expected, "Lowercase taint OK" ); +} + +PROVE_SWITCHES: { + local $ENV{PROVE_SWITCHES} = "-dvb -I fark"; + my @actual = qx/$prove -Ibork -Dd/; + my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" ); + array_match_ok( \@actual, \@expected, "PROVE_SWITCHES OK" ); +} + +sub array_match_ok { + my $actual = shift; + my $expected = shift; + my $message = shift; + my $n = 0; + + my @actual = @$actual; + my @expected = @$expected; + + while ( @actual && @expected ) { + return ok( 0, "Differs at element $n: $message" ) if shift @actual ne shift @expected; + ++$n; + } + return ok( 0, "Too many actual: $message" ) if @actual; + return ok( 0, "Too many expected: $message" ) if @expected; + + return ok( 1, $message ); +} diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 70f973dbd9..c372df90ab 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -468,7 +468,10 @@ $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /^Enormous test number/ || $_[0] =~ /^Can't detailize/ }; -while( my($test, $expect) = each %samples ) { + +for my $test ( sort keys %samples ) { + my $expect = $samples{$test}; + for (0..$#{$expect->{details}}) { $expect->{details}[$_]{type} = '' unless exists $expect->{details}[$_]{type}; diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t index d74ea64da3..2980d970ff 100644 --- a/lib/Test/Harness/t/strap.t +++ b/lib/Test/Harness/t/strap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { @@ -35,7 +35,8 @@ my %comments = ( "#" => '', ); -while( my($line, $line_comment) = each %comments ) { +for my $line ( sort keys %comments ) { + my $line_comment = $comments{$line}; my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); @@ -101,7 +102,8 @@ my %headers = ( } ); -while( my($header, $expect) = each %headers ) { +for my $header ( sort keys %headers ) { + my $expect = $headers{$header}; my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); @@ -169,7 +171,8 @@ my %tests = ( }, ); -while( my($line, $expect) = each %tests ) { +for my $line ( sort keys %tests ) { + my $expect = $tests{$line}; my %test; ok( $strap->_is_test($line, \%test), "_is_test() spots '$line'" ); @@ -204,7 +207,8 @@ my %bails = ( 'bail out! - Out of coffee' => '- Out of coffee', ); -while( my($line, $expect) = each %bails ) { +for my $line ( sort keys %bails ) { + my $expect = $bails{$line}; my $strap = Test::Harness::Straps->new; isa_ok( $strap, 'Test::Harness::Straps' ); diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index 1af11442bd..ca87efa0ae 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -19,26 +19,8 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE} : File::Spec->catdir($Curdir, 't', 'sample-tests'); -# For shutting up Test::Harness. -# Has to work on 5.004 which doesn't have Tie::StdHandle. -package My::Dev::Null; - -sub WRITE {} -sub PRINT {} -sub PRINTF {} -sub TIEHANDLE { - my $class = shift; - my $fh = do { local *HANDLE; \*HANDLE }; - return bless $fh, $class; -} -sub READ {} -sub READLINE {} -sub GETC {} - - -package main; - use Test::More; +use Dev::Null; my $IsMacPerl = $^O eq 'MacOS'; my $IsVMS = $^O eq 'VMS'; @@ -335,6 +317,23 @@ my %samples = ( all_ok => 1, }, + taint_warn => { + total => { + bonus => 0, + max => 1, + 'ok' => 1, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + 'die' => { total => { bonus => 0, @@ -476,14 +475,20 @@ use_ok('Test::Harness'); use Test::Harness; # So that we don't get "used only once" warnings on the next line $Test::Harness::Switches = '"-Mstrict"'; -tie *NULL, 'My::Dev::Null' or die $!; +tie *NULL, 'Dev::Null' or die $!; + +for my $test ( sort keys %samples ) { +SKIP: { + skip "-t introduced in 5.8.0", 8 if $test eq 'taint_warn' and $] < 5.008; + + my $expect = $samples{$test}; -while (my($test, $expect) = each %samples) { # _run_all_tests() runs the tests but skips the formatting. my($totals, $failed); my $warning = ''; my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); + print STDERR "# $test\n" if $ENV{TEST_VERBOSE}; eval { select NULL; # _run_all_tests() isn't as quiet as it should be. local $SIG{__WARN__} = sub { $warning .= join '', @_; }; @@ -531,3 +536,4 @@ WARN is( $warning, '' ); } } +} diff --git a/t/lib/Dev/Null.pm b/t/lib/Dev/Null.pm new file mode 100644 index 0000000000..2bd2274061 --- /dev/null +++ b/t/lib/Dev/Null.pm @@ -0,0 +1,17 @@ +# For shutting up Test::Harness. +# Has to work on 5.004 which doesn't have Tie::StdHandle. +package Dev::Null; + +sub WRITE {} +sub PRINT {} +sub PRINTF {} +sub TIEHANDLE { + my $class = shift; + my $fh = do { local *HANDLE; \*HANDLE }; + return bless $fh, $class; +} +sub READ {} +sub READLINE {} +sub GETC {} + +1; diff --git a/t/lib/sample-tests/inc_taint b/t/lib/sample-tests/inc_taint new file mode 100644 index 0000000000..c0dc994989 --- /dev/null +++ b/t/lib/sample-tests/inc_taint @@ -0,0 +1,7 @@ +#!/usr/bin/perl -Tw + +use lib qw(t/lib); +use Test::More tests => 1; + +ok( grep(/we_added_this_lib/, @INC) ); + diff --git a/t/lib/sample-tests/taint_warn b/t/lib/sample-tests/taint_warn new file mode 100644 index 0000000000..5b4c486166 --- /dev/null +++ b/t/lib/sample-tests/taint_warn @@ -0,0 +1,11 @@ +#!/usr/bin/perl -tw + +use lib qw(t/lib); +use Test::More tests => 1; + +my $warnings = ''; +{ + local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; + kill 0, $^X; +} +like( $warnings, '/^Insecure dependency/', '-t honored' ); @@ -19,6 +19,7 @@ utils/perldoc # pod = pod/perldoc.pod utils/perlivp utils/piconv utils/pl2pm +utils/prove utils/splain utils/xsubpp x2p/a2p # pod = x2p/a2p.pod diff --git a/utils/Makefile b/utils/Makefile index 85237995a8..48f1e14ff3 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -5,9 +5,9 @@ REALPERL = ../perl # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL -plextract = c2ph cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp -plextractexe = ./c2ph ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp +pl = c2ph.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL +plextract = c2ph cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp +plextractexe = ./c2ph ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp all: $(plextract) @@ -43,6 +43,8 @@ perldoc: perldoc.PL ../config.sh perlivp: perlivp.PL ../config.sh +prove: prove.PL ../config.sh + pl2pm: pl2pm.PL ../config.sh splain: splain.PL ../config.sh ../lib/diagnostics.pm diff --git a/utils/prove.PL b/utils/prove.PL new file mode 100644 index 0000000000..d1961c8725 --- /dev/null +++ b/utils/prove.PL @@ -0,0 +1,49 @@ +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +my $origdir = cwd; +chdir dirname($0); +my $file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{startperl} + eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' + if \$running_under_some_shell; +!GROK!THIS! + +use File::Spec; + +my $prove = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, + "lib", "Test", "Harness", "bin"), "prove"); + +if (open(PROVE, $prove)) { + print OUT <PROVE>; + close PROVE; +} else { + die "$0: cannot find '$prove'\n"; +} + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; |