[perl #49522] state variable not available

Svf_PADSTALE means something different for state vars. Make sure
we always handle it correctly

p4raw-id: //depot/perl@33009

diff --git a/pad.c b/pad.c
index cfd3787..ea27408 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -102,6 +102,8 @@ to be generated in evals, such as
 
     { my $x = 1; sub f { eval '$x'} } f();
 
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
 =cut
 */
 
@@ -768,6 +770,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                else {
                    int newwarn = warn;
                    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
+                        && !SvPAD_STATE(name_svp[offset])
                         && warn && ckWARN(WARN_CLOSURE)) {
                        newwarn = 0;
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
@@ -796,7 +799,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
                        PTR2UV(cv), PTR2UV(*out_capture)));
 
-                   if (SvPADSTALE(*out_capture)) {
+                   if (SvPADSTALE(*out_capture)
+                       && !SvPAD_STATE(name_svp[offset]))
+                   {
                        if (ckWARN(WARN_CLOSURE))
                            Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                                "Variable \"%s\" is not available", name);
@@ -853,7 +858,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                    ? SvSTASH(*out_name_sv) : NULL,
            SvOURSTASH(*out_name_sv),
            1,  /* fake */
-           0   /* not a state variable */
+           SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
@@ -1496,8 +1501,8 @@ Perl_cv_clone(pTHX_ CV *proto)
                assert(sv);
                /* formats may have an inactive parent,
                   while my $x if $false can leave an active var marked as
-                  stale */
-               if (SvPADSTALE(sv)) {
+                  stale. And state vars are always available */
+               if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
                    if (ckWARN(WARN_CLOSURE))
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%s\" is not available", SvPVX_const(namesv));

diff --git a/t/op/state.t b/t/op/state.t
index 411ffaa..953cd26 100644 (file)
--- a/t/op/state.t
+++ b/t/op/state.t
@@ -10,7 +10,7 @@ BEGIN {
 use strict;
 use feature ":5.10";
 
-plan tests => 123;
+plan tests => 130;
 
 ok( ! defined state $uninit, q(state vars are undef by default) );
 
@@ -354,6 +354,50 @@ foreach my $forbidden (<DATA>) {
     eval $forbidden;
     like $@, qr/Initialization of state variables in list context currently forbidden/, "Currently forbidden: $forbidden";
 }
+
+# [perl #49522] state variable not available
+
+{
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+    eval q{
+       use warnings;
+
+       sub f_49522 {
+           state $s = 88;
+           sub g_49522 { $s }
+           sub { $s };
+       }
+
+       sub h_49522 {
+           state $t = 99;
+           sub i_49522 {
+               sub { $t };
+           }
+       }
+    };
+    is $@, '', "eval f_49522";
+    # shouldn't be any 'not available' or 'not stay shared' warnings
+    ok !@warnings, "suppress warnings part 1 [@warnings]";
+
+    @warnings = ();
+    my $f = f_49522();
+    is $f->(), 88, "state var closure 1";
+    is g_49522(), 88, "state var closure 2";
+    ok !@warnings, "suppress warnings part 2 [@warnings]";
+
+
+    @warnings = ();
+    $f = i_49522();
+    h_49522(); # initialise $t
+    is $f->(), 99, "state var closure 3";
+    ok !@warnings, "suppress warnings part 3 [@warnings]";
+
+
+}
+
+
 __DATA__
 state ($a) = 1;
 (state $a) = 1;