diff --git a/MANIFEST b/MANIFEST index e2bd454e2e96..d9153e9c8016 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6682,9 +6682,11 @@ t/run/switchx3.aux Data for switchx.t t/run/todo.t TODO tests t/TEST The regression tester t/test.pl Simple testing library +t/test_pl.pod Documentation for test.pl t/test_pl/_num_to_alpha.t Tests for the simple testing library t/test_pl/can_isa_ok.t Tests for the simple testing library t/test_pl/display.t Tests for the simple testing library +t/test_pl/examples.t Tests for the simple testing library t/test_pl/plan_skip_all.t Tests for the simple testing library t/test_pl/tempfile.t Tests for the simple testing library t/thread_it.pl Run regression tests in a new thread diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index 4d5f13499518..fe534cd31eea 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -1817,6 +1817,9 @@ else { # No input files -- go find all the possibilities. # Add ourselves to the test push @files, "t/porting/podcheck.t"; + + # and the test.pl documentation + push @files, "t/test_pl.pod"; } # Now we know how many tests there will be. diff --git a/t/test.pl b/t/test.pl index e498038cd618..1810f662fa92 100644 --- a/t/test.pl +++ b/t/test.pl @@ -17,6 +17,8 @@ # # In this file, we use the latter "Baby Perl" approach, and increment # will be worked over by t/op/inc.t +# +# see t/test_pl.pod for documentation # This file sets for its caller $::IS_ASCII and $::IS_EBCDIC appropriately; # and $::devnull to be the string to use to specify /dev/null on this diff --git a/t/test_pl.pod b/t/test_pl.pod new file mode 100644 index 000000000000..02660deac16b --- /dev/null +++ b/t/test_pl.pod @@ -0,0 +1,884 @@ +=encoding utf8 + +=head1 NAME + +test_pl.pod - documentation for t/test.pl + +=head1 SYNOPSIS + + BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc(qw '../lib ...'); + } + + # either: + plan tests => $test_count; + ... tests ... + + # or + ... tests ... + done_testing(); + + # roughly Test::More compatible + # you can omit $name but you really shouldn't + # tests + ok($ok, $name); + is($got, $expected, $name); + isnt($got, $unexpected, $name); + cmp_ok($got, $op, $expected, $name); + like($got, $expected, $name); + unlike($got, $expected, $name); + pass($name); + fail($name); + can_ok($object, @methods); + new_ok($class, \@args, $obj_name); + isa_ok($object, $class, $obj_name); + require_ok($module); # eg "Time::HiRes" not "Time/Hires.pm" + use_ok($module) # eg "Time::HiRes" not "Time/Hires.pm" + local $::TODO = "todo reason"; + + # test utilities + skip($reason, $count); # $count is 1 if omitted + diag(@messages); + note(@messages); + BAIL_OUT($reason); + + # test extensions over Test::More + # you can omit $name but you really shouldn't + within($got, $expected, $range, $name); + refcount_is($got, $expected, $name); + + object_ok($obj, $isa, $obj_name); + class_ok($class, $isa, $class_name); + + warnings_like($subref, \@expect_qr, $name); + warning_is($subref, $expect, $name); + warning_like($subref, $expect_qr, $name); + + fresh_perl_is($code, $expected, \%runperl_args, $name); + fresh_perl_like($code, $expected, \%runperl_args, $name); + + # test tools + my $test_num = curr_test(); + curr_test($new_test_num); + todo_skip($reason, $count); + + # often used from BEGIN + skip_if_miniperl($reason, $count); + skip_all_without_dynamic_extension($extension); # eg "Time::HiRes" + skip_all(@messages); + skip_all_if_miniperl(@messages); + skip_all_without_perlio(); + skip_all_without_config(@config_keys); + skip_all_without_unicode_tables(); + find_git_or_skip("all"); + find_git_or_skip($count); + + # test directory runners (like t/lib/croak.t, lib/warnings.t) + my ($count, @test_progs) = setup_multiple_progs(@files); + run_multiple_progs('', $fh); + run_multiple_progs($up, @test_progs); + + # utilities + my $output = runperl(%runperl_args); + my $output = run_perl(%runperl_args); # purely an alias + + my ($stdout, $stderr) = + runperl_and_capture(\%myenv_changes, \@run_me); + + my @warnings = capture_warnings($subref); # may allow args + +=for comment not really usable + my $clean = untaint_path($1); # $dirty shouldn't be tainted + + watchdog($timeout, $type); # zero timeout clears the watchdog + + my $perl_exe = which_perl(); + + my $count = unlink_all(@filenames); # return value normally ignored + + my $tmpfile = tempfile(); + register_tempfile(@filenames); + unlink_tempfiles(); # done by END, but you can cleanup earlier too + + my $output = fresh_perl($code, \%runperl_args); + + my @pretty = display(@data); + my $pretty_re = display_rx($str); + + if (eq_array(\@one, \@two)) { + ... + } + if (eq_hash(\%one, \%two)) { + ... + } + + unless (is_miniperl()) { + ... + } + if (is_linux_container()) { + ... + } + + # detected configuration + $::IS_ASCII # if an ASCII-ish system, ie. ord("A") == 65 + $::IS_EBCDIC # if an EDCDIC-ish system, ie. ord("A") == 193 + # path to a device that reads nothing and discards writes + # "/dev/null" or "nul" + $::devnull + +=head1 DESCRIPTION + +F provides much of L, and more, but tries not +to exercise too much of the interpreter. + +Some parts do work differently. + +=head1 Test::More differences + +Since F is loaded with C instead of C you need +to call plan(), or the skip_all() function instead of specifying that +on the C line. + +Instead of: + + use Test::More plan => 20; + +you need something like: + + BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc( '../lib' ); + } + plan tests => 20; + +or you can skip the plan and use done_testing(). + +There is no support for subtests. + +The following Test::More functions are provided and they are generally +Test::More compatible: + +=over + +=item ok($ok, $name) + +=item is($got, $expected, $name) + +=item isnt($got, $unexpected, $name) + +=item cmp_ok($got, $op, $expected, $name) + +=item like($got, $expected, $name) + +=item unlike($got, $expected, $name) + +=item pass($name) + +=item fail($name) + +=item can_ok($object, @methods) + +=item $obj = new_ok($class, \@args, $obj_name) + +=item isa_ok($object, $class, $obj_name) + +=item require_ok($module) + +=item use_ok($module) + +=item skip($reason, $count) + +=item diag(@messages) + +=item note(@messages) + +=item BAIL_OUT($reason) + +=item done_testing() + +=back + +=head1 Extended test functions + +These perform some sort of test, in some cases results for multiple +tests are produced: + +=over + +=item within($got, $expected, $range, $name) + +Check C<$got> is within a numeric range. + +Fails if any of C<$got>, C<$expected> or C<$range> is non-numeric. + +If C<$range> is zero, succeeds if C<< $got == $range >>. + +If C<$expected> is zero, succeeds if C<< -$range <= $got <= $range >>. + +Otherwise succeeds if C<< abs($got - $expected)/$expected < $range >>. + + my $pi = 3.14159265; + within(sin($pi/6), 0.5, 0.0001, "sin(PI/6) is sane"); + within(cos($pi), 0, 0.0001, "cos(PI) is sane"); + +=item refcount_is($got, $expected, $name) + +Succeed if the reference count of C<$got> is C<$expected>. + + my $x = 1; + refcount_is(\$x, 1, "only one reference"); + my $ref = \$x; + refcount_is(\$x, 2, "two references"); + +=item object_ok($obj, $isa, $obj_name) + +Succeeds if C<$obj> is a reference and C C<$isa>. + + object_ok(*STDERR{IO}, "IO::Handle", "check STDERR is IO"); + +=item class_ok($class, $isa, $class_name) + +Succeeds if C<$class> is not a reference and C C<$isa>. + + use IO::File; + class_ok("IO::File", "IO::Handle", "Check IO::File is a class"); + +=item warnings_like($subref, \@expect_qr, $name) + +Captures warnings while running C<&$subref> and succeeds if the +warning text from each warning matches the regular expressions in +C<@expect_qr> in sequence. + + warnings_like(sub { my $x; $x+1 }, [ qr/Undefined value/ ], + "undefined value in addition"); + +Produces C< 1 + scalar(@expect_qr) > test results, one for the count +of warnings, and one for each warning checked. + +=item warning_is($subref, $expect, $name) + +Captures warnings while running C<&$subref> and succeeds if either: + +=over + +=item * + +there is only one warning captured and it is precisely C<$expect>. + +=item * + +there were no warnings and C<$expect> is not defined. + +=back + + warning_is(sub { +#line 1 "fake.pl" + my $x; $x+1 +}, "Use of uninitialized value $x in addition (+) at fake.t line 1."); + +=item warning_like($subref, $expect_qr, $name) + +Captures warnings while running C<&$subref> and succeeds if the +warning text matches the regular expression object C<$expect_qr>. + + warning_like(sub { my $x; $x+1 }, + qr/^Use of uninitialized value \$x in addition/, + "undefined value in addition"); + +=item fresh_perl_is($code, $expected, \%runperl_args, $name) + +=item fresh_perl_like($code, $expect_qr, \%runperl_args, $name) + +Run the C<$code> in a new perl process and capture the output. + +fresh_perl_is() succeeds if the output is precisely C<$expect>. + +fresh_perl_like() succeeds if the output matches the regular +expression C<$expect_qr>. + +See L for the details of C<%runperl_args>. + +This uses fresh_perl() under the hood, see that for some other +differences from raw runperl(). + + fresh_perl_is(<<~'CODE', "Hello\n", {}, "test print"); + print "Hello\n"; + CODE + + fresh_perl_like(<<~'CODE', qr/^Hello at/, {}, "test print like"); + die "Hello"; + CODE + +=item setup_multiple_progs(@files) + +Scan the given files for tests to be run by run_multiple_progs(). +This is currently only used by F which itself is used +by most tests that use run_multiple_progs() on other files. + +Test files parsed by setup_multiple_progs() ignore any lines until a +C<__END__> line is found. + +So in general, just use F, see F and +F for examples. + + ($count, @test_progs) = setup_multiple_progs(@files) + +=item run_multiple_progs('', $fh) + +Read and parse tests from C<$fh>, which is typically C<\*DATA>, and +run them per C< run_multiple_progs($up, @test_progs) >. + + run_multiple_progs('', \*DATA); + ... + __END__ + # NAME first multi test + print "One\n"; + EXPECT + One + ######## + # NAME second multi test + die "Two"; + EXPECT + OPTIONS fatal + Two at - line 1. + +=item run_multiple_progs($up, @test_progs) + +Run each of the test programs, testing whether the output, and +optionally the exit value, matches the expected output. + +See L for the details of the format of +each test. + +The tests here should already be parsed into separate tests, ie. they +do not contain the C<########> separators. + +This form is typically only used directly by F and +indirectly by the users of that file, as with F and +F and you should probably do the same. + +=back + +These functions are test utilties - they don't test anything but +either skip on some condition useful when testing perl itself, or +interact with the test engine at a low level: + +=over + +=item my $test_num = curr_test(); + +=item curr_test($new_test_num); + +Return or set the current test number. + +This can be used when dealing with forked processes to ensure child +and parent test numbers are sequential. See F for an +example. + +=item todo_skip($reason, $count); + +Skip and TODO tests. + +=item skip_if_miniperl($reason, $count); + +Skip some tests if F is running the tests, as with +C. + +=item skip_all_without_dynamic_extension($extension); # eg "Time::HiRes" + +Skip all tests if the test is being run by F or if the given +module hasn't been configured to be built. + +=item skip_all(@messages); + +Skip all tests. Also available via plan() as with Test::More. + +=item skip_all_if_miniperl(@messages); + +Skip all tests if the test is being run by F. + +=item skip_all_without_perlio(); + +Skip all tests if perl was built without C, which should no +longer be possible. + +=item skip_all_without_config(@config_keys) + +Skip all tests if any of the supplied C<%Config> keys is false. + +Typically used for testing C or C prefix keys: + + skip_all_without_config("d_fork"); + skip_all_without_config("usethreads"); + skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid)); + +=item skip_all_without_unicode_tables(); + +Skip all tests if the unicode tables, used for unicode character +classification, haven't been built yet. + +=item find_git_or_skip("all"); + +=item find_git_or_skip($count); + +Look for the git directory for the perl being tested, if not found, +either skip all tests if called with C<"all">, or skip C<$count> tests. + +Ensures that the git directory is a clone or fork of the Perl 5 +Porters git repository rather than some other repository, such as the +Debian repository. + +Generally used by porting tests to ensure we're working from a git +clone of the master Perl repository. + +=back + +=head1 Utility functions + +=over + +=item runperl(%runperl_args) +=item run_perl(%runperl_args) + +Run a new perl process with the C, C or C +specified in C<%runperl_args>, captures the output and returns that. + +See L below for the many possible arguments. + + my $out = runperl(prog => "print qq(Hello\n)"); + is($out, "Hello\n", "runperl"); + +=item runperl_and_capture(\%myenv_changes, \@run_me) + +Run a new perl process with the given arguments and capture standard +output and standard error separately: + + my ($stdout, $stderr) = + runperl_and_capture($env, [ '-e', 'print $^O' ]); + +This uses fork(), if fork fails it will return an empty standard +output and stanadard error will contain an error message. + +Despite the name this does not use runperl(). + +=item capture_warnings($subref) + +Runs the given code reference with C<$SIG{__WARN__}> hooked to capture +any warnings, and returns those warnings as a list: + + my @warnings = capture_warnings(sub { my $x; $x+1 }); + is(@warnings, 1, "captured one warning"); + like($warnings[0], + qr/^Use of uninitialized value \$x in addition/, + "check undefined value in addition warning"); + +=item untaint_path($1) + +Remote any empty, C<.>, non-existent, or writable by other/all entries +from the supplied path and return the result: + + $ENV{PATH} =~ /(.*)/s; + my $clean = untaint_path($1); + +Note: currently only used by F itself. + +=item watchdog($timeout); + +=item watchdog($timeout, $method); + +Start a watchdog timer for C<$timeout> seconds. If C<$timeout> is +zero then disables any existing watchdog timer. + +The timeout may be scaled by setting C or +C in the environment. If C +is set the scale factor has a minimum of 10. + +The method used to kill on timeout can be selected by C<$method> which +can be: + +=over + +=item * + +empty or omitted - a method is selected automatically. + +=item * + +C - fork() or system(1, ...) a process that will kill the +current process after the timeout expires. + +=item * + +C - alarm() is used to schedule a signal and a handler is +installed to kill the current process. + +=back + +Automatic selection: + +=over + +=item 1. + +If the C module is loaded, create a thread which will exit +the process after the timeout expires. + +=item 2. + +Try the C method, if that fails, try to use a thread as +above. + +=item 3. + +Use the C method. + +=back + +If none of these work no watchdog is set. + + watchdog(10); # top of file + ... + watchdog(0); # one anything that might lockup is done + +=item which_perl() + +Return the path to the perl used to invoke the test script. + + my $perl_exe = which_perl(); + +=item unlink_all(@filenames) + +Unlink all (including all versions on VMS) of the given files. + + my $count = unlink_all(@filenames); + +This returns the count of successful unlinks, but this is usually +ignored. + +=item tempfile() + +Returns the name of a new temporary file. The file is not created and +the returned name does not include a directory. + + my $tmpfile = tempfile(); + +The file is registered for deletion by unlink_tempfiles(). + +=item register_tempfile(@filenames) + +Register a list of files to be deleted by the next call to +unlink_tempfiles(), which is also called at C time. + +=item unlink_tempfiles() + +Unlink any registered temporary files. This is also called by END, +but you can cleanup earlier too. + +=item fresh_perl($code, \%runperl_args) + +Write the given code to a file, run it via runperl() and return the +captured output. + + my $output = fresh_perl($code, \%runperl_args); + +If you don't otherwise specify it fresh_perl() will set C to 1 +in C<%runperl_args> so standard error output will also be included. + +fresh_perl() accepts the following extra arguments in +C<%runperl_arguments>: + +=over + +=item * + +C - the test code is written to the file as UTF-8. + +=item * + +C - if non-zero any whitespace is trimmed from the end +of all lines in the output. eg. C<"abc \ndef\t\n"> would be returned +as C<"abc\ndef\n">. + +=back + +All trailing empty lines are trimmed from the output. + +The filename of the file the code is written to is replaced with C<-> +in the output. + +C and C are case insensitively replaced with +C in the output. + +=item display(@data) + +Returns the contents of C<@data> with non-ASCII or non-printable +characters in each string replaced with an escape sequence. + + my @pretty = display(@data); + +=item display_rx($str) + +Returns the contents of C<$str> escaped in a similar fashion to the +regex debugger. + + my $pretty_re = display_rx($str); + +=item eq_array(\@one, \@two) + +Returns if the contents of the two arrays compare equally as strings. +This is not a deep compare. + + if (eq_array(\@one, \@two)) { + ... + } + +=item eq_hash(\%one, \%two) + +Returns if the contents of the two hashs compare equally as string. This is not a deep compare. + + if (eq_hash(\%one, \%two)) { + ... + } + +=item is_miniperl() + +Returns true if the test script is being run by C. + + unless (is_miniperl()) { + ... + } + +=item is_linux_container() + +Returns true if the test appears to be running in a container. + + if (is_linux_container()) { + ... + } + +=back + +There are also some variables which detect useful configuration: + +=over + +=item C<$::IS_ASCII> + +=item C<$::IS_EBCDIC> + +True if the system is ASCII or EBCDIC respectively. + +=item C<$::devnull> + +The name of the system F equivalent. + +=back + +There's also: + +=over + +=item C<$::FATAL> + +Controls the default fatality for L. + +=back + +=head1 Runperl Arguments + +runperl(), fresh_perl(), fresh_perl_is() and fresh_perl_like() accept +a common set of parameters that are eventually processed by runperl, +these are: + +=over + +=item * + +C - the code to run as a single string. This is split on new +lines and procssed internally like C. ie. + + prog => $str + +is processed like: + + progs => [ split /\n/, $str ] + +=item * + +C - an array reference of code fragments to pass to the new +perl as C<-e> arguments. + +=item * + +C - the name of a file containing perl code to be run by the +new perl. + +=item * + +C - if present, an array reference of extra switches to +supply before or instead of C or C. + +=item * + +C - if true, suppress the C<"-I../lib" "-I."> runperl() +normally adds before the other arguments. + +=item * + +C - if true, this is fed to standard input of the new perl +process via a pipe. + +It set but not true, the process standard input reads from the +platform F equivalent. + +=item * + +C - an arrayref of extra arguments supplied after the switches +and program. + +=item * + +C - if equal to C, standard error is redirected to +the system F equivalent. + +Otherwise if true, standard error is captured along with standard +output. + +Note: fresh_perl() sets this to true if not otherwise provided. + +=item * + +C - if true the generated command-line is written to stderr +before it is executed. + +=back + +fresh_perl(), fresh_perl_is() and fresh_perl_like() also accept +C and C, see L for details. + +C + +=head1 run_multiple_progs() tests + + # NAME my test name + print "Ok\n"; + EXPECT + Ok + ######## + die "Time to die"; + EXPECT + OPTIONS fatal + Time to die at - line 1. + +Test files parsed by setup_multiple_progs() ignore any lines until a +C<__END__> line is found. This includes any test file based on +F. + +Tests are separated by lines containing exactly eight C<#>. + +A test (both code and expected result) can contain text matching +C]CONFLICT/> which is replaced by the C<< <=> >> repeated seven +times. This is used to test perl's conflict marker detection without +invoking git's complaints about it. + +Each test contains test code, followed by a line containing exactly +C followed by the expected output. + +The test code can contain a variety of control lines: + +=over + +=item * + +C< # NAME >I + +Specifies the name of the test, like the second argument to ok(). + +=item * + +C< # NOTE >I + +Completely ignored. + +=item * + +C< # SKIP ? >I + +=item * + +C< # TODO ? >I + +Conditionally TODO or skip() the test. If I evaluates to +a true value the result is used at the TODO or SKIP message, otherwise +the test is not skipped or TODOed. + +=item * + +C< # SKIP > I + +=item * + +C< # TODO > I + +SKIP or TODO the test with the given message. + +=back + +You can specify extra input files for the test, most typically to +define extra codee to be loaded by C. + +=over + +C<--FILE--> I + +... content for filename1 + +C<--FILE--> I + +... content for filename2 + +C<--FILE--> + +... content for the program + +=back + +If this found all but the first entry are written to their given +filenames, and the last entry is the program supplied to fresh_perl(). + +The expected result may include an C