Skip to content

Commit e33b044

Browse files
committed
Exercise documentation claim about 'goto EXPR'
Since 887d89f (Feb 22 2011), 'perldoc -f goto' has claimed: "goto EXPR" is exempt from the "looks like a function" rule. A pair of parentheses following it does not (necessarily) delimit its argument. "goto("NE")."XT"" is equivalent to "goto NEXT". However, no test was added to demonstrate this claim; provided herewith. Fixes: GH #23806 In passing: Remove trailing whitespace from several existing lines.
1 parent b7b77ff commit e33b044

File tree

1 file changed

+38
-9
lines changed

1 file changed

+38
-9
lines changed

t/op/goto.t

Lines changed: 38 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ BEGIN {
1212
use warnings;
1313
use strict;
1414
use Config;
15-
plan tests => 95;
15+
plan tests => 97;
1616

1717
our $TODO;
1818

@@ -232,7 +232,7 @@ EOT
232232
close $f;
233233

234234
$r = runperl(prog => 'BEGIN { unshift @INC, q[.] } use Op_goto01; print qq[DONE\n]');
235-
is($r, "OK\nDONE\n", "goto within use-d file");
235+
is($r, "OK\nDONE\n", "goto within use-d file");
236236
unlink_all "Op_goto01.pm";
237237

238238
# test for [perl #24108]
@@ -300,8 +300,8 @@ moretests:
300300
}
301301

302302
$z = 0;
303-
L2:
304-
{
303+
L2:
304+
{
305305
$z += 10;
306306
is($z, 10, 'prefer this scope (block body) to outer scope (block entry)');
307307
goto L2 if $z == 10;
@@ -311,7 +311,7 @@ moretests:
311311
}
312312

313313

314-
{
314+
{
315315
$z = 0;
316316
while (1) {
317317
L3: # not inner scope
@@ -326,7 +326,7 @@ moretests:
326326
}
327327

328328
L4: # not outer scope
329-
{
329+
{
330330
$z = 0;
331331
while (1) {
332332
L4: # not inner scope
@@ -342,10 +342,10 @@ moretests:
342342

343343
{
344344
my $loop = 0;
345-
for my $x (0..1) {
345+
for my $x (0..1) {
346346
L2: # without this, fails 1 (middle) out of 3 iterations
347347
$z = 0;
348-
L2:
348+
L2:
349349
$z += 10;
350350
is($z, 10,
351351
"same label, multiple times in same scope (choose 1st) $loop");
@@ -586,7 +586,7 @@ TODO: {
586586
FASTCGI_NEXT_REQUEST:
587587
last;
588588
}
589-
589+
590590
sub that_cgi_script {
591591
local $SIG{__DIE__} = sub { print "die handler\n"; exit; print "exit failed?\n"; };
592592
print "before\n";
@@ -683,3 +683,32 @@ eval {
683683
};
684684
is $@,'', 'goto the first parameter of a binary expression [perl #132854]';
685685

686+
# [GH-23806]
687+
{
688+
my $orig = "(A)";
689+
my $exp = '(A)(B)(tobermory)';
690+
691+
my ($refoo, $sefoo) = ($orig x 2);
692+
$refoo = $sefoo = "(A)";
693+
694+
if($refoo eq $refoo) {
695+
goto ORINOCO;
696+
}
697+
$refoo .= "(X)";
698+
ORINOCO:
699+
sub pudley { return "tobermory"; }
700+
$refoo .= "(B)";
701+
$refoo .= "(".pudley().")";
702+
is($refoo, $exp, "GH-23806: goto LABEL worked as expected");
703+
704+
if($sefoo eq $sefoo) {
705+
goto ("AMA")."ZON";
706+
}
707+
$sefoo .= "(X)";
708+
AMAZON:
709+
sub canterbury { return "tobermory"; }
710+
$sefoo .= "(B)";
711+
$sefoo .= "(".canterbury().")";
712+
is($sefoo, $refoo,
713+
"GH-23806: goto EXPR exempt from 'looks like a function' rule; worked as expected");
714+
}

0 commit comments

Comments
 (0)