xref: /openbsd/gnu/usr.bin/perl/t/op/study.t (revision d415bd75) 
1#!./perl -w
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8
9watchdog(10);
10plan(tests => 43);
11use strict;
12
13use Config;
14my $have_alarm = $Config{d_alarm};
15
16our $x = "abc\ndef\n";
17study($x);
18
19ok($x =~ /^abc/);
20ok($x !~ /^def/);
21
22# used to be a test for $*
23ok($x =~ /^def/m);
24
25$_ = '123';
26study;
27ok(/^([0-9][0-9]*)/);
28
29ok(!($x =~ /^xxx/));
30ok(!($x !~ /^abc/));
31
32ok($x =~ /def/);
33ok(!($x !~ /def/));
34
35study($x);
36ok($x !~ /.def/);
37ok(!($x =~ /.def/));
38
39ok($x =~ /\ndef/);
40ok(!($x !~ /\ndef/));
41
42$_ = 'aaabbbccc';
43study;
44ok(/(a*b*)(c*)/);
45is($1, 'aaabbb');
46is($2,'ccc');
47ok(/(a+b+c+)/);
48is($1, 'aaabbbccc');
49
50ok(!/a+b?c+/);
51
52$_ = 'aaabccc';
53study;
54ok(/a+b?c+/);
55ok(/a*b+c*/);
56
57$_ = 'aaaccc';
58study;
59ok(/a*b?c*/);
60ok(!/a*b+c*/);
61
62$_ = 'abcdef';
63study;
64ok(/bcd|xyz/);
65ok(/xyz|bcd/);
66
67ok(m|bc/*d|);
68
69ok(/^$_$/);
70
71# used to be a test for $*
72ok("ab\ncd\n" =~ /^cd/m);
73
74TODO: {
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}
161