14 # The behaviour of the feature pragma should be tested by lib/feature.t
15 # using the tests in t/lib/feature/*. This file tests the behaviour of
16 # the switch ops themselves.
19 # Before loading feature, test the switch ops with CORE::
21 CORE::when(3) { pass "CORE::given and CORE::when"; continue }
22 CORE::default { pass "continue (without feature) and CORE::default" }
29 like($@, qr/^Can't "continue" outside/, "continue outside");
32 like($@, qr/^Can't "break" outside/, "break outside");
38 given(my $x = "bar") {
39 is($x, "bar", "given scope starts");
41 is($x, "foo", "given scope ends");
46 given(my $x = "foo") {
47 when(be_true(my $x = "bar")) {
48 is($x, "bar", "given scope starts");
50 is($x, "foo", "given scope ends");
54 given("inside") { check_outside1() }
55 sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
59 given("inside") { check_outside2() }
61 is($_, "outside", "\$_ lexically scoped (lexical \$_)")
65 # Basic string/numeric comparisons and control flow
70 when(2) { $ok = 'two'; }
71 when(3) { $ok = 'three'; }
72 when(4) { $ok = 'four'; }
73 default { $ok = 'd'; }
75 is($ok, 'three', "numeric comparison");
82 when(2) { $ok = 'two'; }
83 when(3) { $ok = 'three'; }
84 when(4) { $ok = 'four'; }
85 default { $ok = 'd'; }
87 is($ok, 'three', "integer comparison");
93 when(3.1) { $ok1 = 'n'; }
94 when(3.0) { $ok1 = 'y'; continue }
95 when("3.0") { $ok2 = 'y'; }
96 default { $ok2 = 'n'; }
98 is($ok1, 'y', "more numeric (pt. 1)");
99 is($ok2, 'y', "more numeric (pt. 2)");
105 when("b") { $ok = 'B'; }
106 when("c") { $ok = 'C'; }
107 when("d") { $ok = 'D'; }
108 default { $ok = 'def'; }
110 is($ok, 'C', "string comparison");
116 when("b") { $ok = 'B'; }
117 when("c") { $ok = 'C'; continue }
118 when("c") { $ok = 'CC'; }
119 default { $ok = 'D'; }
121 is($ok, 'CC', "simple continue");
127 given (0) { when(undef) {$ok = 0} }
128 is($ok, 1, "Given(0) when(undef)");
133 given (0) { when($undef) {$ok = 0} }
134 is($ok, 1, 'Given(0) when($undef)');
139 given (0) { when($undef++) {$ok = 1} }
140 is($ok, 1, "Given(0) when($undef++)");
143 no warnings "uninitialized";
145 given (undef) { when(0) {$ok = 0} }
146 is($ok, 1, "Given(undef) when(0)");
149 no warnings "uninitialized";
152 given ($undef) { when(0) {$ok = 0} }
153 is($ok, 1, 'Given($undef) when(0)');
158 given ("") { when(undef) {$ok = 0} }
159 is($ok, 1, 'Given("") when(undef)');
164 given ("") { when($undef) {$ok = 0} }
165 is($ok, 1, 'Given("") when($undef)');
168 no warnings "uninitialized";
170 given (undef) { when("") {$ok = 0} }
171 is($ok, 1, 'Given(undef) when("")');
174 no warnings "uninitialized";
177 given ($undef) { when("") {$ok = 0} }
178 is($ok, 1, 'Given($undef) when("")');
183 given (undef) { when(undef) {$ok = 1} }
184 is($ok, 1, "Given(undef) when(undef)");
189 given (undef) { when($undef) {$ok = 1} }
190 is($ok, 1, 'Given(undef) when($undef)');
195 given ($undef) { when(undef) {$ok = 1} }
196 is($ok, 1, 'Given($undef) when(undef)');
201 given ($undef) { when($undef) {$ok = 1} }
202 is($ok, 1, 'Given($undef) when($undef)');
206 # Regular expressions
209 given("Hello, world!") {
211 { $ok1 = 'y'; continue}
213 { $ok1 = 'n'; continue}
214 when(/^(Hello,|Goodbye cruel) world[!.?]/)
215 { $ok2 = 'Y'; continue}
216 when(/^(Hello cruel|Goodbye,) world[!.?]/)
217 { $ok2 = 'n'; continue}
219 is($ok1, 'y', "regex 1");
220 is($ok2, 'Y', "regex 2");
225 my $test = "explicit numeric comparison (<)";
226 my $twenty_five = 25;
228 given($twenty_five) {
229 when ($_ < 10) { $ok = "ten" }
230 when ($_ < 20) { $ok = "twenty" }
231 when ($_ < 30) { $ok = "thirty" }
232 when ($_ < 40) { $ok = "forty" }
233 default { $ok = "default" }
235 is($ok, "thirty", $test);
240 my $test = "explicit numeric comparison (integer <)";
241 my $twenty_five = 25;
243 given($twenty_five) {
244 when ($_ < 10) { $ok = "ten" }
245 when ($_ < 20) { $ok = "twenty" }
246 when ($_ < 30) { $ok = "thirty" }
247 when ($_ < 40) { $ok = "forty" }
248 default { $ok = "default" }
250 is($ok, "thirty", $test);
254 my $test = "explicit numeric comparison (<=)";
255 my $twenty_five = 25;
257 given($twenty_five) {
258 when ($_ <= 10) { $ok = "ten" }
259 when ($_ <= 20) { $ok = "twenty" }
260 when ($_ <= 30) { $ok = "thirty" }
261 when ($_ <= 40) { $ok = "forty" }
262 default { $ok = "default" }
264 is($ok, "thirty", $test);
269 my $test = "explicit numeric comparison (integer <=)";
270 my $twenty_five = 25;
272 given($twenty_five) {
273 when ($_ <= 10) { $ok = "ten" }
274 when ($_ <= 20) { $ok = "twenty" }
275 when ($_ <= 30) { $ok = "thirty" }
276 when ($_ <= 40) { $ok = "forty" }
277 default { $ok = "default" }
279 is($ok, "thirty", $test);
284 my $test = "explicit numeric comparison (>)";
285 my $twenty_five = 25;
287 given($twenty_five) {
288 when ($_ > 40) { $ok = "forty" }
289 when ($_ > 30) { $ok = "thirty" }
290 when ($_ > 20) { $ok = "twenty" }
291 when ($_ > 10) { $ok = "ten" }
292 default { $ok = "default" }
294 is($ok, "twenty", $test);
298 my $test = "explicit numeric comparison (>=)";
299 my $twenty_five = 25;
301 given($twenty_five) {
302 when ($_ >= 40) { $ok = "forty" }
303 when ($_ >= 30) { $ok = "thirty" }
304 when ($_ >= 20) { $ok = "twenty" }
305 when ($_ >= 10) { $ok = "ten" }
306 default { $ok = "default" }
308 is($ok, "twenty", $test);
313 my $test = "explicit numeric comparison (integer >)";
314 my $twenty_five = 25;
316 given($twenty_five) {
317 when ($_ > 40) { $ok = "forty" }
318 when ($_ > 30) { $ok = "thirty" }
319 when ($_ > 20) { $ok = "twenty" }
320 when ($_ > 10) { $ok = "ten" }
321 default { $ok = "default" }
323 is($ok, "twenty", $test);
328 my $test = "explicit numeric comparison (integer >=)";
329 my $twenty_five = 25;
331 given($twenty_five) {
332 when ($_ >= 40) { $ok = "forty" }
333 when ($_ >= 30) { $ok = "thirty" }
334 when ($_ >= 20) { $ok = "twenty" }
335 when ($_ >= 10) { $ok = "ten" }
336 default { $ok = "default" }
338 is($ok, "twenty", $test);
343 my $test = "explicit string comparison (lt)";
344 my $twenty_five = "25";
346 given($twenty_five) {
347 when ($_ lt "10") { $ok = "ten" }
348 when ($_ lt "20") { $ok = "twenty" }
349 when ($_ lt "30") { $ok = "thirty" }
350 when ($_ lt "40") { $ok = "forty" }
351 default { $ok = "default" }
353 is($ok, "thirty", $test);
357 my $test = "explicit string comparison (le)";
358 my $twenty_five = "25";
360 given($twenty_five) {
361 when ($_ le "10") { $ok = "ten" }
362 when ($_ le "20") { $ok = "twenty" }
363 when ($_ le "30") { $ok = "thirty" }
364 when ($_ le "40") { $ok = "forty" }
365 default { $ok = "default" }
367 is($ok, "thirty", $test);
371 my $test = "explicit string comparison (gt)";
372 my $twenty_five = 25;
374 given($twenty_five) {
375 when ($_ ge "40") { $ok = "forty" }
376 when ($_ ge "30") { $ok = "thirty" }
377 when ($_ ge "20") { $ok = "twenty" }
378 when ($_ ge "10") { $ok = "ten" }
379 default { $ok = "default" }
381 is($ok, "twenty", $test);
385 my $test = "explicit string comparison (ge)";
386 my $twenty_five = 25;
388 given($twenty_five) {
389 when ($_ ge "40") { $ok = "forty" }
390 when ($_ ge "30") { $ok = "thirty" }
391 when ($_ ge "20") { $ok = "twenty" }
392 when ($_ ge "10") { $ok = "ten" }
393 default { $ok = "default" }
395 is($ok, "twenty", $test);
398 # Make sure it still works with a lexical $_:
401 my $test = "explicit comparison with lexical \$_";
402 my $twenty_five = 25;
404 given($twenty_five) {
405 when ($_ ge "40") { $ok = "forty" }
406 when ($_ ge "30") { $ok = "thirty" }
407 when ($_ ge "20") { $ok = "twenty" }
408 when ($_ ge "10") { $ok = "ten" }
409 default { $ok = "default" }
411 is($ok, "twenty", $test);
414 # Optimized-away comparisons
418 when (2 + 2 == 4) { $ok = 'y'; continue }
419 when (2 + 2 == 5) { $ok = 'n' }
421 is($ok, 'y', "Optimized-away comparison");
427 when (scalar 24) { $ok = 'n'; continue }
428 default { $ok = 'y' }
430 is($ok,'y','scalar()');
434 # (How to be both thorough and portable? Pinch a few ideas
435 # from t/op/filetest.t. We err on the side of portability for
439 my ($ok_d, $ok_f, $ok_r);
441 when(-d) {$ok_d = 1; continue}
442 when(!-f) {$ok_f = 1; continue}
443 when(-r) {$ok_r = 1; continue}
445 ok($ok_d, "Filetest -d");
446 ok($ok_f, "Filetest -f");
447 ok($ok_r, "Filetest -r");
450 # Sub and method calls
455 when(notfoo()) {$ok = 1}
457 ok($ok, "Sub call acts as boolean")
463 when(main->notfoo()) {$ok = 1}
465 ok($ok, "Class-method call acts as boolean")
472 when($obj->notfoo()) {$ok = 1}
474 ok($ok, "Object-method call acts as boolean")
477 # Other things that should not be smart matched
481 when( /(\d+)/ and ( 1 <= $1 and $1 <= 12 ) ) {
485 ok($ok, "bool not smartmatches");
495 ok($ok, "eof() not smartmatched");
500 my %foo = ("bar", 0);
502 when(exists $foo{bar}) {
506 ok($ok, "exists() not smartmatched");
516 ok($ok, "defined() not smartmatched");
522 when((1 == 1) && "bar") {
525 when((1 == 1) && $_ eq "foo") {
529 is($ok, 2, "((1 == 1) && \"bar\") not smartmatched");
534 for my $l (qw(a b c d)) {
536 when ($_ eq "b" .. $_ eq "c") { $n = 1 }
539 ok(($n xor $l =~ /[ad]/), 'when(E1..E2) evaluates in boolean context');
545 for my $l (qw(a b c d)) {
547 when ($_ eq "b" ... $_ eq "c") { $n = 1 }
550 ok(($n xor $l =~ /[ad]/), 'when(E1...E2) evaluates in boolean context');
557 when((1 == $ok) || "foo") {
561 ok($ok, '((1 == $ok) || "foo") smartmatched');
567 when((1 == $ok || undef) // "foo") {
571 ok($ok, '((1 == $ok || undef) // "foo") smartmatched');
574 # Make sure we aren't invoking the get-magic more than once
576 { # A helper class to count the number of accesses.
577 package FetchCounter;
580 bless {value => undef, count => 0}, $class;
583 my ($self, $val) = @_;
585 $self->{value} = $val;
589 # Avoid pre/post increment here
590 $self->{count} = 1 + $self->{count};
599 my $f = tie my $v, "FetchCounter";
601 { my $test_name = "Multiple FETCHes in given, due to aliasing";
611 is($ok, 1, "precheck: $test_name");
612 is($f->count(), 4, $test_name);
615 { my $test_name = "Only one FETCH (numeric when)";
618 is($f->count(), 0, "Sanity check: $test_name");
627 is($ok, 1, "precheck: $test_name");
628 is($f->count(), 1, $test_name);
631 { my $test_name = "Only one FETCH (string when)";
634 is($f->count(), 0, "Sanity check: $test_name");
643 is($ok, 1, "precheck: $test_name");
644 is($f->count(), 1, $test_name);
647 { my $test_name = "Only one FETCH (undef)";
650 is($f->count(), 0, "Sanity check: $test_name");
651 no warnings "uninitialized";
657 when(undef) {$ok = 0}
659 is($ok, 1, "precheck: $test_name");
660 is($f->count(), 1, $test_name);
668 is($first, 0, "Loop: second");
670 like($@, qr/^Can't "break" in a loop topicalizer/,
671 q{Can't "break" in a loop topicalizer});
674 is($first, 1, "Loop: first");
676 # Implicit break is okay
685 is($first, 0, "Explicit \$_: second");
687 like($@, qr/^Can't "break" in a loop topicalizer/,
688 q{Can't "break" in a loop topicalizer});
691 is($first, 1, "Explicit \$_: first");
693 # Implicit break is okay
703 is($first, 0, "Implicitly lexical loop: second");
705 like($@, qr/^Can't "break" in a loop topicalizer/,
706 q{Can't "break" in a loop topicalizer});
709 is($first, 1, "Implicitly lexical loop: first");
711 # Implicit break is okay
721 is($first, 0, "Implicitly lexical, explicit \$_: second");
723 like($@, qr/^Can't "break" in a loop topicalizer/,
724 q{Can't "break" in a loop topicalizer});
727 is($first, 1, "Implicitly lexical, explicit \$_: first");
729 # Implicit break is okay
736 for my $_ (1, "two") {
738 is($first, 0, "Lexical loop: second");
740 like($@, qr/^Can't "break" in a loop topicalizer/,
741 q{Can't "break" in a loop topicalizer});
744 is($first, 1, "Lexical loop: first");
746 # Implicit break is okay
755 sub foo {$called_foo = 1; "@_" eq "foo"}
757 sub bar {$called_bar = 1; "@_" eq "bar"}
758 my ($matched_foo, $matched_bar) = (0, 0);
760 when(\&bar) {$matched_bar = 1}
761 when(\&foo) {$matched_foo = 1}
763 is($called_foo, 1, "foo() was called");
764 is($called_bar, 1, "bar() was called");
765 is($matched_bar, 0, "bar didn't match");
766 is($matched_foo, 1, "foo did match");
774 my ($ok1, $ok2) = (0,0);
777 { $ok1 = 1; continue }
779 { $ok2 = 1; continue }
781 is($ok1, 1, "Calling sub directly (true)");
782 is($ok2, 1, "Calling sub indirectly (true)");
786 { $ok1 = 2; continue }
788 { $ok2 = 2; continue }
790 is($ok1, 1, "Calling sub directly (false)");
791 is($ok2, 1, "Calling sub indirectly (false)");
795 skip_if_miniperl("no dynamic loading on miniperl, no Scalar::Util", 14);
797 { package OverloadTest;
799 use overload '""' => sub{"string value of obj"};
800 use overload 'eq' => sub{"$_[0]" eq "$_[1]"};
802 use overload "~~" => sub {
803 my ($self, $other, $reversed) = @_;
805 $self->{left} = $other;
806 $self->{right} = $self;
807 $self->{reversed} = 1;
809 $self->{left} = $self;
810 $self->{right} = $other;
811 $self->{reversed} = 0;
814 return $self->{retval};
818 my ($pkg, $retval) = @_;
827 my $test = "Overloaded obj in given (true)";
828 my $obj = OverloadTest->new(1);
831 when ("other arg") {$matched = 1}
832 default {$matched = 0}
835 is($obj->{called}, 1, "$test: called");
836 ok($matched, "$test: matched");
840 my $test = "Overloaded obj in given (false)";
841 my $obj = OverloadTest->new(0);
844 when ("other arg") {$matched = 1}
847 is($obj->{called}, 1, "$test: called");
848 ok(!$matched, "$test: not matched");
852 my $test = "Overloaded obj in when (true)";
853 my $obj = OverloadTest->new(1);
856 when ($obj) {$matched = 1}
857 default {$matched = 0}
860 is($obj->{called}, 1, "$test: called");
861 ok($matched, "$test: matched");
862 is($obj->{left}, "topic", "$test: left");
863 is($obj->{right}, "string value of obj", "$test: right");
864 ok($obj->{reversed}, "$test: reversed");
868 my $test = "Overloaded obj in when (false)";
869 my $obj = OverloadTest->new(0);
872 when ($obj) {$matched = 1}
873 default {$matched = 0}
876 is($obj->{called}, 1, "$test: called");
877 ok(!$matched, "$test: not matched");
878 is($obj->{left}, "topic", "$test: left");
879 is($obj->{right}, "string value of obj", "$test: right");
880 ok($obj->{reversed}, "$test: reversed");
890 is($ok, 1, "postfix undef");
896 $ok += 2 when 9.1685;
897 $ok += 4 when $_ > 4;
898 $ok += 8 when $_ < 2.5;
900 is($ok, 8, "postfix numeric");
905 $ok = 1, continue when $_ eq "apple";
907 $ok = 0 when "banana";
909 is($ok, 3, "postfix string");
914 do { $ok = 1; continue } when /pea/;
920 is($ok, 7, "postfix regex");
922 # be_true is defined at the beginning of the file
925 given(my $x = "foo") {
927 is($x, "foo", "scope inside ... when my \$x = ...");
929 } when be_true(my $x = "bar");
930 is($x, "bar", "scope after ... when my \$x = ...");
936 my $x = 2, continue when be_true();
937 is($x, undef, "scope after my \$x = ... when ...");
941 # Tests for last and next in when clauses
952 is($letter, "b", "last in when");
955 LETTER1: for ("a".."e") {
958 when ("b") { last LETTER1 }
962 is($letter, "b", "last LABEL in when");
967 when (/b|d/) { next }
972 is($letter, "a,c,e,", "next in when");
975 LETTER2: for ("a".."e") {
977 when (/b|d/) { next LETTER2 }
982 is($letter, "a,c,e,", "next LABEL in when");
984 # Test goto with given/when
989 GIVEN1: given ($flag) {
993 is($flag, 0, "goto GIVEN1");
998 when (0) { $flag = 1; }
1003 is($flag, 1, "goto inside given");
1008 when (0) { $flag = 1; goto GIVEN3; $flag = 2; }
1012 is($flag, 1, "goto inside given and when");
1017 when (0) { $flag = 1; goto GIVEN4; $flag = 2; }
1021 is($flag, 1, "goto inside for and when");
1027 when (0) { $flag = 1; goto GIVEN5; $flag = 2; }
1031 is($flag, 1, "goto inside given and when to the given stmt");
1034 # test with unreified @_ in smart match [perl #71078]
1035 sub unreified_check { ok([@_] ~~ \@_) } # should always match
1036 unreified_check(1,2,"lala");
1037 unreified_check(1,2,undef);
1038 unreified_check(undef);
1039 unreified_check(undef,"");
1041 # Test do { given } as a rvalue
1046 my @things = (11 .. 26); # 16 elements
1047 my @exp = (5, 16, 9);
1050 my $scalar = do { given ($_) {
1051 when (0) { $lexical }
1052 when (2) { 'void'; 8, 9 }
1055 is($scalar, shift(@exp), "rvalue given - simple scalar [$_]");
1061 my @exp = (5, 7, 9);
1064 my $scalar = do { given ($_) {
1069 is($scalar, shift(@exp), "rvalue given - postfix scalar [$_]");
1074 my @exp = (5, 9, 9);
1076 my $scalar = do { given ($_) {
1082 is($scalar, shift(@exp), "rvalue given - default scalar [$_]");
1087 my @things = (11 .. 13);
1088 my @exp = ('3 4 5', '11 12 13', '8 9');
1090 my @list = do { given ($_) {
1092 when (2) { my $fake = 'void'; 8, 9 }
1095 is("@list", shift(@exp), "rvalue given - simple list [$_]");
1101 my @exp = ('3 4 5', '6 7', '12');
1103 my @list = do { given ($_) {
1108 is("@list", shift(@exp), "rvalue given - postfix list [$_]");
1113 my @things = (11 .. 20); # 10 elements
1114 my @exp = ('m o o', '8 10', '8 10');
1116 my @list = do { given ($_) {
1117 when (0) { "moo" =~ /(.)/g }
1118 default { 8, scalar(@things) }
1121 is("@list", shift(@exp), "rvalue given - default list [$_]");
1126 my @exp = ('6 7', '', '6 7');
1128 my @list = do { given ($_) {
1129 continue when $_ <= 1;
1134 is("@list", shift(@exp), "rvalue given - default list [$_]");
1138 # Context propagation
1139 my $smart_hash = sub {
1140 do { given ($_[0]) {
1142 when ([ 1 .. 3 ]) { 1 .. 3 }
1143 when (4) { my $fake; do { 4, 5 } }
1149 $scalar = $smart_hash->();
1150 is($scalar, 'undef', "rvalue given - scalar context propagation [undef]");
1152 $scalar = $smart_hash->(4);
1153 is($scalar, 5, "rvalue given - scalar context propagation [4]");
1155 $scalar = $smart_hash->(999);
1156 is($scalar, undef, "rvalue given - scalar context propagation [999]");
1160 @list = $smart_hash->();
1161 is("@list", 'undef', "rvalue given - list context propagation [undef]");
1163 @list = $smart_hash->(2);
1164 is("@list", '1 2 3', "rvalue given - list context propagation [2]");
1166 @list = $smart_hash->(4);
1167 is("@list", '4 5', "rvalue given - list context propagation [4]");
1169 @list = $smart_hash->(999);
1170 is("@list", '', "rvalue given - list context propagation [999]");
1174 my @list = 10 .. 15;
1183 when (@list[0..2]) {
1188 is("@in_list", "10 15", "when(array)");
1189 is("@in_slice", "10", "when(array slice)");
1193 my %list = map { $_ => $_ } "a" .. "f";
1196 for ("a", "e", "i") {
1202 when (@list{"a".."c"}) {
1207 is("@in_list", "a e", "when(hash)");
1208 is("@in_slice", "a", "when(hash slice)");
1211 { # RT#84526 - Handle magical TARG
1212 my $x = my $y = "aaa";
1215 is(pos, undef, "handle magical TARG");
1221 # Test that returned values are correctly propagated through several context
1222 # levels (see RT #93548).
1229 our ($when_loc, $given_loc, $ext_loc);
1237 our $given_glob = 5;
1238 local $given_loc = 6;
1242 when (1) { my $when_lex = 1 }
1243 when (2) { our $when_glob = 2 }
1244 when (3) { local $when_loc = 3 }
1246 when (4) { $given_lex }
1247 when (5) { $given_glob }
1248 when (6) { $given_loc }
1250 when (7) { $ext_lex }
1251 when (8) { $ext_glob }
1252 when (9) { $ext_loc }
1258 my @descriptions = qw<
1274 for my $id (0 .. 9) {
1275 my $desc = $descriptions[$id];
1277 my $res = $tester->($id);
1278 is $res, $id, "plain call - $desc";
1281 my $id_plus_1 = $id + 1;
1282 given ($id_plus_1) {
1291 $tester->($id_plus_1);
1296 is $res, $id, "across continue and default - $desc";
1300 # Check that values returned from given/when are destroyed at the right time.
1317 my @descriptions = qw<
1324 for my $id (0 .. 3) {
1325 my $desc = $descriptions[$id];
1334 when (0) { Fmurrr->new($destroyed, 0) }
1335 when (1) { my $y = Fmurrr->new($destroyed, 1); break }
1336 when (2) { $x = Fmurrr->new($destroyed, 2); continue }
1338 default { Fmurrr->new($destroyed, 3) }
1341 $res_id = $res->{id};
1343 $res_id = $id if $id == 1; # break doesn't return anything
1345 is $res_id, $id, "given/when returns the right object - $desc";
1346 is $destroyed, 1, "given/when does not leak - $desc";
1350 # break() must reset the stack
1361 is "@res", "1", "break resets the stack";
1365 # must ensure $_ is initialised and cleared at start/end of given block
1371 return sub { $_ } # close over lexical $_
1374 is(f1()->(), 3, 'closed over $_');
1379 sub DESTROY { $d++ };
1384 ::is($_->[0], 7, "is [7]");
1386 ::is($_, 5, "is 5");
1387 ::is($d, 1, "DESTROY called once");
1394 # Okay, that'll do for now. The intricacies of the smartmatch
1395 # semantics are tested in t/op/smartmatch.t. Taintedness of
1396 # returned values is checked in t/op/taint.t.