xref: /openbsd-src/gnu/usr.bin/perl/t/op/try.t (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7    require Config;
8}
9
10use strict;
11use warnings;
12use feature 'try';
13
14{
15    my $x;
16    try {
17        $x .= "try";
18    }
19    catch ($e) {
20        $x .= "catch";
21    }
22    is($x, "try", 'successful try/catch runs try but not catch');
23}
24
25{
26    my $x;
27    my $caught;
28    try {
29        $x .= "try";
30        die "Oopsie\n";
31    }
32    catch ($e) {
33        $x .= "catch";
34        $caught = $e;
35        is($@, "", '$@ is empty within catch block');
36    }
37    is($x, "trycatch", 'die in try runs catch block');
38    is($caught, "Oopsie\n", 'catch block saw exception value');
39}
40
41# return inside try {} makes containing function return
42{
43    sub f
44    {
45        try {
46            return "return inside try";
47        }
48        catch ($e) { }
49        return "return from func";
50    }
51    is(f(), "return inside try", 'return inside try');
52}
53
54# wantarray inside try
55{
56    my $context;
57    sub whatcontext
58    {
59        try {
60            $context = wantarray ? "list" :
61                defined wantarray ? "scalar" : "void";
62        }
63        catch ($e) { }
64    }
65
66    whatcontext();
67    is($context, "void", 'sub {try} in void');
68
69    my $scalar = whatcontext();
70    is($context, "scalar", 'sub {try} in scalar');
71
72    my @array = whatcontext();
73    is($context, "list", 'sub {try} in list');
74}
75
76# Loop controls inside try {} do not emit warnings
77{
78    my $warnings = "";
79    local $SIG{__WARN__} = sub { $warnings .= $_[0] };
80
81    {
82        try {
83            last;
84        }
85        catch ($e) { }
86    }
87
88    {
89        try {
90            next;
91        }
92        catch ($e) { }
93    }
94
95    my $count = 0;
96    {
97        try {
98            $count++;
99            redo if $count < 2;
100        }
101        catch ($e) { }
102    }
103
104    is($warnings, "", 'No warnings emitted by next/last/redo inside try');
105
106    $warnings = "";
107
108    LOOP_L: {
109        try {
110            last LOOP_L;
111        }
112        catch ($e) { }
113    }
114
115    LOOP_N: {
116        try {
117            next LOOP_N;
118        }
119        catch ($e) { }
120    }
121
122    $count = 0;
123    LOOP_R: {
124        try {
125            $count++;
126            redo LOOP_R if $count < 2;
127        }
128        catch ($e) { }
129    }
130
131    is($warnings, "", 'No warnings emitted by next/last/redo LABEL inside try');
132}
133
134# try/catch should localise $@
135{
136    eval { die "Value before\n"; };
137
138    try { die "Localized value\n" } catch ($e) {}
139
140    is($@, "Value before\n", 'try/catch localized $@');
141}
142
143# try/catch is not confused by false values
144{
145    my $caught;
146    try {
147        die 0;
148    }
149    catch ($e) {
150        $caught++;
151    }
152
153    ok( $caught, 'catch{} sees a false exception' );
154}
155
156# try/catch is not confused by always-false objects
157{
158    my $caught;
159    try {
160        die FALSE->new;
161    }
162    catch ($e) {
163        $caught++;
164    }
165
166    ok( $caught, 'catch{} sees a false-overload exception object' );
167
168    {
169        package FALSE;
170        use overload 'bool' => sub { 0 };
171        sub new { bless [], shift }
172    }
173}
174
175# return from try is correct even for :lvalue subs
176#   https://github.com/Perl/perl5/issues/18553
177{
178    my $scalar;
179    sub fscalar :lvalue
180    {
181        try { return $scalar }
182        catch ($e) { }
183    }
184
185    fscalar = 123;
186    is($scalar, 123, 'try { return } in :lvalue sub in scalar context' );
187
188    my @array;
189    sub flist :lvalue
190    {
191        try { return @array }
192        catch ($e) { }
193    }
194
195    (flist) = (4, 5, 6);
196    ok(eq_array(\@array, [4, 5, 6]), 'try { return } in :lvalue sub in list context' );
197}
198
199# try as final expression yields correct value
200{
201    my $scalar = do {
202        try { 123 }
203        catch ($e) { 456 }
204    };
205    is($scalar, 123, 'do { try } in scalar context');
206
207    my @list = do {
208        try { 1, 2, 3 }
209        catch ($e) { 4, 5, 6 }
210    };
211    ok(eq_array(\@list, [1, 2, 3]), 'do { try } in list context');
212
213    # Regression test related to
214    #   https://github.com/Perl/perl5/issues/18855
215    $scalar = do {
216        try { my $x = 123; 456 }
217        catch ($e) { 789 }
218    };
219    is($scalar, 456, 'do { try } with multiple statements');
220}
221
222# catch as final expression yields correct value
223{
224    my $scalar = do {
225        try { die "Oops" }
226        catch ($e) { 456 }
227    };
228    is($scalar, 456, 'do { try/catch } in scalar context');
229
230    my @list = do {
231        try { die "Oops" }
232        catch ($e) { 4, 5, 6 }
233    };
234    ok(eq_array(\@list, [4, 5, 6]), 'do { try/catch } in list context');
235
236    # Regression test
237    #   https://github.com/Perl/perl5/issues/18855
238    $scalar = do {
239        try { die "Oops" }
240        catch ($e) { my $x = 123; "result" }
241    };
242    is($scalar, "result", 'do { try/catch } with multiple statements');
243}
244
245# try{} blocks should be invisible to caller()
246{
247    my $caller;
248    sub A { $caller = sprintf "%s (%s line %d)", (caller 1)[3,1,2]; }
249
250    sub B {
251        try { A(); }
252        catch ($e) {}
253    }
254
255    my $LINE = __LINE__+1;
256    B();
257
258    is($caller, "main::B ($0 line $LINE)", 'try {} block is invisible to caller()');
259}
260
261# try/catch/finally
262
263# experimental warnings
264{
265    my $warnings;
266    BEGIN { $SIG{__WARN__} = sub { $warnings .= shift; }; }
267
268    my ($lfinally) = (__LINE__+5);
269    try {
270    }
271    catch ($e) {
272    }
273    finally {
274    }
275
276    is($warnings, "try/catch/finally is experimental at $0 line $lfinally.\n",
277        'compiletime warnings');
278    BEGIN { undef $SIG{__WARN__}; }
279}
280
281no warnings 'experimental::try';
282
283{
284    my $x;
285    try {
286        $x .= "try";
287    }
288    catch ($e) {
289        $x .= "catch";
290    }
291    finally {
292        $x .= "finally";
293    }
294    is($x, "tryfinally", 'successful try/catch/finally runs try+finally but not catch');
295}
296
297{
298    my $x;
299    try {
300        $x .= "try";
301        die "Oopsie\n";
302    }
303    catch ($e) {
304        $x .= "catch";
305    }
306    finally {
307        $x .= "finally";
308    }
309    is($x, "trycatchfinally", 'try/catch/finally runs try+catch+finally on failure');
310}
311
312{
313    my $finally_invoked;
314    sub ff
315    {
316        try {
317            return "return inside try+finally";
318        }
319        catch ($e) {}
320        finally { $finally_invoked++; "last value" }
321        return "return from func";
322    }
323    is(ff(), "return inside try+finally", 'return inside try+finally');
324    ok($finally_invoked, 'finally block still invoked for side-effects');
325}
326
327# Nicer compiletime errors
328{
329    my $e;
330
331    $e = defined eval 'try { A() } catch { B() }; 1;' ? undef : $@;
332    like($e, qr/^catch block requires a \(VAR\) at /,
333        'Parse error for catch without (VAR)');
334}
335
336done_testing;
337