Add MUTABLE_CV(), and eliminate (CV *) casts in *.c.

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index ea0b34d..7d737de 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,7 +1,7 @@
 /*    gv.c
  *
- *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -599,19 +599,18 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
     return stash;
 }
 
-/* FIXME. If changing this function note the comment in pp_hot's
-   S_method_common:
-
-   This code tries to figure out just what went wrong with
-   gv_fetchmethod.  It therefore needs to duplicate a lot of
-   the internals of that function. ...
+GV *
+Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
+{
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
 
-   I'd guess that with one more flag bit that could all be moved inside
-   here.
-*/
+    return gv_fetchmethod_flags(stash, name, autoload ? GV_AUTOLOAD : 0);
+}
 
+/* Don't merge this yet, as it's likely to get a len parameter, and possibly
+   even a U32 hash */
 GV *
-Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
+Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
 {
     dVAR;
     register const char *nend;
@@ -619,11 +618,19 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
     GV* gv;
     HV* ostash = stash;
     const char * const origname = name;
+    SV *const error_report = (SV *)stash;
+    const U32 autoload = flags & GV_AUTOLOAD;
+    const U32 do_croak = flags & GV_CROAK;
 
-    PERL_ARGS_ASSERT_GV_FETCHMETHOD_AUTOLOAD;
+    PERL_ARGS_ASSERT_GV_FETCHMETHOD_FLAGS;
 
-    if (stash && SvTYPE(stash) < SVt_PVHV)
+    if (SvTYPE(stash) < SVt_PVHV)
        stash = NULL;
+    else {
+       /* The only way stash can become NULL later on is if nsplit is set,
+          which in turn means that there is no need for a SVt_PVHV case
+          the error reporting code.  */
+    }
 
     for (nend = name; *nend; nend++) {
        if (*nend == '\'') {
@@ -665,6 +672,31 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
            gv = (GV*)&PL_sv_yes;
        else if (autoload)
            gv = gv_autoload4(ostash, name, nend - name, TRUE);
+       if (!gv && do_croak) {
+           /* Right now this is exclusively for the benefit of S_method_common
+              in pp_hot.c  */
+           if (stash) {
+               Perl_croak(aTHX_
+                          "Can't locate object method \"%s\" via package \"%.*s\"",
+                          name, (int)HvNAMELEN_get(stash), HvNAME_get(stash));
+           }
+           else {
+               STRLEN packlen;
+               const char *packname;
+
+               if (nsplit) {
+                   packlen = nsplit - origname;
+                   packname = origname;
+               } else {
+                   packname = SvPV_const(error_report, packlen);
+               }
+
+               Perl_croak(aTHX_
+                          "Can't locate object method \"%s\" via package \"%.*s\""
+                          " (perhaps you forgot to load \"%.*s\"?)",
+                          name, (int)packlen, packname, (int)packlen, packname);
+           }
+       }
     }
     else if (autoload) {
        CV* const cv = GvCV(gv);
@@ -1479,7 +1511,7 @@ Perl_newIO(pTHX)
     /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
     if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
       iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
-    SvSTASH_set(io, (HV*)SvREFCNT_inc(GvHV(iogv)));
+    SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
     return io;
 }
 
@@ -1732,10 +1764,10 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
            if (i < DESTROY_amg)
                have_ovl = 1;
        } else if (gv) {                /* Autoloaded... */
-           cv = (CV*)gv;
+           cv = MUTABLE_CV(gv);
            filled = 1;
        }
-       amt.table[i]=(CV*)SvREFCNT_inc_simple(cv);
+       amt.table[i]=MUTABLE_CV(SvREFCNT_inc_simple(cv));
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
@@ -1890,7 +1922,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                   Hence we can't use SvAMAGIC_on()
                */
                SvFLAGS(newref) |= SVf_AMAGIC;
-               SvSTASH_set(newref, (HV*)SvREFCNT_inc(SvSTASH(tmpRef)));
+               SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef))));
                return newref;
             }
           }