This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b407c6f0fb8413259a49d89f0e0f7d5118ed8f68
[perl5.git] / t / op / study.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 $Ok_Level = 0;
9 my $test = 1;
10 sub 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
25 sub nok ($;$) {
26     my($nok, $name) = @_;
27     local $Ok_Level = 1;
28     ok( !$nok, $name );
29 }
30
31 use Config;
32 my $have_alarm = $Config{d_alarm};
33 sub 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
50 print "1..26\n";
51
52 $x = "abc\ndef\n";
53 study($x);
54
55 ok($x =~ /^abc/);
56 ok($x !~ /^def/);
57
58 # used to be a test for $*
59 ok($x =~ /^def/m);
60
61 $_ = '123';
62 study;
63 ok(/^([0-9][0-9]*)/);
64
65 nok($x =~ /^xxx/);
66 nok($x !~ /^abc/);
67
68 ok($x =~ /def/);
69 nok($x !~ /def/);
70
71 study($x);
72 ok($x !~ /.def/);
73 nok($x =~ /.def/);
74
75 ok($x =~ /\ndef/);
76 nok($x !~ /\ndef/);
77
78 $_ = 'aaabbbccc';
79 study;
80 ok(/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc');
81 ok(/(a+b+c+)/ && $1 eq 'aaabbbccc');
82
83 nok(/a+b?c+/);
84
85 $_ = 'aaabccc';
86 study;
87 ok(/a+b?c+/);
88 ok(/a*b+c*/);
89
90 $_ = 'aaaccc';
91 study;
92 ok(/a*b?c*/);
93 nok(/a*b+c*/);
94
95 $_ = 'abcdef';
96 study;
97 ok(/bcd|xyz/);
98 ok(/xyz|bcd/);
99
100 ok(m|bc/*d|);
101
102 ok(/^$_$/);
103
104 # used to be a test for $*
105 ok("ab\ncd\n" =~ /^cd/m);
106
107 if ($^O eq 'os390' or $^O eq 'posix-bc') {
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