wrong setting in canned win32/config.vc64 file

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index af75bec..418e08c 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -122,6 +122,25 @@ Perl_gv_fetchfile(pTHX_ const char *name)
     return gv;
 }
 
+/*
+=for apidoc gv_const_sv
+
+If C<gv> is a typeglob whose subroutine entry is a constant sub eligible for
+inlining, or C<gv> is a placeholder reference that would be promoted to such
+a typeglob, then returns the value returned by the sub.  Otherwise, returns
+NULL.
+
+=cut
+*/
+
+SV *
+Perl_gv_const_sv(pTHX_ GV *gv)
+{
+    if (SvTYPE(gv) == SVt_PVGV)
+       return cv_const_sv(GvCVu(gv));
+    return SvROK(gv) ? SvRV(gv) : NULL;
+}
+
 void
 Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 {
@@ -129,6 +148,24 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     register GP *gp;
     const bool doproto = SvTYPE(gv) > SVt_NULL;
     const char * const proto = (doproto && SvPOK(gv)) ? SvPVX_const(gv) : NULL;
+    SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL;
+
+    assert (!(proto && has_constant));
+
+    if (has_constant) {
+       /* The constant has to be a simple scalar type.  */
+       switch (SvTYPE(has_constant)) {
+       case SVt_PVAV:
+       case SVt_PVHV:
+       case SVt_PVCV:
+       case SVt_PVFM:
+       case SVt_PVIO:
+            Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
+                      sv_reftype(has_constant, 0));
+       }
+       SvRV_set(gv, NULL);
+       SvROK_off(gv);
+    }
 
     sv_upgrade((SV*)gv, SVt_PVGV);
     if (SvLEN(gv)) {
@@ -163,9 +200,14 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     if (doproto) {                     /* Replicate part of newSUB here. */
        SvIOK_off(gv);
        ENTER;
-       /* XXX unsafe for threads if eval_owner isn't held */
-       (void) start_subparse(0,0);     /* Create empty CV in compcv. */
-       GvCV(gv) = PL_compcv;
+       if (has_constant) {
+           /* newCONSTSUB takes ownership of the reference from us.  */
+           GvCV(gv) = newCONSTSUB(stash, name, has_constant);
+       } else {
+           /* XXX unsafe for threads if eval_owner isn't held */
+           (void) start_subparse(0,0); /* Create empty CV in compcv. */
+           GvCV(gv) = PL_compcv;
+       }
        LEAVE;
 
        PL_sub_generation++;
@@ -433,7 +475,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
     HV* ostash = stash;
 
     if (stash && SvTYPE(stash) < SVt_PVHV)
-       stash = Nullhv;
+       stash = NULL;
 
     for (nend = name; *nend; nend++) {
        if (*nend == '\'')
@@ -516,7 +558,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     if (stash) {
        if (SvTYPE(stash) < SVt_PVHV) {
            packname = SvPV_const((SV*)stash, packname_len);
-           stash = Nullhv;
+           stash = NULL;
        }
        else {
            packname = HvNAME_get(stash);
@@ -699,7 +741,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     I32 len;
     register const char *namend;
     HV *stash = 0;
-    const I32 add = flags & ~SVf_UTF8;
+    const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
+    const I32 add = flags & ~SVf_UTF8 & ~ GV_NOADD_NOINIT;
 
     PERL_UNUSED_ARG(full_len);
 
@@ -864,7 +907,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                require_errno(gv);
        }
        return gv;
-    } else if (add & GV_NOINIT) {
+    } else if (no_init) {
        return gv;
     }
 
@@ -1189,7 +1232,7 @@ Perl_newIO(pTHX)
     SvOBJECT_on(io);
     /* Clear the stashcache because a new IO could overrule a package name */
     hv_clear(PL_stashcache);
-    iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
+    iogv = gv_fetchpv("FileHandle::", 0, SVt_PVHV);
     /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
     if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
       iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);