This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In various POSIX tests, make better use of Test::More.
authorNicholas Clark <nick@ccl4.org>
Fri, 9 Sep 2011 16:10:19 +0000 (18:10 +0200)
committerNicholas Clark <nick@ccl4.org>
Tue, 13 Sep 2011 09:28:09 +0000 (11:28 +0200)
Avoid using ok() when alternatives are available, as ok() can't give useful
diagnostics on failure.

ext/POSIX/t/posix.t
ext/POSIX/t/sigaction.t
ext/POSIX/t/time.t

index aaa6e96..2610634 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 86;
+use Test::More tests => 87;
 
 use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
             errno localeconv);
@@ -51,8 +51,8 @@ if ($Is_VMS) {
 
 }
 
-
-ok( $testfd = open("Makefile.PL", O_RDONLY, 0),        'O_RDONLY with open' );
+my $testfd = open("Makefile.PL", O_RDONLY, 0);
+like($testfd, qr/\A\d+\z/, 'O_RDONLY with open');
 read($testfd, $buffer, 4) if $testfd > 2;
 is( $buffer, "# Ex",                      '    with read' );
 
@@ -64,22 +64,22 @@ TODO:
     is( $buffer[1], "perl\n",                 '    read to array element' );
 }
 
-write(1,"ok 4\nnot ok 4\n", 5);
-next_test();
+my $test = next_test();
+write(1,"ok $test\nnot ok $test\n", 5);
 
 SKIP: {
     skip("no pipe() support on DOS", 2) if $Is_Dos;
 
     @fds = POSIX::pipe();
-    ok( $fds[0] > $testfd,      'POSIX::pipe' );
+    cmp_ok($fds[0], '>', $testfd, 'POSIX::pipe');
 
     CORE::open($reader = \*READER, "<&=".$fds[0]);
     CORE::open($writer = \*WRITER, ">&=".$fds[1]);
-    print $writer "ok 6\n";
+    my $test = next_test();
+    print $writer "ok $test\n";
     close $writer;
     print <$reader>;
     close $reader;
-    next_test();
 }
 
 SKIP: {
@@ -144,7 +144,8 @@ SKIP: {
     skip("_POSIX_OPEN_MAX is inaccurate on MPE", 1) if $Is_MPE;
     skip("_POSIX_OPEN_MAX undefined ($fds[1])",  1) unless &_POSIX_OPEN_MAX;
 
-    ok( &_POSIX_OPEN_MAX >= 16, "The minimum allowed values according to susv2" );
+    cmp_ok(&_POSIX_OPEN_MAX, '>=', 16,
+          "The minimum allowed values according to susv2" );
 
 }
 
@@ -160,13 +161,14 @@ like( getcwd(), qr/$pat/, 'getcwd' );
 # Check string conversion functions.
 
 SKIP: { 
-    skip("strtod() not present", 1) unless $Config{d_strtod};
+    skip("strtod() not present", 2) unless $Config{d_strtod};
 
     $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
 
     # we're just checking that strtod works, not how accurate it is
     ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
-    ok((abs("3.14159" - $n) < 1e-6) && ($x == 6), 'strtod works');
+    cmp_ok(abs("3.14159" - $n), '<', 1e-6, 'strtod works');
+    is($x, 6, 'strtod works');
 
     &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
 }
@@ -188,14 +190,14 @@ SKIP: {
 }
 
 # Pick up whether we're really able to dynamically load everything.
-ok( &POSIX::acos(1.0) == 0.0,   'dynamic loading' );
+cmp_ok(&POSIX::acos(1.0), '==', 0.0, 'dynamic loading');
 
 # This can coredump if struct tm has a timezone field and we
 # didn't detect it.  If this fails, try adding
 # -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
 # See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl 
-print POSIX::strftime("ok 21 # %H:%M, on %m/%d/%y\n", localtime());
-next_test();
+$test = next_test();
+print POSIX::strftime("ok $test # %H:%M, on %m/%d/%y\n", localtime());
 
 # If that worked, validate the mini_mktime() routine's normalisation of
 # input fields to strftime().
index 81d699d..1d0315f 100644 (file)
@@ -11,7 +11,7 @@ BEGIN{
        }
 }
 
-use Test::More tests => 32;
+use Test::More tests => 33;
 
 use strict;
 use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
@@ -19,15 +19,15 @@ use vars qw/$bad $bad7 $ok10 $bad18 $ok/;
 $^W=1;
 
 sub IGNORE {
-       $bad7=1;
+    ++$bad7;
 }
 
 sub DEFAULT {
-       $bad18=1;
+    ++$bad18;
 }
 
 sub foo {
-       $ok=1;
+    ++$ok;
 }
 
 my $newaction=POSIX::SigAction->new('::foo', new POSIX::SigSet(SIGUSR1), 0);
@@ -37,11 +37,10 @@ my $oldaction=POSIX::SigAction->new('::bar', new POSIX::SigSet(), 0);
        my $bad;
        local($SIG{__WARN__})=sub { $bad=1; };
        sigaction(SIGHUP, $newaction, $oldaction);
-       ok(!$bad, "no warnings");
+       is($bad, undef, "no warnings");
 }
 
-ok($oldaction->{HANDLER} eq 'DEFAULT' ||
-   $oldaction->{HANDLER} eq 'IGNORE', $oldaction->{HANDLER});
+like($oldaction->{HANDLER}, qr/\A(?:DEFAULT|IGNORE)\z/, '$oldaction->{HANDLER}');
 
 is($SIG{HUP}, '::foo');
 
@@ -59,19 +58,19 @@ SKIP: {
 $newaction=POSIX::SigAction->new('IGNORE');
 sigaction(SIGHUP, $newaction);
 kill 'HUP', $$;
-ok(!$bad, "SIGHUP ignored");
+is($bad, undef, "SIGHUP ignored");
 
 is($SIG{HUP}, 'IGNORE');
 sigaction(SIGHUP, POSIX::SigAction->new('DEFAULT'));
 is($SIG{HUP}, 'DEFAULT');
 
-$newaction=POSIX::SigAction->new(sub { $ok10=1; });
+$newaction=POSIX::SigAction->new(sub { ++$ok10; });
 sigaction(SIGHUP, $newaction);
 {
        local($^W)=0;
        kill 'HUP', $$;
 }
-ok($ok10, "SIGHUP handler called");
+is($ok10, 1, "SIGHUP handler called");
 
 is(ref($SIG{HUP}), 'CODE');
 
@@ -83,13 +82,14 @@ eval {
        sigaction(SIGINT, $act);
 };
 kill 'HUP', $$;
-ok($ok, "signal mask gets restored after croak");
+is($ok, 1, "signal mask gets restored after croak");
 
 undef $ok;
 # Make sure the signal mask gets restored after sigaction returns early.
 my $x=defined sigaction(SIGKILL, $newaction, $oldaction);
 kill 'HUP', $$;
-ok(!$x && $ok, "signal mask gets restored after early return");
+is($x, '', "signal mask gets restored after early return");
+is($ok, 1, "signal mask gets restored after early return");
 
 $SIG{HUP}=sub {};
 sigaction(SIGHUP, $newaction, $oldaction);
@@ -98,22 +98,23 @@ is(ref($oldaction->{HANDLER}), 'CODE');
 eval {
        sigaction(SIGHUP, undef, $oldaction);
 };
-ok(!$@, "undef for new action");
+is($@, '', "undef for new action");
 
 eval {
        sigaction(SIGHUP, 0, $oldaction);
 };
-ok(!$@, "zero for new action");
+is($@, '', "zero for new action");
 
 eval {
        sigaction(SIGHUP, bless({},'Class'), $oldaction);
 };
-ok($@, "any object not good as new action");
+like($@, qr/\Aaction is not of type POSIX::SigAction/,
+     'any object not good as new action');
 
 SKIP: {
     skip("SIGCONT not trappable in $^O", 1)
        if ($^O eq 'VMS');
-    $newaction=POSIX::SigAction->new(sub { $ok10=1; });
+    $newaction=POSIX::SigAction->new(sub { ++$ok10; });
     if (eval { SIGCONT; 1 }) {
        sigaction(SIGCONT, POSIX::SigAction->new('DEFAULT'));
        {
@@ -121,7 +122,7 @@ SKIP: {
            kill 'CONT', $$;
        }
     }
-    ok(!$bad18, "SIGCONT trappable");
+    is($bad18, undef, "SIGCONT trappable");
 }
 
 {
@@ -134,7 +135,7 @@ SKIP: {
     sub hup21 { $hup21++ }
 
     sigaction("FOOBAR", $newaction);
-    ok(1, "no coredump, still alive");
+    pass("no coredump, still alive");
 
     $newaction = POSIX::SigAction->new("hup20");
     sigaction("SIGHUP", $newaction);
@@ -171,7 +172,7 @@ ok($oldaction->safe, "SigAction can be safe");
 # And safe signal delivery must work
 $ok = 0;
 kill 'HUP', $$;
-ok($ok, "safe signal delivery must work");
+is($ok, 1, "safe signal delivery must work");
 
 SKIP: {
     eval 'use POSIX qw(%SIGRT SIGRTMIN SIGRTMAX); scalar %SIGRT + SIGRTMIN() + SIGRTMAX()';
@@ -179,7 +180,7 @@ SKIP: {
     || SIGRTMIN() < 0 || SIGRTMAX() < 0        # HP-UX 10.20 exports both as -1
     || SIGRTMIN() > $Config{sig_count} # AIX 4.3.3 exports bogus 888 and 999
        and skip("no SIGRT signals", 4);
-    ok(SIGRTMAX() > SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
+    cmp_ok(SIGRTMAX(), '>', SIGRTMIN(), "SIGRTMAX > SIGRTMIN");
     is(scalar %SIGRT, SIGRTMAX() - SIGRTMIN() + 1, "scalar SIGRT");
     my $sigrtmin;
     my $h = sub { $sigrtmin = 1 };
index 7b8a52c..90b54ca 100644 (file)
@@ -74,7 +74,7 @@ setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";
 # and BSD.  Cygwin, Win32, and Linux lean the BSD way.  So, the tests just
 # check the basics.
 like(clock(), qr/\d*/, "clock() returns a numeric value");
-ok(clock() >= 0, "...and it returns something >= 0");
+cmp_ok(clock(), '>=', 0, "...and it returns something >= 0");
 
 SKIP: {
     skip "No difftime()", 1 if $Config{d_difftime} ne 'define';