This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
util.c:report_wrongway_fh: Don’t create an SV
[perl5.git] / util.c
diff --git a/util.c b/util.c
index 7a8f3bb..c080dc0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -557,11 +557,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 
     PERL_ARGS_ASSERT_FBM_COMPILE;
 
-    /* Refuse to fbm_compile a studied scalar, as this gives more flexibility in
-       SV flag usage.  No real-world code would ever end up using a studied
-       scalar as a compile-time second argument to index, so this isn't a real
-       pessimisation.  */
-    if (SvSCREAM(sv))
+    if (isGV_with_GP(sv))
        return;
 
     if (SvVALID(sv))
@@ -1310,8 +1306,9 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume)
        if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO)
                && IoLINES(GvIOp(PL_last_in_gv)))
        {
+           STRLEN l;
            const bool line_mode = (RsSIMPLE(PL_rs) &&
-                             SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');
+                                  *SvPV_const(PL_rs,l) == '\n' && l == 1);
            Perl_sv_catpvf(aTHX_ sv, ", <%"SVf"> %s %"IVdf,
                           SVfARG(PL_last_in_gv == PL_argvgv
                                  ? &PL_sv_no
@@ -3719,15 +3716,15 @@ void
 Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have)
 {
     if (ckWARN(WARN_IO)) {
-        SV * const name
-           = gv && (isGV(gv) || isGV_with_GP(gv))
-                ? sv_2mortal(newSVhek(GvENAME_HEK((gv))))
+        HEK * const name
+           = gv && (isGV_with_GP(gv))
+                ? GvENAME_HEK((gv))
                 : NULL;
        const char * const direction = have == '>' ? "out" : "in";
 
-       if (name && SvPOK(name) && *SvPV_nolen(name))
+       if (name && *HEK_KEY(name))
            Perl_warner(aTHX_ packWARN(WARN_IO),
-                       "Filehandle %"SVf" opened only for %sput",
+                       "Filehandle %"HEKf" opened only for %sput",
                        name, direction);
        else
            Perl_warner(aTHX_ packWARN(WARN_IO),
@@ -5698,40 +5695,6 @@ Perl_get_hash_seed(pTHX)
      return myseed;
 }
 
-#ifdef USE_ITHREADS
-bool
-Perl_stashpv_hvname_match(pTHX_ const COP *c, const HV *hv)
-{
-    const char * stashpv = CopSTASHPV(c);
-    const char * name    = HvNAME_get(hv);
-    const bool utf8 = CopSTASH_len(c) < 0;
-    const I32  len  = utf8 ? -CopSTASH_len(c) : CopSTASH_len(c);
-    PERL_UNUSED_CONTEXT;
-    PERL_ARGS_ASSERT_STASHPV_HVNAME_MATCH;
-
-    if (!stashpv || !name)
-       return stashpv == name;
-    if ( !HvNAMEUTF8(hv) != !utf8 ) {
-        if (utf8) {
-            return (bytes_cmp_utf8(
-                        (const U8*)stashpv, len,
-                        (const U8*)name, HEK_LEN(HvNAME_HEK(hv))) == 0);
-        } else {
-            return (bytes_cmp_utf8(
-                        (const U8*)name, HEK_LEN(HvNAME_HEK(hv)),
-                        (const U8*)stashpv, len) == 0);
-        }
-    }
-    else
-        return (stashpv == name
-                    || (HEK_LEN(HvNAME_HEK(hv)) == len
-                        && memEQ(stashpv, name, len)));
-    /*NOTREACHED*/
-    return FALSE;
-}
-#endif
-
-
 #ifdef PERL_GLOBAL_STRUCT
 
 #define PERL_GLOBAL_STRUCT_INIT