Skip to content

Commit

Permalink
fix handling of mayhaps-extended @_ in goto &sub
Browse files Browse the repository at this point in the history
p4raw-id: //depot/perl@2030
  • Loading branch information
Gurusamy Sarathy committed Oct 21, 1998
1 parent 779c5bc commit 62b1ebc
Show file tree
Hide file tree
Showing 3 changed files with 22 additions and 6 deletions.
1 change: 1 addition & 0 deletions av.c
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@ av_reify(AV *av)
key = AvARRAY(av) - AvALLOC(av);
while (key)
AvALLOC(av)[--key] = &PL_sv_undef;
AvREIFY_off(av);
AvREAL_on(av);
}

Expand Down
12 changes: 10 additions & 2 deletions pp_ctl.c
Original file line number Diff line number Diff line change
Expand Up @@ -1873,6 +1873,7 @@ PP(pp_goto)
SV** mark;
I32 items = 0;
I32 oldsave;
int arg_was_real = 0;

retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
Expand Down Expand Up @@ -1917,7 +1918,10 @@ PP(pp_goto)
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
#endif /* USE_THREADS */
AvREAL_off(av);
if (AvREAL(av)) {
arg_was_real = 1;
AvREAL_off(av); /* so av_clear() won't clobber elts */
}
av_clear(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
Expand Down Expand Up @@ -2073,7 +2077,11 @@ PP(pp_goto)
}
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;

/* preserve @_ nature */
if (arg_was_real) {
AvREIFY_off(av);
AvREAL_on(av);
}
while (items--) {
if (*mark)
SvTEMP_off(*mark);
Expand Down
15 changes: 11 additions & 4 deletions t/op/goto.t
Original file line number Diff line number Diff line change
@@ -1,10 +1,8 @@
#!./perl

# $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $

# "This IS structured code. It's just randomly structured."

print "1..9\n";
print "1..12\n";

while ($?) {
$foo = 1;
Expand Down Expand Up @@ -56,7 +54,7 @@ sub bar {
exit;

FINALE:
print "ok 9\n";
print "ok 12\n";
exit;

bypass:
Expand Down Expand Up @@ -86,5 +84,14 @@ $wherever = NOWHERE;
eval { goto $wherever };
print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";

# see if a modified @_ propagates
{
package Foo;
sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
sub start { push @_, 1, "foo", {}; goto &show; }
for (9..11) { start(bless([$_]), 'bar'); }
}

$wherever = FINALE;
goto $wherever;

0 comments on commit 62b1ebc

Please sign in to comment.