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$* = 1; 59ok($x =~ /^def/); 60$* = 0; 61 62$_ = '123'; 63study; 64ok(/^([0-9][0-9]*)/); 65 66nok($x =~ /^xxx/); 67nok($x !~ /^abc/); 68 69ok($x =~ /def/); 70nok($x !~ /def/); 71 72study($x); 73ok($x !~ /.def/); 74nok($x =~ /.def/); 75 76ok($x =~ /\ndef/); 77nok($x !~ /\ndef/); 78 79$_ = 'aaabbbccc'; 80study; 81ok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc'); 82ok(/(a+b+c+)/ && $1 eq 'aaabbbccc'); 83 84nok(/a+b?c+/); 85 86$_ = 'aaabccc'; 87study; 88ok(/a+b?c+/); 89ok(/a*b+c*/); 90 91$_ = 'aaaccc'; 92study; 93ok(/a*b?c*/); 94nok(/a*b+c*/); 95 96$_ = 'abcdef'; 97study; 98ok(/bcd|xyz/); 99ok(/xyz|bcd/); 100 101ok(m|bc/*d|); 102 103ok(/^$_$/); 104 105$* = 1; # test 3 only tested the optimized version--this one is for real 106ok("ab\ncd\n" =~ /^cd/); 107 108if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'MacOS') { 109 # Even with the alarm() OS/390 and BS2000 can't manage these tests 110 # (Perl just goes into a busy loop, luckily an interruptable one) 111 for (25..26) { print "not ok $_ # TODO compiler bug?\n" } 112 $test += 2; 113} else { 114 # [ID 20010618.006] tests 25..26 may loop 115 116 $_ = 'FGF'; 117 study; 118 alarm_ok { /G.F$/ }; 119 alarm_ok { /[F]F$/ }; 120} 121 122