RT #4682: given() didn't scope $_ correctly

given(expr) {...} behaves similarly to { my $_ = expr; ...},
except that, prior to this commit, it wasn't doing the SAVECLEARSV()
that pp_padsv would do.  This meant that $_ was still marked as stale
while in scope, and wasn't getting cleared at the end of scope.

diff --git a/pp_ctl.c b/pp_ctl.c
index 0d2aae1..238f230 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4367,6 +4367,7 @@ PP(pp_entergiven)
     ENTER_with_name("given");
     SAVETMPS;
 
+    SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     sv_setsv_mg(PAD_SV(PL_op->op_targ), POPs);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);

diff --git a/t/op/switch.t b/t/op/switch.t
index a286559..420c6ae 100644 (file)
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan tests => 197;
+plan tests => 201;
 
 # The behaviour of the feature pragma should be tested by lib/feature.t
 # using the tests in t/lib/feature/*. This file tests the behaviour of
@@ -1361,6 +1361,35 @@ unreified_check(undef,"");
     is "@res", "1", "break resets the stack";
 }
 
+# RT #94682:
+# must ensure $_ is initialised and cleared at start/end of given block
+
+{
+    sub f1 {
+       given(3) {
+           return sub { $_ } # close over lexical $_
+       }
+    }
+    is(f1()->(), 3, 'closed over $_');
+
+    package RT94682;
+
+    my $d = 0;
+    sub DESTROY { $d++ };
+
+    sub f2 {
+       my $_ = 5;
+       given(bless [7]) {
+           ::is($_->[0], 7, "is [7]");
+       }
+       ::is($_, 5, "is 5");
+       ::is($d, 1, "DESTROY called once");
+    }
+    f2();
+}
+
+
+
 # Okay, that'll do for now. The intricacies of the smartmatch
 # semantics are tested in t/op/smartmatch.t. Taintedness of
 # returned values is checked in t/op/taint.t.