From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 2 Jan 2006 15:19:59 +0000 (+0000)
Subject: Since we no longer autovivify stashes (change #26370), we need
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ce10b5d1ec5b5f68b0811018a415bc37;p=p5sagit%2Fp5-mst-13.2.git

Since we no longer autovivify stashes (change #26370), we need
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
---

diff --git a/op.c b/op.c
index fde4f9e..8f8cb02 100644
--- 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:
diff --git a/t/op/stash.t b/t/op/stash.t
index 3d9d084..4a3cf06 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -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) );