As we know the length, replace strEQ with memEQs in S_doopen_pm().

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 7f37b75..39f18b2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2660,14 +2660,6 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
-STATIC void
-S_docatch_body(pTHX)
-{
-    dVAR;
-    CALLRUNOPS(aTHX);
-    return;
-}
-
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
@@ -2688,7 +2680,7 @@ S_docatch(pTHX_ OP *o)
        assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
        cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env;
  redo_body:
-       docatch_body();
+       CALLRUNOPS(aTHX);
        break;
     case 3:
        /* die caught by an inner eval - continue inner loop */
@@ -3014,7 +3006,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 }
 
 STATIC PerlIO *
-S_check_type_and_open(pTHX_ const char *name, const char *mode)
+S_check_type_and_open(pTHX_ const char *name)
 {
     Stat_t st;
     const int st_rc = PerlLIO_stat(name, &st);
@@ -3023,36 +3015,40 @@ S_check_type_and_open(pTHX_ const char *name, const char *mode)
        return NULL;
     }
 
-    return PerlIO_open(name, mode);
+    return PerlIO_open(name, PERL_SCRIPT_MODE);
 }
 
+#ifndef PERL_DISABLE_PMC
 STATIC PerlIO *
-S_doopen_pm(pTHX_ const char *name, const char *mode)
+S_doopen_pm(pTHX_ const char *name, const STRLEN namelen)
 {
-#ifndef PERL_DISABLE_PMC
-    const STRLEN namelen = strlen(name);
     PerlIO *fp;
 
-    if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
-       SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
-       const char * const pmc = SvPV_nolen_const(pmcsv);
+    if (namelen > 3 && memEQs(name + namelen - 3, 3, ".pm")) {
+       SV *const pmcsv = newSV(namelen + 2);
+       char *const pmc = SvPVX(pmcsv);
        Stat_t pmcstat;
+
+       memcpy(pmc, name, namelen);
+       pmc[namelen] = 'c';
+       pmc[namelen + 1] = '\0';
+
        if (PerlLIO_stat(pmc, &pmcstat) < 0) {
-           fp = check_type_and_open(name, mode);
+           fp = check_type_and_open(name);
        }
        else {
-           fp = check_type_and_open(pmc, mode);
+           fp = check_type_and_open(pmc);
        }
        SvREFCNT_dec(pmcsv);
     }
     else {
-       fp = check_type_and_open(name, mode);
+       fp = check_type_and_open(name);
     }
     return fp;
+}
 #else
-    return check_type_and_open(name, mode);
+#  define doopen_pm(name, namelen) check_type_and_open(name)
 #endif /* !PERL_DISABLE_PMC */
-}
 
 PP(pp_require)
 {
@@ -3144,8 +3140,11 @@ PP(pp_require)
            vcmp(sv, sv_2mortal(upg_version(newSVnv(5.006), FALSE))) >= 0) {
          HV * hinthv = GvHV(PL_hintgv);
          if( hinthv ) {
-           (void)hv_stores(hinthv, "v_string", newSViv(1));
-           PL_hints |= HINT_LOCALIZE_HH;
+             SV *hint = newSViv(1);
+             (void)hv_stores(hinthv, "v_string", hint);
+             /* This will call through to Perl_magic_sethint() which in turn
+                sets PL_hints correctly.  */
+             SvSETMAGIC(hint);
          }
          /* If we request a version >= 5.9.5, load feature.pm with the
           * feature bundle that corresponds to the required version. */
@@ -3202,7 +3201,7 @@ PP(pp_require)
 
     if (path_is_absolute(name)) {
        tryname = name;
-       tryrsfp = doopen_pm(name,PERL_SCRIPT_MODE);
+       tryrsfp = doopen_pm(name, len);
     }
 #ifdef MACOS_TRADITIONAL
     if (!tryrsfp) {
@@ -3211,7 +3210,7 @@ PP(pp_require)
        MacPerl_CanonDir(name, newname, 1);
        if (path_is_absolute(newname)) {
            tryname = newname;
-           tryrsfp = doopen_pm(newname,PERL_SCRIPT_MODE);
+           tryrsfp = doopen_pm(newname, strlen(newname));
        }
     }
 #endif
@@ -3223,6 +3222,7 @@ PP(pp_require)
 #endif
        {
            namesv = newSV(0);
+           sv_upgrade(namesv, SVt_PV);
            for (i = 0; i <= AvFILL(ar); i++) {
                SV * const dirsv = *av_fetch(ar, i, TRUE);
 
@@ -3352,7 +3352,16 @@ PP(pp_require)
                        || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
 #endif
                  ) {
-                   const char *dir = SvOK(dirsv) ? SvPV_nolen_const(dirsv) : "";
+                   const char *dir;
+                   STRLEN dirlen;
+
+                   if (SvOK(dirsv)) {
+                       dir = SvPV_const(dirsv, dirlen);
+                   } else {
+                       dir = "";
+                       dirlen = 0;
+                   }
+
 #ifdef MACOS_TRADITIONAL
                    char buf1[256];
                    char buf2[256];
@@ -3380,13 +3389,32 @@ PP(pp_require)
                                       "%s\\%s",
                                       dir, name);
 #    else
-                   Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
+                   /* The equivalent of                    
+                      Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
+                      but without the need to parse the format string, or
+                      call strlen on either pointer, and with the correct
+                      allocation up front.  */
+                   {
+                       char *tmp = SvGROW(namesv, dirlen + len + 2);
+
+                       memcpy(tmp, dir, dirlen);
+                       tmp +=dirlen;
+                       *tmp++ = '/';
+                       /* name came from an SV, so it will have a '\0' at the
+                          end that we can copy as part of this memcpy().  */
+                       memcpy(tmp, name, len + 1);
+
+                       SvCUR_set(namesv, dirlen + len + 1);
+
+                       /* Don't even actually have to turn SvPOK_on() as we
+                          access it directly with SvPVX() below.  */
+                   }
 #    endif
 #  endif
 #endif
                    TAINT_PROPER("require");
                    tryname = SvPVX_const(namesv);
-                   tryrsfp = doopen_pm(tryname, PERL_SCRIPT_MODE);
+                   tryrsfp = doopen_pm(tryname, SvCUR(namesv));
                    if (tryrsfp) {
                        if (tryname[0] == '.' && tryname[1] == '/')
                            tryname += 2;