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 (file)
--- 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 (file)
--- 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.