lib/Test.pm

   1 use strict;
   2 package Test;
   3 use Test::Harness 1.1601 ();
   4 use Carp;
   5 use vars qw($VERSION @ISA @EXPORT $ntest %todo);
   6 $VERSION = '0.06';
   7 require Exporter;
   8 @ISA=('Exporter');
   9 @EXPORT= qw(&plan &ok &skip $ntest);
  10
  11 $|=1;
  12 #$^W=1;  ?
  13 $ntest=1;
  14
  15 # Use of this variable is strongly discouraged.  It is set
  16 # exclusively for test coverage analyzers.
  17 $ENV{REGRESSION_TEST} = $0;
  18
  19 sub plan {
  20     croak "Test::plan(%args): odd number of arguments" if @_ & 1;
  21     my $max=0;
  22     for (my $x=0; $x < @_; $x+=2) {
  23         my ($k,$v) = @_[$x,$x+1];
  24         if ($k =~ /^test(s)?$/) { $max = $v; }
  25         elsif ($k eq 'todo' or
  26                $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
  27         else { carp "Test::plan(): skipping unrecognized directive '$k'" }
  28     }
  29     my @todo = sort { $a <=> $b } keys %todo;
  30     if (@todo) {
  31         print "1..$max todo ".join(' ', @todo).";\n";
  32     } else {
  33         print "1..$max\n";
  34     }
  35 }
  36
  37 sub ok {
  38     my ($ok, $guess) = @_;
  39     carp "(this is ok $ntest)" if defined $guess && $guess != $ntest;
  40     $ok = $ok->() if (ref $ok or '') eq 'CODE';
  41     if ($ok) {
  42         if ($todo{$ntest}) {
  43             print("ok $ntest # Wow!\n");
  44         } else {
  45             print("ok $ntest # (failure expected)\n");
  46         }
  47     } else {
  48         print("not ok $ntest\n");
  49     }
  50     ++ $ntest;
  51     $ok;
  52 }
  53
  54 sub skip {
  55     my ($toskip, $ok, $guess) = @_;
  56     carp "(this is skip $ntest)" if defined $guess && $guess != $ntest;
  57     $toskip = $toskip->() if (ref $toskip or '') eq 'CODE';
  58     if ($toskip) {
  59         print "ok $ntest # skip\n";
  60         ++ $ntest;
  61         1;
  62     } else {
  63         ok($ok);
  64     }
  65 }
  66
  67 1;
  68 __END__
  69
  70 =head1 NAME
  71
  72   Test - provides a simple framework for writing test scripts
  73
  74 =head1 SYNOPSIS
  75
  76   use strict;
  77   use Test;
  78   BEGIN { plan tests => 5, todo => [3,4] }
  79
  80   ok(0); #failure
  81   ok(1); #success
  82
  83   ok(0); #ok, expected failure (see todo above)
  84   ok(1); #surprise success!
  85
  86   skip($feature_is_missing, sub {...});    #do platform specific test
  87
  88 =head1 DESCRIPTION
  89
  90 Test::Harness expects to see particular output when it executes test
  91 scripts.  This module tries to make conforming just a little bit
  92 easier (and less error prone).
  93
  94 =head1 TEST CATEGORIES
  95
  96 =over 4
  97
  98 =item * NORMAL TESTS
  99
 100 These tests are expected to succeed.  If they don't, something is
 101 wrong!
 102
 103 =item * SKIPPED TESTS
 104
 105 C<skip> should be used to skip tests for which a platform specific
 106 feature isn't available.
 107
 108 =item * TODO TESTS
 109
 110 TODO tests are designed for the purpose of maintaining an executable
 111 TODO list.  These tests are expected NOT to succeed (otherwise the
 112 feature they test would be on the new feature list, not the TODO
 113 list).
 114
 115 Packages should NOT be released with successful TODO tests.  As soon
 116 as a TODO test starts working, it should be promoted to a normal test
 117 and the new feature should be documented in the release notes.
 118
 119 =back
 120
 121 =head1 SEE ALSO
 122
 123 L<Test::Harness> and various test coverage analysis tools.
 124
 125 =head1 AUTHOR
 126
 127 Copyright © 1998 Joshua Nathaniel Pritikin.  All rights reserved.
 128
 129 This package is free software and is provided "as is" without express
 130 or implied warranty.  It may be used, redistributed and/or modified
 131 under the terms of the Perl Artistic License (see
 132 http://www.perl.com/perl/misc/Artistic.html)
 133
 134 =cut