Epigraph for 5.29.8
[perl.git] / t / op / study.t
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 watchdog(10);
10 plan(tests => 43);
11 use strict;
12
13 use Config;
14 my $have_alarm = $Config{d_alarm};
15
16 our $x = "abc\ndef\n";
17 study($x);
18
19 ok($x =~ /^abc/);
20 ok($x !~ /^def/);
21
22 # used to be a test for $*
23 ok($x =~ /^def/m);
24
25 $_ = '123';
26 study;
27 ok(/^([0-9][0-9]*)/);
28
29 ok(!($x =~ /^xxx/));
30 ok(!($x !~ /^abc/));
31
32 ok($x =~ /def/);
33 ok(!($x !~ /def/));
34
35 study($x);
36 ok($x !~ /.def/);
37 ok(!($x =~ /.def/));
38
39 ok($x =~ /\ndef/);
40 ok(!($x !~ /\ndef/));
41
42 $_ = 'aaabbbccc';
43 study;
44 ok(/(a*b*)(c*)/);
45 is($1, 'aaabbb');
46 is($2,'ccc');
47 ok(/(a+b+c+)/);
48 is($1, 'aaabbbccc');
49
50 ok(!/a+b?c+/);
51
52 $_ = 'aaabccc';
53 study;
54 ok(/a+b?c+/);
55 ok(/a*b+c*/);
56
57 $_ = 'aaaccc';
58 study;
59 ok(/a*b?c*/);
60 ok(!/a*b+c*/);
61
62 $_ = 'abcdef';
63 study;
64 ok(/bcd|xyz/);
65 ok(/xyz|bcd/);
66
67 ok(m|bc/*d|);
68
69 ok(/^$_$/);
70
71 # used to be a test for $*
72 ok("ab\ncd\n" =~ /^cd/m);
73
74 TODO: {
75     # Even with the alarm() OS/390 and BS2000 can't manage these tests
76     # (Perl just goes into a busy loop, luckily an interruptable one)
77     todo_skip('busy loop - compiler bug?', 2)
78               if $^O eq 'os390' or $^O eq 'posix-bc';
79
80     # [ID ] tests 25..26 may loop
81
82     $_ = 'FGF';
83     study;
84     ok(!/G.F$/, 'bug 20010618.006 (#7126)');
85     ok(!/[F]F$/, 'bug 20010618.006 (#7126)');
86 }
87
88 {
89     my $a = 'QaaQaabQaabbQ';
90     study $a;
91     my @a = split /aab*/, $a;
92     is("@a", 'Q Q Q Q', 'split with studied string passed to the regep engine');
93 }
94
95 {
96     $_ = "AABBAABB";
97     study;
98     is(s/AB+/1/ge, 2, 'studied scalar passed to pp_substconst');
99     is($_, 'A1A1');
100 }
101
102 {
103     $_ = "AABBAABB";
104     study;
105     is(s/(A)B+/1/ge, 2,
106        'studied scalar passed to pp_substconst with RX_MATCH_COPIED() true');
107     is($1, 'A');
108     is($2, undef);
109     is($_, 'A1A1');
110 }
111
112 {
113     my @got;
114     $a = "ydydydyd";
115     $b = "xdx";
116     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
117     is("@got", 'ydyd ydyd', '#92696 control');
118
119     @got = ();
120     $a = "ydydydyd";
121     $b = "xdx";
122     study $a;
123     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
124     is("@got", 'ydyd ydyd', '#92696 study $a');
125
126     @got = ();
127     $a = "ydydydyd";
128     $b = "xdx";
129     study $b;
130     push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
131     is("@got", 'ydyd ydyd', '#92696 study $b');
132
133     @got = ();
134     $a = "ydydydyd";
135     $b = "xdx";
136     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
137     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), nothing studied');
138
139     @got = ();
140     $a = "ydydydyd";
141     $b = "xdx";
142     my $c = 'zz';
143     study $c;
144     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
145     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $c studied');
146
147     @got = ();
148     $a = "ydydydyd";
149     $b = "xdx";
150     study $a;
151     push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
152     is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $a studied');
153
154     @got = ();
155     $a = "ydydydyd";
156     $b = "xdx";
157     study $a;
158     push @got, $_ foreach $a =~ /[^x]d(?{$a .= ''})[^x]d/g;
159     is("@got", 'ydyd ydyd', '#92696 $a .= \'\' inside (?{}), $a studied');
160 }