s/PERL_COPY_ON_WRITE/PERL_OLD_COPY_ON_WRITE/g

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 21a3747..5a224e2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -81,7 +81,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
     MGS* mgs;
     assert(SvMAGICAL(sv));
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
     /* Turning READONLY off for a copy-on-write scalar is a bad idea.  */
     if (SvIsCOW(sv))
       sv_force_normal(sv);
@@ -263,11 +263,11 @@ Perl_mg_length(pTHX_ SV *sv)
     }
 
     if (DO_UTF8(sv)) {
-        U8 *s = (U8*)SvPV(sv, len);
+        const U8 *s = (U8*)SvPV_const(sv, len);
         len = Perl_utf8_length(aTHX_ s, s + len);
     }
     else
-        (void)SvPV(sv, len);
+        (void)SvPV_const(sv, len);
     return len;
 }
 
@@ -468,12 +468,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 {
     (void)sv; (void)mg;
     Perl_croak(aTHX_ PL_no_modify);
-    /* NOT REACHED */
-#ifndef HASATTRIBUTE
-    /* No __attribute__, so the compiler doesn't know that croak never returns
-     */
-    return 0;
-#endif
+    NORETURN_FUNCTION_END;
 }
 
 U32
@@ -499,11 +494,12 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
              getlen:
                if (i > 0 && RX_MATCH_UTF8(rx)) {
                    char *s    = rx->subbeg + s1;
-                   char *send = rx->subbeg + t1;
+                   const U8 *ep;
+                   STRLEN el;
 
                     i = t1 - s1;
-                   if (is_utf8_string((U8*)s, i))
-                       i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
+                   if (is_utf8_string_loclen((U8*)s, i, &ep, &el))
+                       i = el;
                }
                if (i < 0)
                    Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
@@ -581,8 +577,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\001':               /* ^A */
        sv_setsv(sv, PL_bodytarget);
        break;
-    case '\003':               /* ^C */
-       sv_setiv(sv, (IV)PL_minus_c);
+    case '\003':               /* ^C, ^CHILD_ERROR_NATIVE */
+       if (*(mg->mg_ptr+1) == '\0') {
+           sv_setiv(sv, (IV)PL_minus_c);
+       }
+       else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+           sv_setiv(sv, (IV)STATUS_NATIVE);
+        }
        break;
 
     case '\004':               /* ^D */
@@ -608,7 +609,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                  if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
                       sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
                  else
-                      sv_setpv(sv,"");
+                      sv_setpvn(sv,"",0);
             }
 #else
 #ifdef OS2
@@ -634,7 +635,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                       PerlProc_GetOSError(sv, dwErr);
                  }
                  else
-                      sv_setpv(sv, "");
+                      sv_setpvn(sv, "", 0);
                  SetLastError(dwErr);
             }
 #else
@@ -820,11 +821,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        sv_setsv(sv,&PL_sv_undef);
        break;
     case '.':
-#ifndef lint
        if (GvIO(PL_last_in_gv)) {
            sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));
        }
-#endif
        break;
     case '?':
        {
@@ -852,7 +851,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            s = GvENAME(PL_defoutgv);
        sv_setpv(sv,s);
        break;
-#ifndef lint
     case '=':
        if (GvIOp(PL_defoutgv))
            sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
@@ -865,7 +863,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        if (GvIOp(PL_defoutgv))
            sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
        break;
-#endif
     case ':':
        break;
     case '/':
@@ -914,21 +911,21 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '(':
        sv_setiv(sv, (IV)PL_gid);
 #ifdef HAS_GETGROUPS
-       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
+       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid);
 #endif
        goto add_groups;
     case ')':
        sv_setiv(sv, (IV)PL_egid);
 #ifdef HAS_GETGROUPS
-       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
+       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid);
 #endif
       add_groups:
 #ifdef HAS_GETGROUPS
        {
            Groups_t gary[NGROUPS];
-           i = getgroups(NGROUPS,gary);
-           while (--i >= 0)
-               Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]);
+           I32 j = getgroups(NGROUPS,gary);
+           while (--j >= 0)
+               Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]);
        }
 #endif
        (void)SvIOK_on(sv);     /* what a wonderful hack! */
@@ -956,11 +953,11 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     register char *s;
-    char *ptr;
+    const char *ptr;
     STRLEN len, klen;
 
     s = SvPV(sv,len);
-    ptr = MgPV(mg,klen);
+    ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
 #ifdef DYNAMIC_ENV_FETCH
@@ -1605,13 +1602,13 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
    
     if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
         SV *key;
-        if (HvEITER(hv))
+        if (HvEITER_get(hv))
             /* we are in an iteration so the hash cannot be empty */
             return &PL_sv_yes;
         /* no xhv_eiter so now use FIRSTKEY */
         key = sv_newmortal();
         magic_nextpack((SV*)hv, mg, key);
-        HvEITER(hv) = NULL;     /* need to reset iterator */
+        HvEITER_set(hv, NULL);     /* need to reset iterator */
         return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
     }
    
@@ -2291,7 +2288,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
        else
 #endif
-           STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
         {
@@ -2646,7 +2643,7 @@ restore_magic(pTHX_ const void *p)
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
     {
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        /* While magic was saved (and off) sv_setsv may well have seen
           this SV as a prime candidate for COW.  */
        if (SvIsCOW(sv))
@@ -2698,4 +2695,12 @@ unwind_handler_stack(pTHX_ const void *p)
 #endif
 }
 
-
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */