From: Vincent Pit <perl@profvince.com>
Date: Wed, 30 Apr 2008 13:14:00 +0000 (+0200)
Subject: Double magic/warnings with tie $x, $m
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a91d1d4276ac73a4692bb4f0f5725c1b2817cfa8;p=p5sagit%2Fp5-mst-13.2.git

Double magic/warnings with tie $x, $m
From: "Vincent Pit" <perl@profvince.com>
Message-ID: <62186.92.128.43.82.1209554040.squirrel@92.128.43.82>

p4raw-id: //depot/perl@33770
---

diff --git a/pp_sys.c b/pp_sys.c
index 94549ed..833e565 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -825,7 +825,7 @@ PP(pp_tie)
 	    break;
     }
     items = SP - MARK++;
-    if (sv_isobject(*MARK)) {
+    if (sv_isobject(*MARK)) { /* Calls GET magic. */
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
@@ -839,10 +839,12 @@ PP(pp_tie)
 	/* Not clear why we don't call call_method here too.
 	 * perhaps to get different error message ?
 	 */
-	stash = gv_stashsv(*MARK, 0);
+	STRLEN len;
+	const char *name = SvPV_nomg_const(*MARK, len);
+	stash = gv_stashpvn(name, len, 0);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
 	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
-		 methname, SVfARG(*MARK));
+		 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
 	}
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index ffa69d8..0a984e2 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -1138,7 +1138,6 @@ eval { my $x; sysread $m1, $x, $g1 };
 eval { my $x; sysread $m1, $x, $g1, $g2 };
 EXPECT
 Use of uninitialized value $m1 in tie at - line 5.
-Use of uninitialized value $m1 in tie at - line 5.
 Use of uninitialized value $m1 in ref-to-glob cast at - line 7.
 Use of uninitialized value $g1 in read at - line 7.
 Use of uninitialized value $m1 in ref-to-glob cast at - line 8.