This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Since we no longer autovivify stashes (change #26370), we need
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 2 Jan 2006 15:19:59 +0000 (15:19 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 2 Jan 2006 15:19:59 +0000 (15:19 +0000)
to turn off strict-refs on them, or we'll have a stricture
error the first time we'd try to access them (when they'll be
actually autovivified).
p4raw-link: @26370 on //depot/perl: adc51b978ed1b2e9d4512c9bfa80386ac917d05a

p4raw-id: //depot/perl@26574

op.c
t/op/stash.t

diff --git a/op.c b/op.c
index fde4f9e..8f8cb02 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5408,7 +5408,18 @@ Perl_ck_rvconst(pTHX_ register OP *o)
                Perl_croak(aTHX_ "Constant is not %s reference", badtype);
            return o;
        }
-       if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
+       else if ((o->op_type == OP_RV2HV || o->op_type == OP_RV2SV) &&
+               (PL_hints & HINT_STRICT_REFS) && SvPOK(kidsv)) {
+           /* If this is an access to a stash, disable "strict refs", because
+            * stashes aren't auto-vivified at compile-time (unless we store
+            * symbols in them), and we don't want to produce a run-time
+            * stricture error when auto-vivifying the stash. */
+           const char *s = SvPV_nolen(kidsv);
+           const STRLEN l = SvCUR(kidsv);
+           if (l > 1 && s[l-1] == ':' && s[l-2] == ':')
+               o->op_private &= ~HINT_STRICT_REFS;
+       }
+       if ((o->op_private & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
             const char *badthing = Nullch;
            switch (o->op_type) {
            case OP_RV2SV:
index 3d9d084..4a3cf06 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
 
 require "./test.pl";
 
-plan( tests => 9 );
+plan( tests => 11 );
 
 # Used to segfault (bug #15479)
 fresh_perl_is(
@@ -50,3 +50,9 @@ package main;
                  '',
                  );
 }
+
+# now tests with strictures
+
+use strict;
+ok( !defined %pig::, q(referencing a non-existent stash doesn't produce stricture errors) );
+ok( !exists $pig::{bodine}, q(referencing a non-existent stash element doesn't produce stricture errors) );