This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The last parameter to gv_stashpv/gv_stashpvn/gv_stashsv is a bitmask
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 78e528f..9617b82 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -325,7 +325,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* UNIVERSAL methods should be callable without a stash */
     if (!stash) {
        level = -1;  /* probably appropriate */
-       if(!(stash = gv_stashpvs("UNIVERSAL", FALSE)))
+       if(!(stash = gv_stashpvs("UNIVERSAL", 0)))
            return 0;
     }
 
@@ -371,7 +371,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            HV* basestash;
 
            packlen -= 7;
-           basestash = gv_stashpvn(hvname, packlen, TRUE);
+           basestash = gv_stashpvn(hvname, packlen, GV_ADD);
            gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE);
            if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
                gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
@@ -391,7 +391,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
        I32 items = AvFILLp(av) + 1;
        while (items--) {
            SV* const sv = *svp++;
-           HV* const basestash = gv_stashsv(sv, FALSE);
+           HV* const basestash = gv_stashsv(sv, 0);
            if (!basestash) {
                if (ckWARN(WARN_MISC))
                    Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
@@ -408,7 +408,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* if at top level, try UNIVERSAL */
 
     if (level == 0 || level == -1) {
-       lastchance = gv_stashpvs("UNIVERSAL", FALSE);
+       lastchance = gv_stashpvs("UNIVERSAL", 0);
 
        if (lastchance) {
            if ((gv = gv_fetchmeth(lastchance, name, len,
@@ -540,20 +540,20 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
            SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
                                                  CopSTASHPV(PL_curcop)));
            /* __PACKAGE__::SUPER stash should be autovivified */
-           stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), TRUE);
+           stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), GV_ADD);
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
                         origname, HvNAME_get(stash), name) );
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
-            stash = gv_stashpvn(origname, nsplit - origname, FALSE);
+            stash = gv_stashpvn(origname, nsplit - origname, 0);
 
            /* however, explicit calls to Pkg::SUPER::method may
               happen, and may require autovivification to work */
            if (!stash && (nsplit - origname) >= 7 &&
                strnEQ(nsplit - 7, "::SUPER", 7) &&
-               gv_stashpvn(origname, nsplit - origname - 7, FALSE))
-             stash = gv_stashpvn(origname, nsplit - origname, TRUE);
+               gv_stashpvn(origname, nsplit - origname - 7, 0))
+             stash = gv_stashpvn(origname, nsplit - origname, GV_ADD);
        }
        ostash = stash;
     }
@@ -682,7 +682,7 @@ STATIC HV*
 S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags)
 {
     dVAR;
-    HV* stash = gv_stashsv(namesv, FALSE);
+    HV* stash = gv_stashsv(namesv, 0);
     
     if (!stash || !(gv_fetchmethod(stash, methpv))) {
         SV *module = newSVsv(namesv);
@@ -694,7 +694,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
         Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        LEAVE;
        SPAGAIN;
-       stash = gv_stashsv(namesv, FALSE);
+       stash = gv_stashsv(namesv, 0);
        if (!stash)
            Perl_croak( aTHX_ "panic: Can't use %%%s because %"SVf" is not available", 
                varpv, SVfARG(module));
@@ -708,10 +708,8 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp
 /*
 =for apidoc gv_stashpv
 
-Returns a pointer to the stash for a specified package.  C<name> should
-be a valid UTF-8 string and must be null-terminated.  If C<create> is set
-then the package will be created if it does not already exist.  If C<create>
-is not set and the package does not exist then NULL is returned.
+Returns a pointer to the stash for a specified package.  Uses C<strlen> to
+determine the length of C<name, then calls C<gv_stashpvn()>.
 
 =cut
 */
@@ -725,17 +723,19 @@ Perl_gv_stashpv(pTHX_ const char *name, I32 create)
 /*
 =for apidoc gv_stashpvn
 
-Returns a pointer to the stash for a specified package.  C<name> should
-be a valid UTF-8 string.  The C<namelen> parameter indicates the length of
-the C<name>, in bytes.  If C<create> is set then the package will be
-created if it does not already exist.  If C<create> is not set and the
-package does not exist then NULL is returned.
+Returns a pointer to the stash for a specified package.  The C<namelen>
+parameter indicates the length of the C<name>, in bytes.  C<flags> is passed
+to C<gv_fetchpvn_flags()>, so if set to C<GV_ADD> then the package will be
+created if it does not already exist.  If the package does not exist and
+C<flags> is 0 (or any other setting that does not create packages) then NULL
+is returned.
+
 
 =cut
 */
 
 HV*
-Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
+Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
 {
     char smallbuf[128];
     char *tmpbuf;
@@ -750,11 +750,11 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen++] = ':';
     tmpbuf[namelen] = '\0';
-    tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, create, SVt_PVHV);
+    tmpgv = gv_fetchpvn_flags(tmpbuf, namelen, flags, SVt_PVHV);
     if (tmpbuf != smallbuf)
        Safefree(tmpbuf);
     if (!tmpgv)
-       return 0;
+       return NULL;
     if (!GvHV(tmpgv))
        GvHV(tmpgv) = newHV();
     stash = GvHV(tmpgv);
@@ -766,18 +766,17 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
 /*
 =for apidoc gv_stashsv
 
-Returns a pointer to the stash for a specified package, which must be a
-valid UTF-8 string.  See C<gv_stashpv>.
+Returns a pointer to the stash for a specified package.  See C<gv_stashpvn>.
 
 =cut
 */
 
 HV*
-Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
+Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
 {
     STRLEN len;
     const char * const ptr = SvPV_const(sv,len);
-    return gv_stashpvn(ptr, len, create);
+    return gv_stashpvn(ptr, len, flags);
 }
 
 
@@ -1056,15 +1055,15 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                        {
                            const char *pname;
                            av_push(av, newSVpvn(pname = "NDBM_File",9));
-                           gv_stashpvn(pname, 9, TRUE);
+                           gv_stashpvn(pname, 9, GV_ADD);
                            av_push(av, newSVpvn(pname = "DB_File",7));
-                           gv_stashpvn(pname, 7, TRUE);
+                           gv_stashpvn(pname, 7, GV_ADD);
                            av_push(av, newSVpvn(pname = "GDBM_File",9));
-                           gv_stashpvn(pname, 9, TRUE);
+                           gv_stashpvn(pname, 9, GV_ADD);
                            av_push(av, newSVpvn(pname = "SDBM_File",9));
-                           gv_stashpvn(pname, 9, TRUE);
+                           gv_stashpvn(pname, 9, GV_ADD);
                            av_push(av, newSVpvn(pname = "ODBM_File",9));
-                           gv_stashpvn(pname, 9, TRUE);
+                           gv_stashpvn(pname, 9, GV_ADD);
                        }
                }
                break;
@@ -1205,7 +1204,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            HV *const hv_tie = newHV();
             SV *tie = newRV_noinc((SV*)hv_tie);
 
-            sv_bless(tie, gv_stashsv(stashname,1));
+            sv_bless(tie, gv_stashsv(stashname,GV_ADD));
             hv_magic(hv, (GV*)tie, PERL_MAGIC_tied);    
             sv_magic((SV*)av, (plus ? (SV*)av : NULL), PERL_MAGIC_regdata, NULL, 0);
             sv_magic(GvSVn(gv), (SV*)gv, PERL_MAGIC_sv, name, len);