This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Retract #20548 and #20465.
[perl5.git] / lib / Test / More.pm
index 617455f..d82f81d 100644 (file)
@@ -11,23 +11,25 @@ use Test::Builder;
 # actually happened.
 sub _carp {
     my($file, $line) = (caller(1))[1,2];
-    warn @_, sprintf " at $file line $line\n";
+    warn @_, " at $file line $line\n";
 }
 
 
 
 require Exporter;
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.33';
+$VERSION = '0.47';
 @ISA    = qw(Exporter);
 @EXPORT = qw(ok use_ok require_ok
-             is isnt like is_deeply
-             skip todo
+             is isnt like unlike is_deeply
+             cmp_ok
+             skip todo todo_skip
              pass fail
              eq_array eq_hash eq_set
              $TODO
              plan
              can_ok  isa_ok
+             diag
             );
 
 my $Test = Test::Builder->new;
@@ -38,7 +40,7 @@ sub _export_to_level
 {
       my $pkg = shift;
       my $level = shift;
-      (undef) = shift;                  # XXX redundant arg
+      (undef) = shift;                  # redundant arg
       my $callpkg = caller($level);
       $pkg->export($callpkg, @_);
 }
@@ -64,7 +66,14 @@ Test::More - yet another framework for writing test scripts
 
   is  ($this, $that,    $test_name);
   isnt($this, $that,    $test_name);
-  like($this, qr/that/, $test_name);
+
+  # Rather than print STDERR "# here's what went wrong\n"
+  diag("here's what went wrong");
+
+  like  ($this, qr/that/, $test_name);
+  unlike($this, qr/that/, $test_name);
+
+  cmp_ok($this, '==', $that, $test_name);
 
   is_deeply($complex_structure1, $complex_structure2, $test_name);
 
@@ -102,13 +111,15 @@ Test::More - yet another framework for writing test scripts
 
 =head1 DESCRIPTION
 
-If you're just getting started writing tests, have a look at
+B<STOP!> If you're just getting started writing tests, have a look at
 Test::Simple first.  This is a drop in replacement for Test::Simple
 which you can switch to once you get the hang of basic testing.
 
-This module provides a very wide range of testing utilities.  Various
-ways to say "ok", facilities to skip tests, test future features
-and compare complicated data structures.
+The purpose of this module is to provide a wide range of testing
+utilities.  Various ways to say "ok" with better diagnostics,
+facilities to skip tests, test future features and compare complicated
+data structures.  While you can do almost anything with a simple
+C<ok()> function, it doesn't provide good diagnostic output.
 
 
 =head2 I love it when a plan comes together
@@ -165,16 +176,18 @@ sub plan {
     my $caller = caller;
 
     $Test->exported_to($caller);
-    $Test->plan(@plan);
 
     my @imports = ();
     foreach my $idx (0..$#plan) {
         if( $plan[$idx] eq 'import' ) {
-            @imports = @{$plan[$idx+1]};
+            my($tag, $imports) = splice @plan, $idx, 2;
+            @imports = @$imports;
             last;
         }
     }
 
+    $Test->plan(@plan);
+
     __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
 }
 
@@ -187,7 +200,7 @@ sub import {
 =head2 Test names
 
 By convention, each test is assigned a number in order.  This is
-largely done automatically for you.  However, its often very useful to
+largely done automatically for you.  However, it's often very useful to
 assign a name to each test.  Which would you rather see:
 
   ok 4
@@ -204,7 +217,7 @@ The later gives you some idea of what failed.  It also makes it easier
 to find the test in your script, simply search for "simple
 exponential".
 
-All test functions take a name argument.  Its optional, but highly
+All test functions take a name argument.  It's optional, but highly
 suggested that you use it.
 
 
@@ -291,7 +304,7 @@ test:
 Will produce something like this:
 
     not ok 17 - Is foo the same as bar?
-    #     Failed test (foo.t at line 139)
+    #     Failed test (foo.t at line 139)
     #          got: 'waffle'
     #     expected: 'yarblokos'
 
@@ -320,27 +333,7 @@ sub is ($$;$) {
 }
 
 sub isnt ($$;$) {
-    my($this, $that, $name) = @_;
-
-    my $test;
-    {
-        local $^W = 0;   # so isnt(undef, undef) works quietly.
-        $test = $this ne $that;
-    }
-
-    my $ok = $Test->ok($test, $name);
-
-    unless( $ok ) {
-        $that = defined $that ? "'$that'" : 'undef';
-
-        $Test->diag(sprintf <<DIAGNOSTIC, $that);
-it should not be %s
-but it is.
-DIAGNOSTIC
-
-    }
-
-    return $ok;
+    $Test->isnt_eq(@_);
 }
 
 *isn't = \&isnt;
@@ -380,6 +373,59 @@ sub like ($$;$) {
     $Test->like(@_);
 }
 
+
+=item B<unlike>
+
+  unlike( $this, qr/that/, $test_name );
+
+Works exactly as like(), only it checks if $this B<does not> match the
+given pattern.
+
+=cut
+
+sub unlike {
+    $Test->unlike(@_);
+}
+
+
+=item B<cmp_ok>
+
+  cmp_ok( $this, $op, $that, $test_name );
+
+Halfway between ok() and is() lies cmp_ok().  This allows you to
+compare two arguments using any binary perl operator.
+
+    # ok( $this eq $that );
+    cmp_ok( $this, 'eq', $that, 'this eq that' );
+
+    # ok( $this == $that );
+    cmp_ok( $this, '==', $that, 'this == that' );
+
+    # ok( $this && $that );
+    cmp_ok( $this, '&&', $that, 'this || that' );
+    ...etc...
+
+Its advantage over ok() is when the test fails you'll know what $this
+and $that were:
+
+    not ok 1
+    #     Failed test (foo.t at line 12)
+    #     '23'
+    #         &&
+    #     undef
+
+It's also useful in those cases where you are comparing numbers and
+is()'s use of C<eq> will interfere:
+
+    cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+
+=cut
+
+sub cmp_ok($$$;$) {
+    $Test->cmp_ok(@_);
+}
+
+
 =item B<can_ok>
 
   can_ok($module, @methods);
@@ -400,25 +446,39 @@ is almost exactly like saying:
 only without all the typing and with a better interface.  Handy for
 quickly testing an interface.
 
+No matter how many @methods you check, a single can_ok() call counts
+as one test.  If you desire otherwise, use:
+
+    foreach my $meth (@methods) {
+        can_ok('Foo', $meth);
+    }
+
 =cut
 
 sub can_ok ($@) {
     my($proto, @methods) = @_;
-    my $class= ref $proto || $proto;
+    my $class = ref $proto || $proto;
+
+    unless( @methods ) {
+        my $ok = $Test->ok( 0, "$class->can(...)" );
+        $Test->diag('    can_ok() called with no methods');
+        return $ok;
+    }
 
     my @nok = ();
     foreach my $method (@methods) {
-        my $test = "'$class'->can('$method')";
-        eval $test || push @nok, $method;
+        local($!, $@);  # don't interfere with caller's $@
+                        # eval sometimes resets $!
+        eval { $proto->can($method) } || push @nok, $method;
     }
 
     my $name;
-    $name = @methods == 1 ? "$class->can($methods[0])" 
+    $name = @methods == 1 ? "$class->can('$methods[0]')" 
                           : "$class->can(...)";
     
     my $ok = $Test->ok( !@nok, $name );
 
-    $Test->diag(map "$class->can('$_') failed\n", @nok);
+    $Test->diag(map "    $class->can('$_') failed\n", @nok);
 
     return $ok;
 }
@@ -426,6 +486,7 @@ sub can_ok ($@) {
 =item B<isa_ok>
 
   isa_ok($object, $class, $object_name);
+  isa_ok($ref,    $type,  $ref_name);
 
 Checks to see if the given $object->isa($class).  Also checks to make
 sure the object was defined in the first place.  Handy for this sort
@@ -441,6 +502,10 @@ where you'd otherwise have to write
 
 to safeguard against your test script blowing up.
 
+It works on references, too:
+
+    isa_ok( $array_ref, 'ARRAY' );
+
 The diagnostics of this test normally just refer to 'the object'.  If
 you'd like them to be more specific, you can supply an $object_name
 (for example 'Test customer').
@@ -459,14 +524,37 @@ sub isa_ok ($$;$) {
     elsif( !ref $object ) {
         $diag = "$obj_name isn't a reference";
     }
-    elsif( !$object->isa($class) ) {
-        $diag = "$obj_name isn't a '$class'";
+    else {
+        # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+        local($@, $!);  # eval sometimes resets $!
+        my $rslt = eval { $object->isa($class) };
+        if( $@ ) {
+            if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+                if( !UNIVERSAL::isa($object, $class) ) {
+                    my $ref = ref $object;
+                    $diag = "$obj_name isn't a '$class' it's a '$ref'";
+                }
+            } else {
+                die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen.  Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+            }
+        }
+        elsif( !$rslt ) {
+            my $ref = ref $object;
+            $diag = "$obj_name isn't a '$class' it's a '$ref'";
+        }
     }
+            
+      
 
     my $ok;
     if( $diag ) {
         $ok = $Test->ok( 0, $name );
-        $Test->diag("$diag\n");
+        $Test->diag("    $diag\n");
     }
     else {
         $ok = $Test->ok( 1, $name );
@@ -503,6 +591,47 @@ sub fail (;$) {
 
 =back
 
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed.  But sometimes it doesn't work out
+that way.  So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+  diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output.  Handy for this sort of thing:
+
+    ok( grep(/foo/, @users), "There's a foo user" ) or
+        diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+    not ok 42 - There's a foo user
+    #     Failed test (foo.t at line 52)
+    # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=cut
+
+sub diag {
+    $Test->diag(@_);
+}
+
+
+=back
+
 =head2 Module tests
 
 You usually want to test if the module you're testing loads ok, rather
@@ -517,7 +646,7 @@ C<use_ok> and C<require_ok>.
    BEGIN { use_ok($module, @imports); }
 
 These simply use the given $module and test to make sure the load
-happened ok.  Its recommended that you run use_ok() inside a BEGIN
+happened ok.  It's recommended that you run use_ok() inside a BEGIN
 block so its functions are exported at compile-time and prototypes are
 properly honored.
 
@@ -529,6 +658,20 @@ is like doing this:
 
    use Some::Module qw(foo bar);
 
+don't try to do this:
+
+   BEGIN {
+       use_ok('Some::Module');
+
+       ...some code that depends on the use...
+       ...happening at compile time...
+   }
+
+instead, you want:
+
+  BEGIN { use_ok('Some::Module') }
+  BEGIN { ...some code that depends on the use... }
+
 
 =cut
 
@@ -538,10 +681,11 @@ sub use_ok ($;@) {
 
     my $pack = caller;
 
+    local($@,$!);   # eval sometimes interferes with $!
     eval <<USE;
 package $pack;
 require $module;
-$module->import(\@imports);
+'$module'->import(\@imports);
 USE
 
     my $ok = $Test->ok( !$@, "use $module;" );
@@ -549,8 +693,8 @@ USE
     unless( $ok ) {
         chomp $@;
         $Test->diag(<<DIAGNOSTIC);
-Tried to use '$module'.
-Error:  $@
+    Tried to use '$module'.
+    Error:  $@
 DIAGNOSTIC
 
     }
@@ -571,6 +715,7 @@ sub require_ok ($) {
 
     my $pack = caller;
 
+    local($!, $@); # eval sometimes interferes with $!
     eval <<REQUIRE;
 package $pack;
 require $module;
@@ -581,8 +726,8 @@ REQUIRE
     unless( $ok ) {
         chomp $@;
         $Test->diag(<<DIAGNOSTIC);
-    Tried to require '$module'.
-    Error:  $@
+    Tried to require '$module'.
+    Error:  $@
 DIAGNOSTIC
 
     }
@@ -594,9 +739,6 @@ DIAGNOSTIC
 
 =head2 Conditional tests
 
-B<WARNING!> The following describes an I<experimental> interface that
-is subject to change B<WITHOUT NOTICE>!  Use at your peril.
-
 Sometimes running a test under certain conditions will cause the
 test script to die.  A certain function or method isn't implemented
 (such as fork() on MacOS), some resource isn't available (like a 
@@ -604,7 +746,8 @@ net connection) or a module isn't available.  In these cases it's
 necessary to skip tests, or declare that they are supposed to fail
 but will work in the future (a todo test).
 
-For more details on skip and todo tests see L<Test::Harness>.
+For more details on the mechanics of skip and todo tests see
+L<Test::Harness>.
 
 The way Test::More handles this is with a named block.  Basically, a
 block of tests which can be skipped over or made todo.  It's best if I
@@ -620,34 +763,34 @@ just show you...
       ...normal testing code goes here...
   }
 
-This declares a block of tests to skip, $how_many tests there are,
-$why and under what $condition to skip them.  An example is the
-easiest way to illustrate:
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them.  An example is
+the easiest way to illustrate:
 
     SKIP: {
-        skip "Pigs don't fly here", 2 unless Pigs->can('fly');
+        eval { require HTML::Lint };
+
+        skip "HTML::Lint not installed", 2 if $@;
 
-        my $pig = Pigs->new;
-        $pig->takeoff;
+        my $lint = new HTML::Lint;
+        isa_ok( $lint, "HTML::Lint" );
 
-        ok( $pig->altitude > 0,         'Pig is airborne' );
-        ok( $pig->airspeed > 0,         '  and moving'    );
+        $lint->parse( $html );
+        is( $lint->errors, 0, "No errors found in HTML" );
     }
 
-If pigs cannot fly, the whole block of tests will be skipped
-completely.  Test::More will output special ok's which Test::Harness
-interprets as skipped tests.  Its important to include $how_many tests
-are in the block so the total number of tests comes out right (unless
-you're using C<no_plan>, in which case you can leave $how_many off if
-you like).
+If the user does not have HTML::Lint installed, the whole block of
+code I<won't be run at all>.  Test::More will output special ok's
+which Test::Harness interprets as skipped, but passing, tests.
+It's important that $how_many accurately reflects the number of tests
+in the SKIP block so the # of tests run will match up with your plan.
 
-You'll typically use this when a feature is missing, like an optional
-module is not installed or the operating system doesn't have some
-feature (like fork() or symlinks) or maybe you need an Internet
-connection and one isn't available.
+It's perfectly safe to nest SKIP blocks.  Each SKIP block must have
+the label C<SKIP>, or Test::More can't work its magic.
 
-=for _Future
-See L</Why are skip and todo so weird?>
+You don't skip tests which are failing because there's a bug in your
+program, or for which you don't yet have code written.  For that you
+use TODO.  Read on.
 
 =cut
 
@@ -674,7 +817,7 @@ sub skip {
 =item B<TODO: BLOCK>
 
     TODO: {
-        local $TODO = $why;
+        local $TODO = $why if $condition;
 
         ...normal testing code goes here...
     }
@@ -697,6 +840,8 @@ With a todo block, the tests inside are expected to fail.  Test::More
 will run the tests normally, but print out special flags indicating
 they are "todo".  Test::Harness will interpret failures as being ok.
 Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
 
 The nice part about todo tests, as opposed to simply commenting out a
 block of tests, is it's like having a programmatic todo list.  You know
@@ -707,6 +852,56 @@ Once a todo test starts succeeding, simply move it outside the block.
 When the block is empty, delete it.
 
 
+=item B<todo_skip>
+
+    TODO: {
+        todo_skip $why, $how_many if $condition;
+
+        ...normal testing code...
+    }
+
+With todo tests, it's best to have the tests actually run.  That way
+you'll know when they start passing.  Sometimes this isn't possible.
+Often a failing test will cause the whole program to die or hang, even
+inside an C<eval BLOCK> with and using C<alarm>.  In these extreme
+cases you have no choice but to skip over the broken tests entirely.
+
+The syntax and behavior is similar to a C<SKIP: BLOCK> except the
+tests will be marked as failing but todo.  Test::Harness will
+interpret them as passing.
+
+=cut
+
+sub todo_skip {
+    my($why, $how_many) = @_;
+
+    unless( defined $how_many ) {
+        # $how_many can only be avoided when no_plan is in use.
+        _carp "todo_skip() needs to know \$how_many tests are in the block"
+          unless $Test::Builder::No_Plan;
+        $how_many = 1;
+    }
+
+    for( 1..$how_many ) {
+        $Test->todo_skip($why);
+    }
+
+    local $^W = 0;
+    last TODO;
+}
+
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO.  This
+is for any code you haven't written yet, or bugs you have yet to fix,
+but want to put tests in your testing script (always a good idea).
+
+
 =back
 
 =head2 Comparison functions
@@ -729,6 +924,9 @@ references, it does a deep comparison walking each data structure to
 see if they are equivalent.  If the two structures are different, it
 will display the place where they start differing.
 
+Barrie Slaymaker's Test::Differences module provides more in-depth
+functionality along these lines, and it plays well with Test::More.
+
 B<NOTE> Display of scalar refs is not quite 100%
 
 =cut
@@ -793,6 +991,7 @@ sub _format_stack {
     $out .= "$vars[0] = $vals[0]\n";
     $out .= "$vars[1] = $vals[1]\n";
 
+    $out =~ s/^/    /msg;
     return $out;
 }
 
@@ -910,6 +1109,9 @@ Similar to eq_array(), except the order of the elements is B<not>
 important.  This is a deep check, but the irrelevancy of order only
 applies to the top level.
 
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
 =cut
 
 # We must make sure that references are treated neutrally.  It really
@@ -925,43 +1127,62 @@ sub eq_set  {
     return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
 }
 
-
 =back
 
-=head1 NOTES
 
-Test::More is B<explicitly> tested all the way back to perl 5.004.
+=head2 Extending and Embedding Test::More
 
-=head1 BUGS and CAVEATS
+Sometimes the Test::More interface isn't quite enough.  Fortunately,
+Test::More is built on top of Test::Builder which provides a single,
+unified backend for any test library to use.  This means two test
+libraries which both use Test::Builder B<can be used together in the
+same program>.
+
+If you simply want to do a little tweaking of how the tests behave,
+you can access the underlying Test::Builder object like so:
 
 =over 4
 
-=item Making your own ok()
+=item B<builder>
 
-This will not do what you mean:
+    my $test_builder = Test::More->builder;
 
-    sub my_ok {
-        ok( @_ );
-    }
+Returns the Test::Builder object underlying Test::More for you to play
+with.
 
-    my_ok( 2 + 2 == 5, 'Basic addition' );
+=cut
 
-since ok() takes it's arguments as scalars, it will see the length of
-@_ (2) and always pass the test.  You want to do this instead:
+sub builder {
+    return Test::Builder->new;
+}
 
-    sub my_ok {
-        ok( $_[0], $_[1] );
-    }
+=back
+
+
+=head1 NOTES
+
+Test::More is B<explicitly> tested all the way back to perl 5.004.
 
-The other functions act similarly.
+Test::More is thread-safe for perl 5.8.0 and up.
 
-=item The eq_* family have some caveats.
+=head1 BUGS and CAVEATS
+
+=over 4
+
+=item Making your own ok()
+
+If you are trying to extend Test::More, don't.  Use Test::Builder
+instead.
+
+=item The eq_* family has some caveats.
 
 =item Test::Harness upgrades
 
 no_plan and todo depend on new Test::Harness features and fixes.  If
-you're going to distribute tests that use no_plan your end-users will
-have to upgrade Test::Harness to the latest one on CPAN.
+you're going to distribute tests that use no_plan or todo your
+end-users will have to upgrade Test::Harness to the latest one on
+CPAN.  If you avoid no_plan and TODO tests, the stock Test::Harness
+will work fine.
 
 If you simply depend on Test::More, it's own dependencies will cause a
 Test::Harness upgrade.
@@ -987,10 +1208,14 @@ magic side-effects are kept to a minimum.  WYSIWYG.
 =head1 SEE ALSO
 
 L<Test::Simple> if all this confuses you and you just want to write
-some tests.  You can upgrade to Test::More later (its forward
+some tests.  You can upgrade to Test::More later (it's forward
 compatible).
 
-L<Test> for a similar testing module.
+L<Test::Differences> for more ways to test complex data structures.
+And it plays well with Test::More.
+
+L<Test> is the old testing module.  Its main benefit is that it has
+been distributed with Perl since 5.004_05.
 
 L<Test::Harness> for details on how your test results are interpreted
 by Perl.
@@ -1004,9 +1229,9 @@ L<SelfTest> is another approach to embedded testing.
 
 =head1 AUTHORS
 
-Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration from
-Joshua Pritikin's Test module and lots of discussion with Barrie
-Slaymaker and the perl-qa gang.
+Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
+from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
 
 
 =head1 COPYRIGHT
@@ -1016,7 +1241,7 @@ Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
 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>
+See F<http://www.perl.com/perl/misc/Artistic.html>
 
 =cut