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