1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A}
1N/A
1N/A$Ok_Level = 0;
1N/Amy $test = 1;
1N/Asub ok ($;$) {
1N/A my($ok, $name) = @_;
1N/A
1N/A local $_;
1N/A
1N/A # You have to do it this way or VMS will get confused.
1N/A printf "%s $test%s\n", $ok ? 'ok' : 'not ok',
1N/A $name ? " - $name" : '';
1N/A
1N/A printf "# Failed test at line %d\n", (caller($Ok_Level))[2] unless $ok;
1N/A
1N/A $test++;
1N/A return $ok;
1N/A}
1N/A
1N/Asub nok ($;$) {
1N/A my($nok, $name) = @_;
1N/A local $Ok_Level = 1;
1N/A ok( !$nok, $name );
1N/A}
1N/A
1N/Ause Config;
1N/Amy $have_alarm = $Config{d_alarm};
1N/Asub alarm_ok (&) {
1N/A my $test = shift;
1N/A
1N/A local $SIG{ALRM} = sub { die "timeout\n" };
1N/A
1N/A my $match;
1N/A eval {
1N/A alarm(2) if $have_alarm;
1N/A $match = $test->();
1N/A alarm(0) if $have_alarm;
1N/A };
1N/A
1N/A local $Ok_Level = 1;
1N/A ok( !$match && !$@, 'testing studys that used to hang' );
1N/A}
1N/A
1N/A
1N/Aprint "1..26\n";
1N/A
1N/A$x = "abc\ndef\n";
1N/Astudy($x);
1N/A
1N/Aok($x =~ /^abc/);
1N/Aok($x !~ /^def/);
1N/A
1N/A$* = 1;
1N/Aok($x =~ /^def/);
1N/A$* = 0;
1N/A
1N/A$_ = '123';
1N/Astudy;
1N/Aok(/^([0-9][0-9]*)/);
1N/A
1N/Anok($x =~ /^xxx/);
1N/Anok($x !~ /^abc/);
1N/A
1N/Aok($x =~ /def/);
1N/Anok($x !~ /def/);
1N/A
1N/Astudy($x);
1N/Aok($x !~ /.def/);
1N/Anok($x =~ /.def/);
1N/A
1N/Aok($x =~ /\ndef/);
1N/Anok($x !~ /\ndef/);
1N/A
1N/A$_ = 'aaabbbccc';
1N/Astudy;
1N/Aok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc');
1N/Aok(/(a+b+c+)/ && $1 eq 'aaabbbccc');
1N/A
1N/Anok(/a+b?c+/);
1N/A
1N/A$_ = 'aaabccc';
1N/Astudy;
1N/Aok(/a+b?c+/);
1N/Aok(/a*b+c*/);
1N/A
1N/A$_ = 'aaaccc';
1N/Astudy;
1N/Aok(/a*b?c*/);
1N/Anok(/a*b+c*/);
1N/A
1N/A$_ = 'abcdef';
1N/Astudy;
1N/Aok(/bcd|xyz/);
1N/Aok(/xyz|bcd/);
1N/A
1N/Aok(m|bc/*d|);
1N/A
1N/Aok(/^$_$/);
1N/A
1N/A$* = 1; # test 3 only tested the optimized version--this one is for real
1N/Aok("ab\ncd\n" =~ /^cd/);
1N/A
1N/Aif ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'MacOS') {
1N/A # Even with the alarm() OS/390 and BS2000 can't manage these tests
1N/A # (Perl just goes into a busy loop, luckily an interruptable one)
1N/A for (25..26) { print "not ok $_ # TODO compiler bug?\n" }
1N/A $test += 2;
1N/A} else {
1N/A # [ID 20010618.006] tests 25..26 may loop
1N/A
1N/A $_ = 'FGF';
1N/A study;
1N/A alarm_ok { /G.F$/ };
1N/A alarm_ok { /[F]F$/ };
1N/A}
1N/A