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