A better fix than change 24005 was ;)

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index bf9ecee..c24bf6d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,7 +1,7 @@
 /*    mg.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
 /*    mg.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,

- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others

  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.


@@ -20,10 +20,10 @@
 "magical" properties.  When any Perl code tries to read from, or assign to,
 an SV marked as magical, it calls the 'get' or 'set' function associated
 with that SV's magic. A get is called prior to reading an SV, in order to
 "magical" properties.  When any Perl code tries to read from, or assign to,
 an SV marked as magical, it calls the 'get' or 'set' function associated
 with that SV's magic. A get is called prior to reading an SV, in order to

-give it a chance to update its interval value (get on $. writes the line
+give it a chance to update its internal value (get on $. writes the line

 number of the last read filehandle into to the SV's IV slot), while
 set is called after an SV has been written to, in order to allow it to make
 number of the last read filehandle into to the SV's IV slot), while
 set is called after an SV has been written to, in order to allow it to make

-use of it's changed value (set on $/ copies the SV's new value to the
+use of its changed value (set on $/ copies the SV's new value to the

 PL_rs global variable).
 
 Magic is implemented as a linked list of MAGIC structures attached to the
 PL_rs global variable).
 
 Magic is implemented as a linked list of MAGIC structures attached to the


@@ -208,7 +208,7 @@ Perl_mg_get(pTHX_ SV *sv)
     if (SvREFCNT(sv) == 1) {
        /* We hold the last reference to this SV, which implies that the
           SV was deleted as a side effect of the routines we called.  */
     if (SvREFCNT(sv) == 1) {
        /* We hold the last reference to this SV, which implies that the
           SV was deleted as a side effect of the routines we called.  */

-       (void)SvOK_off(sv);
+       SvOK_off(sv);

     }
     return 0;
 }
     }
     return 0;
 }


@@ -695,7 +695,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '\023':               /* ^S */
         if (*(mg->mg_ptr+1) == '\0') {
            if (PL_lex_state != LEX_NOTPARSING)
     case '\023':               /* ^S */
         if (*(mg->mg_ptr+1) == '\0') {
            if (PL_lex_state != LEX_NOTPARSING)

-               (void)SvOK_off(sv);
+               SvOK_off(sv);

            else if (PL_in_eval)
                sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
            else
            else if (PL_in_eval)
                sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
            else


@@ -715,9 +715,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
                    : 0);
         break;
                    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
                    : 0);
         break;

-    case '\025':               /* $^UNICODE */
+    case '\025':               /* $^UNICODE, $^UTF8LOCALE */

         if (strEQ(mg->mg_ptr, "\025NICODE"))
            sv_setuv(sv, (UV) PL_unicode);
         if (strEQ(mg->mg_ptr, "\025NICODE"))
            sv_setuv(sv, (UV) PL_unicode);

+        else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+           sv_setuv(sv, (UV) PL_utf8locale);

         break;
     case '\027':               /* ^W  & $^WARNING_BITS */
        if (*(mg->mg_ptr+1) == '\0')
         break;
     case '\027':               /* ^W  & $^WARNING_BITS */
        if (*(mg->mg_ptr+1) == '\0')


@@ -1082,6 +1084,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #      endif
     {
 #      ifndef PERL_USE_SAFE_PUTENV
 #      endif
     {
 #      ifndef PERL_USE_SAFE_PUTENV

+    if (!PL_use_safe_putenv) {

     I32 i;
 
     if (environ == PL_origenviron)
     I32 i;
 
     if (environ == PL_origenviron)


@@ -1089,6 +1092,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     else
        for (i = 0; environ[i]; i++)
            safesysfree(environ[i]);
     else
        for (i = 0; environ[i]; i++)
            safesysfree(environ[i]);

+    }

 #      endif /* PERL_USE_SAFE_PUTENV */
 
     environ[0] = Nullch;
 #      endif /* PERL_USE_SAFE_PUTENV */
 
     environ[0] = Nullch;


@@ -1688,7 +1692,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
            return 0;
        }
     }
            return 0;
        }
     }

-    (void)SvOK_off(sv);
+    SvOK_off(sv);

     return 0;
 }
 
     return 0;
 }
 


@@ -1760,16 +1764,11 @@ Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {
 int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {

-    register char *s;

     GV* gv;
     GV* gv;

-    STRLEN n_a;
-
+ 

     if (!SvOK(sv))
        return 0;
     if (!SvOK(sv))
        return 0;

-    s = SvPV(sv, n_a);
-    if (*s == '*' && s[1])
-       s++;
-    gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+    gv = gv_fetchsv(sv,TRUE, SVt_PVGV);

     if (sv == (SV*)gv)
        return 0;
     if (GvGP(sv))
     if (sv == (SV*)gv)
        return 0;
     if (GvGP(sv))


@@ -1861,7 +1860,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     SV *lsv = LvTARG(sv);
 
     if (!lsv) {
     SV *lsv = LvTARG(sv);
 
     if (!lsv) {

-       (void)SvOK_off(sv);
+       SvOK_off(sv);

        return 0;
     }
 
        return 0;
     }
 


@@ -1968,7 +1967,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
                Perl_croak(aTHX_ "panic: magic_killbackrefs");
            /* XXX Should we check that it hasn't changed? */
            SvRV(svp[i]) = 0;
                Perl_croak(aTHX_ "panic: magic_killbackrefs");
            /* XXX Should we check that it hasn't changed? */
            SvRV(svp[i]) = 0;

-           (void)SvOK_off(svp[i]);
+           SvOK_off(svp[i]);

            SvWEAKREF_off(svp[i]);
            svp[i] = Nullsv;
        }
            SvWEAKREF_off(svp[i]);
            svp[i] = Nullsv;
        }


@@ -2071,7 +2070,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '\004':       /* ^D */
 #ifdef DEBUGGING
        s = SvPV_nolen(sv);
     case '\004':       /* ^D */
 #ifdef DEBUGGING
        s = SvPV_nolen(sv);

-       PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
+       PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;

        DEBUG_x(dump_all());
 #else
        PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
        DEBUG_x(dump_all());
 #else
        PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;


@@ -2119,7 +2118,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        if (PL_inplace)
            Safefree(PL_inplace);
        if (SvOK(sv))
        if (PL_inplace)
            Safefree(PL_inplace);
        if (SvOK(sv))

-           PL_inplace = savepv(SvPV(sv,len));
+           PL_inplace = savesvpv(sv);

        else
            PL_inplace = Nullch;
        break;
        else
            PL_inplace = Nullch;
        break;


@@ -2131,7 +2130,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            }
            if (SvOK(sv)) {
                TAINT_PROPER("assigning to $^O");
            }
            if (SvOK(sv)) {
                TAINT_PROPER("assigning to $^O");

-               PL_osname = savepv(SvPV(sv,len));
+               PL_osname = savesvpv(sv);

            }
        }
        else if (strEQ(mg->mg_ptr, "\017PEN")) {
            }
        }
        else if (strEQ(mg->mg_ptr, "\017PEN")) {


@@ -2207,13 +2206,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
        break;
     case '^':
        Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));

-       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
-       IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+       IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
+       IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);

        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
        break;
     case '~':
        Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));

-       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
-       IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+       IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savesvpv(sv);
+       IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);

        break;
     case '=':
        IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '=':
        IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));


@@ -2270,7 +2269,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '#':
        if (PL_ofmt)
            Safefree(PL_ofmt);
     case '#':
        if (PL_ofmt)
            Safefree(PL_ofmt);

-       PL_ofmt = savepv(SvPV(sv,len));
+       PL_ofmt = savesvpv(sv);

        break;
     case '[':
        PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        break;
     case '[':
        PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);


@@ -2617,7 +2616,7 @@ Perl_sighandler(int sig)
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */

-       Perl_die(aTHX_ Nullformat);
+       DieNull;

     }
 cleanup:
     if (flags & 1)
     }
 cleanup:
     if (flags & 1)