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/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
 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
 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';
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 }
 
-use Test::More tests => 8;
 use Config;
 
 use Config;
 
+require "test.pl";
+plan(tests => 8);
+
 ok( binmode(STDERR),            'STDERR made binary' );
 if ($Config{useperlio}) {
   ok( binmode(STDERR, ":unix"),   '  with unix discipline' );
 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.
     # 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.
 
 # 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);
 }
 
     rel2abs(curdir);
 }
 
-use Test::More tests => 25;
-
 my $cwd = abs_path;
 
 # Let's get to a known position
 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';
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib');
+    @INC = qw(. ../lib);
 }
 
 }
 
-use Config;
-
 BEGIN {
 BEGIN {
-    require Test::More;
+    use Config;
+
+    require "test.pl";
 
     if( !$Config{d_crypt} ) {
 
     if( !$Config{d_crypt} ) {
-        Test::More->import('skip_all');
+        skip_all("crypt unimplemented");
     }
     else {
     }
     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.
 
 # 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';
 
 # Tests for the coderef-in-@INC feature
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 use File::Spec;
 }
 
 use File::Spec;
-use Test::More tests => 39;
+
+require "test.pl";
+plan(tests => 39);
 
 my @tempfiles = ();
 
 
 my @tempfiles = ();
 
index 44bf0ff..060d46a 100755 (executable)
 
 BEGIN {
     chdir "t" if -d "t";
 
 BEGIN {
     chdir "t" if -d "t";
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 use strict;
 use Config;
 }
 
 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.
 
 
 my $reps = 10000;      # How many times to try rand each time.
index bbd0e54..e809673 100644 (file)
@@ -1,9 +1,16 @@
 #!./perl -w
 
 #!./perl -w
 
+BEGIN {
+    chdir "t" if -d "t";
+    @INC = qw(. ../lib);
+}
+
 # Test srand.
 
 use strict;
 # 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.
 
 # 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';
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
     $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
 }
 
     $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;
 
 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; $@");
 
 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';
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    @INC = qw(. ../lib);
 }
 
 # VMS and Windows need -e "...", most everything else works better with '
 }
 
 # VMS and Windows need -e "...", most everything else works better with '
@@ -22,7 +22,8 @@ BEGIN {
     $numtests = ($^O eq 'VMS') ? 7 : 3; 
 }
 
     $numtests = ($^O eq 'VMS') ? 7 : 3; 
 }
 
-use Test::More tests => $numtests;
+require "test.pl";
+plan(tests => $numtests);
 
 my $exit, $exit_arg;
 
 
 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;