This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Replace the use Test::More in t/{op,io,run} with t/test.pl.
authorJarkko Hietaniemi <jhi@iki.fi>
Tue, 25 Sep 2001 14:27:01 +0000 (14:27 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Tue, 25 Sep 2001 14:27:01 +0000 (14:27 +0000)
Note: io/binmode is failing, have to figure out why.

p4raw-id: //depot/perl@12198

MANIFEST
t/io/binmode.t
t/op/chdir.t
t/op/crypt.t
t/op/inccode.t
t/op/rand.t
t/op/srand.t
t/op/ver.t
t/run/exit.t
t/test.pl [new file with mode: 0644]

index 1b8c036..d10e42d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2204,11 +2204,12 @@ t/run/exit.t                    Test perl's exit status.
 t/run/kill_perl.t               Tests that kill perl.
 t/run/runenv.t                 Test if perl honors its environment variables.
 t/TEST                         The regression tester
+t/test.pl                      Simple testing library
 t/TestInit.pm                  Preamble library for core tests
 taint.c                                Tainting code
 thrdvar.h                      Per-thread variables
 thread.h                       Threading header
-Todo.micro             The Wishlist for microperl
+Todo.micro                     The Wishlist for microperl
 toke.c                         The tokener
 uconfig.h                      Configuration header for microperl
 uconfig.sh                     Configuration script for microperl
index 34a462d..4991d5e 100644 (file)
@@ -2,12 +2,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
-use Test::More tests => 8;
 use Config;
 
+require "test.pl";
+plan(tests => 8);
+
 ok( binmode(STDERR),            'STDERR made binary' );
 if ($Config{useperlio}) {
   ok( binmode(STDERR, ":unix"),   '  with unix discipline' );
index af13e80..b44cd6f 100644 (file)
@@ -2,9 +2,11 @@ BEGIN {
     # We're not going to chdir() into 't' because we don't know if
     # chdir() works!  Instead, we'll hedge our bets and put both
     # possibilities into @INC.
-    @INC = ('lib', '../lib');
+    @INC = qw(t . lib ../lib);
 }
 
+require "test.pl";
+plan(tests => 25);
 
 # Might be a little early in the testing process to start using these,
 # but I can't think of a way to write this test without them.
@@ -16,8 +18,6 @@ sub abs_path {
     rel2abs(curdir);
 }
 
-use Test::More tests => 25;
-
 my $cwd = abs_path;
 
 # Let's get to a known position
index 8326a09..8beb41d 100644 (file)
@@ -1,20 +1,20 @@
-#!./perl -Tw
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib');
+    @INC = qw(. ../lib);
 }
 
-use Config;
-
 BEGIN {
-    require Test::More;
+    use Config;
+
+    require "test.pl";
 
     if( !$Config{d_crypt} ) {
-        Test::More->import('skip_all');
+        skip_all("crypt unimplemented");
     }
     else {
-        Test::More->import(tests => 2);
+        plan(tests => 2);
     }
 }
 
@@ -28,10 +28,6 @@ BEGIN {
 # bets, given alternative encryption/hashing schemes like MD5,
 # C2 (or higher) security schemes, and non-UNIX platforms.
 
-SKIP: {
-    skip "crypt unimplemented", 2, unless $Config{d_crypt};
-    
-    ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference");
+ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference");
 
-    ok(crypt("HI", "HO") eq crypt(join("",map{chr($_+256)}unpack"C*","HI"), "HO"), "low eight bits of Unicode");
-}
+ok(crypt("HI", "HO") eq crypt(join("",map{chr($_+256)}unpack"C*","HI"), "HO"), "low eight bits of Unicode");
index 71beb3e..3ccea1a 100644 (file)
@@ -1,14 +1,16 @@
-#!./perl -wT
+#!./perl -w
 
 # Tests for the coderef-in-@INC feature
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 use File::Spec;
-use Test::More tests => 39;
+
+require "test.pl";
+plan(tests => 39);
 
 my @tempfiles = ();
 
index 44bf0ff..060d46a 100755 (executable)
 
 BEGIN {
     chdir "t" if -d "t";
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 use strict;
 use Config;
-use Test::More tests => 8;
+
+require "test.pl";
+plan(tests => 8);
 
 
 my $reps = 10000;      # How many times to try rand each time.
index bbd0e54..e809673 100644 (file)
@@ -1,9 +1,16 @@
 #!./perl -w
 
+BEGIN {
+    chdir "t" if -d "t";
+    @INC = qw(. ../lib);
+}
+
 # Test srand.
 
 use strict;
-use Test::More tests => 4;
+
+require "test.pl";
+plan(tests => 4);
 
 # Generate a load of random numbers.
 # int() avoids possible floating point error.
index f64cf47..31bd09c 100755 (executable)
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
     $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
 }
 
@@ -11,8 +11,8 @@ $DOWARN = 1; # enable run-time warnings now
 use Config;
 $tests = $Config{'uvsize'} == 8 ? 47 : 44;
 
-require Test::More;
-Test::More->import( tests => $tests );
+require "test.pl";
+plan( tests => $tests );
 
 eval { use v5.5.640; };
 is( $@, '', "use v5.5.640; $@");
index 2b8ba89..5305bd2 100644 (file)
@@ -5,7 +5,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 # VMS and Windows need -e "...", most everything else works better with '
@@ -22,7 +22,8 @@ BEGIN {
     $numtests = ($^O eq 'VMS') ? 7 : 3; 
 }
 
-use Test::More tests => $numtests;
+require "test.pl";
+plan(tests => $numtests);
 
 my $exit, $exit_arg;
 
diff --git a/t/test.pl b/t/test.pl
new file mode 100644 (file)
index 0000000..c7c9908
--- /dev/null
+++ b/t/test.pl
@@ -0,0 +1,146 @@
+#
+# t/test.pl - most of Test::More functionality without the fuss
+#
+
+my $test = 1;
+my $planned;
+
+sub plan {
+    my $n;
+    if (@_ == 1) {
+       $n = shift;
+    } else {
+       my %plan = @_;
+       $n = $plan{tests}; 
+    }
+    print "1..$n\n";
+    $planned = $n;
+}
+
+END {
+    my $ran = $test - 1;
+    if (defined $planned && $planned != $ran) {
+       print "# Looks like you planned $planned tests but ran $ran.\n";
+    }
+}
+
+sub skip_all {
+    if (@_) {
+       print "1..0 - @_\n";
+    } else {
+       print "1..0\n";
+    }
+    exit(0);
+}
+
+sub _ok {
+    my ($pass, $where, @mess) = @_;
+    # Do not try to microoptimize by factoring out the "not ".
+    # VMS will avenge.
+    if (@mess) {
+       print $pass ? "ok $test - @mess\n" : "not ok $test - @mess\n";
+    } else {
+       print $pass ? "ok $test\n" : "not ok $test\n";
+    }
+    unless ($pass) {
+       print "# Failed $where\n";
+    }
+    $test++;
+}
+
+sub _where {
+    my @caller = caller(1);
+    return "at $caller[1] line $caller[2]";
+}
+
+sub ok {
+    my ($pass, @mess) = @_;
+    _ok($pass, _where(), @mess);
+}
+
+sub _expect {
+    my ($got, $pass, @mess) = @_;
+    if ($pass) {
+       ok(1, @mess);
+    } else {
+       ok(0, @mess);
+    }
+} 
+
+sub is {
+    my ($got, $expected, @mess) = @_;
+    my $pass = $got eq $expected;
+    unless ($pass) {
+       unshift(@mess, "\n",
+               "#      got '$got'\n",
+               "# expected '$expected'\n");
+    }
+    _expect($pass, _where(), @mess);
+}
+
+# Note: this isn't quite as fancy as Test::More::like().
+sub like {
+    my ($got, $expected, @mess) = @_;
+    my $pass;
+    if (ref $expected eq 'Regexp') {
+       $pass = $got =~ $expected;
+       unless ($pass) {
+           unshift(@mess, "\n",
+                   "#      got '$got'\n");
+       }
+    } else {
+       $pass = $got =~ /$expected/;
+       unless ($pass) {
+           unshift(@mess, "\n",
+                   "#      got '$got'\n",
+                   "# expected /$expected/\n");
+       }
+    }
+    _expect($pass, _where(), @mess);
+}
+
+sub pass {
+    _ok(1, '', @_);
+}
+
+sub fail {
+    _ok(0, _where(), @_);
+}
+
+# Note: can't pass multipart messages since we try to
+# be compatible with Test::More::skip().
+sub skip {
+    my ($mess, $n) = @_;
+    for (1..$n) {
+       ok(1, "# skip:", $mess);
+    }
+    local $^W = 0;
+    last SKIP;
+}
+
+sub eq_array {
+    my ($ra, $rb) = @_;
+    return 0 unless $#$ra == $#$rb;
+    for my $i (0..$#$ra) {
+       return 0 unless $ra->[$i] eq $rb->[$i];
+    }
+    return 1;
+}
+
+sub require_ok {
+    my ($require) = @_;
+    eval <<REQUIRE_OK;
+require $require;
+REQUIRE_OK
+    ok(!$@, "require $require");
+}
+
+sub use_ok {
+    my ($use) = @_;
+    eval <<USE_OK;
+use $use;
+USE_OK
+    ok(!$@, "use $use");
+}
+
+1;