sv.c: Turn a FIXME comment into an explanation

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 036ac80..fa4b446 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1032,9 +1032,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '^':
-       if (!isGV_with_GP(PL_defoutgv))
-           s = "";
-       else if (GvIOp(PL_defoutgv))
+       if (GvIOp(PL_defoutgv))
                s = IoTOP_NAME(GvIOp(PL_defoutgv));
        if (s)
            sv_setpv(sv,s);
@@ -1044,9 +1042,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '~':
-       if (!isGV_with_GP(PL_defoutgv))
-           s = "";
-       else if (GvIOp(PL_defoutgv))
+       if (GvIOp(PL_defoutgv))
            s = IoFMT_NAME(GvIOp(PL_defoutgv));
        if (!s)
            s = GvENAME(PL_defoutgv);
@@ -1069,7 +1065,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '/':
        break;
     case '[':
-       sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop));
+       sv_setiv(sv, 0);
        break;
     case '|':
        if (GvIO(PL_defoutgv))
@@ -1306,7 +1302,9 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_GETSIG;
 
     if (!i) {
-       mg->mg_private = i = whichsig(MgPV_nolen_const(mg));
+        STRLEN siglen;
+        const char * sig = MgPV_const(mg, siglen);
+        mg->mg_private = i = whichsig_pvn(sig, siglen);
     }
 
     if (i > 0) {
@@ -1497,9 +1495,9 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_SETSIG;
 
     if (*s == '_') {
-       if (strEQ(s,"__DIE__"))
+        if (memEQs(s, len, "__DIE__"))
            svp = &PL_diehook;
-       else if (strEQ(s,"__WARN__")
+       else if (memEQs(s, len, "__WARN__")
                 && (sv ? 1 : PL_warnhook != PERL_WARNHOOK_FATAL)) {
            /* Merge the existing behaviours, which are as follows:
               magic_setsig, we always set svp to &PL_warnhook
@@ -1507,8 +1505,11 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
               For magic_clearsig, we don't change the warnings handler if it's
               set to the &PL_warnhook.  */
            svp = &PL_warnhook;
-       } else if (sv)
-           Perl_croak(aTHX_ "No such hook: %s", s);
+        } else if (sv) {
+            SV *tmp = sv_newmortal();
+            Perl_croak(aTHX_ "No such hook: %s",
+                                pv_pretty(tmp, s, len, 0, NULL, NULL, 0));
+        }
        i = 0;
        if (svp && *svp) {
            if (*svp != PERL_WARNHOOK_FATAL)
@@ -1519,12 +1520,15 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     else {
        i = (I16)mg->mg_private;
        if (!i) {
-           i = whichsig(s);    /* ...no, a brick */
+           i = whichsig_pvn(s, len);   /* ...no, a brick */
            mg->mg_private = (U16)i;
        }
        if (i <= 0) {
-           if (sv)
-               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
+           if (sv) {
+                SV *tmp = sv_newmortal();
+               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s",
+                                            pv_pretty(tmp, s, len, 0, NULL, NULL, 0));
+            }
            return 0;
        }
 #ifdef HAS_SIGPROCMASK
@@ -1580,7 +1584,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        } else {
            sv = NULL;
        }
-       if (sv && strEQ(s,"IGNORE")) {
+       if (sv && memEQs(s, len,"IGNORE")) {
            if (i) {
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
                PL_sig_ignoring[i] = 1;
@@ -1590,7 +1594,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
            }
        }
-       else if (!sv || strEQ(s,"DEFAULT") || !len) {
+       else if (!sv || memEQs(s, len,"DEFAULT") || !len) {
            if (i) {
 #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
                PL_sig_defaulting[i] = 1;
@@ -2018,7 +2022,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_GETARYLEN;
 
     if (obj) {
-       sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
+       sv_setiv(sv, AvFILL(obj));
     } else {
        SvOK_off(sv);
     }
@@ -2034,7 +2038,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_SETARYLEN;
 
     if (obj) {
-       av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
+       av_fill(obj, SvIV(sv));
     } else {
        Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                       "Attempt to set length of freed array");
@@ -2082,7 +2086,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
            I32 i = found->mg_len;
            if (DO_UTF8(lsv))
                sv_pos_b2u(lsv, &i);
-           sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
+           sv_setiv(sv, i);
            return 0;
        }
     }
@@ -2123,7 +2127,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
 
-    pos = SvIV(sv) - CopARYBASE_get(PL_curcop);
+    pos = SvIV(sv);
 
     if (DO_UTF8(lsv)) {
        ulen = sv_len_utf8(lsv);
@@ -2188,10 +2192,15 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
     PERL_ARGS_ASSERT_MAGIC_SETSUBSTR;
     PERL_UNUSED_ARG(mg);
 
+    SvGETMAGIC(lsv);
+    if (SvROK(lsv))
+       Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+                           "Attempt to use reference as lvalue in substr"
+       );
     if (DO_UTF8(sv)) {
        sv_utf8_upgrade(lsv);
        lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN);
-       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0);
        LvTARGLEN(sv) = sv_len_utf8(sv);
        SvUTF8_on(lsv);
     }
@@ -2200,11 +2209,11 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN);
        LvTARGLEN(sv) = len;
        utf8 = (char*)bytes_to_utf8((U8*)tmps, &len);
-       sv_insert(lsv, lvoff, lvlen, utf8, len);
+       sv_insert_flags(lsv, lvoff, lvlen, utf8, len, 0);
        Safefree(utf8);
     }
     else {
-       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0);
        LvTARGLEN(sv) = len;
     }
 
@@ -2483,6 +2492,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         break;
     case '\001':       /* ^A */
        sv_setsv(PL_bodytarget, sv);
+       FmLINES(PL_bodytarget) = 0;
+       if (SvPOK(PL_bodytarget)) {
+           char *s = SvPVX(PL_bodytarget);
+           while ( ((s = strchr(s, '\n'))) ) {
+               FmLINES(PL_bodytarget)++;
+               s++;
+           }
+       }
        /* mg_set() has temporarily made sv non-magical */
        if (PL_tainting) {
            if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1)
@@ -2661,33 +2678,25 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv);
        break;
     case '^':
-       if (isGV_with_GP(PL_defoutgv)) {
-           Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
-           s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-           IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
-       }
+       Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
+       s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+       IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '~':
-       if (isGV_with_GP(PL_defoutgv)) {
-           Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
-           s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-           IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
-       }
+       Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
+       s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
+       IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '=':
-       if (isGV_with_GP(PL_defoutgv))
-           IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
+       IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
        break;
     case '-':
-       if (isGV_with_GP(PL_defoutgv)) {
-           IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
-           if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
+       IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
+       if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
                IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
-       }
        break;
     case '%':
-       if (isGV_with_GP(PL_defoutgv))
-           IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
+       IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
        break;
     case '|':
        {
@@ -2719,9 +2728,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            PL_ors_sv = NULL;
        }
        break;
-    case '[':
-       CopARYBASE_set(&PL_compiling, SvIV(sv));
-       break;
     case '?':
 #ifdef COMPLEX_STATUS
        if (PL_localizing == 2) {
@@ -2819,7 +2825,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        (void)setregid((Gid_t)PL_gid, (Gid_t)-1);
 #else
 #ifdef HAS_SETRESGID
-      (void)setresgid((Gid_t)PL_gid, (Gid_t)-1, (Gid_t) 1);
+      (void)setresgid((Gid_t)PL_gid, (Gid_t)-1, (Gid_t) -1);
 #else
        if (PL_gid == PL_egid)                  /* special case $( = $) */
            (void)PerlProc_setgid(PL_gid);
@@ -2984,22 +2990,41 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 }
 
 I32
-Perl_whichsig(pTHX_ const char *sig)
+Perl_whichsig_sv(pTHX_ SV *sigsv)
+{
+    const char *sigpv;
+    STRLEN siglen;
+    PERL_ARGS_ASSERT_WHICHSIG_SV;
+    PERL_UNUSED_CONTEXT;
+    sigpv = SvPV_const(sigsv, siglen);
+    return whichsig_pvn(sigpv, siglen);
+}
+
+I32
+Perl_whichsig_pv(pTHX_ const char *sig)
+{
+    PERL_ARGS_ASSERT_WHICHSIG_PV;
+    PERL_UNUSED_CONTEXT;
+    return whichsig_pvn(sig, strlen(sig));
+}
+
+I32
+Perl_whichsig_pvn(pTHX_ const char *sig, STRLEN len)
 {
     register char* const* sigv;
 
-    PERL_ARGS_ASSERT_WHICHSIG;
+    PERL_ARGS_ASSERT_WHICHSIG_PVN;
     PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
-       if (strEQ(sig,*sigv))
+       if (strlen(*sigv) == len && memEQ(sig,*sigv, len))
            return PL_sig_num[sigv - (char* const*)PL_sig_name];
 #ifdef SIGCLD
-    if (strEQ(sig,"CHLD"))
+    if (memEQs(sig, len, "CHLD"))
        return SIGCLD;
 #endif
 #ifdef SIGCHLD
-    if (strEQ(sig,"CLD"))
+    if (memEQs(sig, len, "CLD"))
        return SIGCHLD;
 #endif
     return -1;