1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8$Ok_Level = 0; 9my $test = 1; 10sub ok ($;$) { 11 my($ok, $name) = @_; 12 13 local $_; 14 15 # You have to do it this way or VMS will get confused. 16 printf "%s $test%s\n", $ok ? 'ok' : 'not ok', 17 $name ? " - $name" : ''; 18 19 printf "# Failed test at line %d\n", (caller($Ok_Level))[2] unless $ok; 20 21 $test++; 22 return $ok; 23} 24 25sub nok ($;$) { 26 my($nok, $name) = @_; 27 local $Ok_Level = 1; 28 ok( !$nok, $name ); 29} 30 31use Config; 32my $have_alarm = $Config{d_alarm}; 33sub alarm_ok (&) { 34 my $test = shift; 35 36 local $SIG{ALRM} = sub { die "timeout\n" }; 37 38 my $match; 39 eval { 40 alarm(2) if $have_alarm; 41 $match = $test->(); 42 alarm(0) if $have_alarm; 43 }; 44 45 local $Ok_Level = 1; 46 ok( !$match && !$@, 'testing studys that used to hang' ); 47} 48 49 50print "1..26\n"; 51 52$x = "abc\ndef\n"; 53study($x); 54 55ok($x =~ /^abc/); 56ok($x !~ /^def/); 57 58# used to be a test for $* 59ok($x =~ /^def/m); 60 61$_ = '123'; 62study; 63ok(/^([0-9][0-9]*)/); 64 65nok($x =~ /^xxx/); 66nok($x !~ /^abc/); 67 68ok($x =~ /def/); 69nok($x !~ /def/); 70 71study($x); 72ok($x !~ /.def/); 73nok($x =~ /.def/); 74 75ok($x =~ /\ndef/); 76nok($x !~ /\ndef/); 77 78$_ = 'aaabbbccc'; 79study; 80ok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc'); 81ok(/(a+b+c+)/ && $1 eq 'aaabbbccc'); 82 83nok(/a+b?c+/); 84 85$_ = 'aaabccc'; 86study; 87ok(/a+b?c+/); 88ok(/a*b+c*/); 89 90$_ = 'aaaccc'; 91study; 92ok(/a*b?c*/); 93nok(/a*b+c*/); 94 95$_ = 'abcdef'; 96study; 97ok(/bcd|xyz/); 98ok(/xyz|bcd/); 99 100ok(m|bc/*d|); 101 102ok(/^$_$/); 103 104# used to be a test for $* 105ok("ab\ncd\n" =~ /^cd/m); 106 107if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'MacOS') { 108 # Even with the alarm() OS/390 and BS2000 can't manage these tests 109 # (Perl just goes into a busy loop, luckily an interruptable one) 110 for (25..26) { print "not ok $_ # TODO compiler bug?\n" } 111 $test += 2; 112} else { 113 # [ID 20010618.006] tests 25..26 may loop 114 115 $_ = 'FGF'; 116 study; 117 alarm_ok { /G.F$/ }; 118 alarm_ok { /[F]F$/ }; 119} 120 121