-#!./perl
+#!./perl -w
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};
-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);
study;
ok(/^([0-9][0-9]*)/);
-nok($x =~ /^xxx/);
-nok($x !~ /^abc/);
+ok(!($x =~ /^xxx/));
+ok(!($x !~ /^abc/));
ok($x =~ /def/);
-nok($x !~ /def/);
+ok(!($x !~ /def/));
study($x);
ok($x !~ /.def/);
-nok($x =~ /.def/);
+ok(!($x =~ /.def/));
ok($x =~ /\ndef/);
-nok($x !~ /\ndef/);
+ok(!($x !~ /\ndef/));
$_ = '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;
$_ = 'aaaccc';
study;
ok(/a*b?c*/);
-nok(/a*b+c*/);
+ok(!/a*b+c*/);
$_ = 'abcdef';
study;
# 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)
- 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;
- alarm_ok { /G.F$/ };
- alarm_ok { /[F]F$/ };
+ ok(!/G.F$/, 'bug 20010618.006');
+ ok(!/[F]F$/, 'bug 20010618.006');
}
-