This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert t/op/study.t to use test.pl, strict and warnings.
authorNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 19:35:00 +0000 (19:35 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 12 Mar 2011 19:41:49 +0000 (19:41 +0000)
Replace its alarm_ok() with test.pl's watchdog().

t/op/study.t

index b407c6f..0e3ddb6 100644 (file)
@@ -1,53 +1,18 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 }
 
-$Ok_Level = 0;
-my $test = 1;
-sub ok ($;$) {
-    my($ok, $name) = @_;
-
-    local $_;
-
-    # You have to do it this way or VMS will get confused.
-    printf "%s $test%s\n", $ok   ? 'ok' : 'not ok',
-                           $name ? " - $name" : '';
-
-    printf "# Failed test at line %d\n", (caller($Ok_Level))[2] unless $ok;
-
-    $test++;
-    return $ok;
-}
-
-sub nok ($;$) {
-    my($nok, $name) = @_;
-    local $Ok_Level = 1;
-    ok( !$nok, $name );
-}
+watchdog(10);
+plan(tests => 29);
+use strict;
+use vars '$x';
 
 use Config;
 my $have_alarm = $Config{d_alarm};
 
 use Config;
 my $have_alarm = $Config{d_alarm};
-sub alarm_ok (&) {
-    my $test = shift;
-
-    local $SIG{ALRM} = sub { die "timeout\n" };
-    
-    my $match;
-    eval { 
-        alarm(2) if $have_alarm;
-        $match = $test->();
-        alarm(0) if $have_alarm;
-    };
-
-    local $Ok_Level = 1;
-    ok( !$match && !$@, 'testing studys that used to hang' );
-}
-
-
-print "1..26\n";
 
 $x = "abc\ndef\n";
 study($x);
 
 $x = "abc\ndef\n";
 study($x);
@@ -62,25 +27,28 @@ $_ = '123';
 study;
 ok(/^([0-9][0-9]*)/);
 
 study;
 ok(/^([0-9][0-9]*)/);
 
-nok($x =~ /^xxx/);
-nok($x !~ /^abc/);
+ok(!($x =~ /^xxx/));
+ok(!($x !~ /^abc/));
 
 ok($x =~ /def/);
 
 ok($x =~ /def/);
-nok($x !~ /def/);
+ok(!($x !~ /def/));
 
 study($x);
 ok($x !~ /.def/);
 
 study($x);
 ok($x !~ /.def/);
-nok($x =~ /.def/);
+ok(!($x =~ /.def/));
 
 ok($x =~ /\ndef/);
 
 ok($x =~ /\ndef/);
-nok($x !~ /\ndef/);
+ok(!($x !~ /\ndef/));
 
 $_ = 'aaabbbccc';
 study;
 
 $_ = 'aaabbbccc';
 study;
-ok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc');
-ok(/(a+b+c+)/ && $1 eq 'aaabbbccc');
+ok(/(a*b*)(c*)/);
+is($1, 'aaabbb');
+is($2,'ccc');
+ok(/(a+b+c+)/);
+is($1, 'aaabbbccc');
 
 
-nok(/a+b?c+/);
+ok(!/a+b?c+/);
 
 $_ = 'aaabccc';
 study;
 
 $_ = 'aaabccc';
 study;
@@ -90,7 +58,7 @@ ok(/a*b+c*/);
 $_ = 'aaaccc';
 study;
 ok(/a*b?c*/);
 $_ = 'aaaccc';
 study;
 ok(/a*b?c*/);
-nok(/a*b+c*/);
+ok(!/a*b+c*/);
 
 $_ = 'abcdef';
 study;
 
 $_ = 'abcdef';
 study;
@@ -104,17 +72,16 @@ ok(/^$_$/);
 # used to be a test for $*
 ok("ab\ncd\n" =~ /^cd/m);
 
 # used to be a test for $*
 ok("ab\ncd\n" =~ /^cd/m);
 
-if ($^O eq 'os390' or $^O eq 'posix-bc') {
+TODO: {
     # Even with the alarm() OS/390 and BS2000 can't manage these tests
     # (Perl just goes into a busy loop, luckily an interruptable one)
     # Even with the alarm() OS/390 and BS2000 can't manage these tests
     # (Perl just goes into a busy loop, luckily an interruptable one)
-    for (25..26) { print "not ok $_ # TODO compiler bug?\n" }
-    $test += 2;
-} else {
-    # [ID 20010618.006] tests 25..26 may loop
+    todo_skip('busy loop - compiler bug?', 2)
+             if $^O eq 'os390' or $^O eq 'posix-bc';
+
+    # [ID ] tests 25..26 may loop
 
     $_ = 'FGF';
     study;
 
     $_ = 'FGF';
     study;
-    alarm_ok { /G.F$/ };
-    alarm_ok { /[F]F$/ };
+    ok(!/G.F$/, 'bug 20010618.006');
+    ok(!/[F]F$/, 'bug 20010618.006');
 }
 }
-