A better fix than change 24005 was ;)

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 0feb7da..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,
- *    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.
@@ -15,6 +15,24 @@
 
 /*
 =head1 Magical Functions
+
+"Magic" is special data attached to SV structures in order to give them
+"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 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
+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
+SV. Each MAGIC struct holds the type of the magic, a pointer to an array
+of functions that implement the get(), set(), length() etc functions,
+plus space for some flags and pointers. For example, a tied variable has
+a MAGIC structure that contains a pointer to the object associated with the
+tie.
+
 */
 
 #include "EXTERN.h"
@@ -677,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)
-               (void)SvOK_off(sv);
+               SvOK_off(sv);
            else if (PL_in_eval)
                sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE));
            else
@@ -697,9 +715,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                    ? (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);
+        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')
@@ -1064,6 +1084,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #      endif
     {
 #      ifndef PERL_USE_SAFE_PUTENV
+    if (!PL_use_safe_putenv) {
     I32 i;
 
     if (environ == PL_origenviron)
@@ -1071,6 +1092,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     else
        for (i = 0; environ[i]; i++)
            safesysfree(environ[i]);
+    }
 #      endif /* PERL_USE_SAFE_PUTENV */
 
     environ[0] = Nullch;
@@ -1670,7 +1692,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
            return 0;
        }
     }
-    (void)SvOK_off(sv);
+    SvOK_off(sv);
     return 0;
 }
 
@@ -1742,16 +1764,11 @@ Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {
-    register char *s;
     GV* gv;
-    STRLEN n_a;
-
+ 
     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))
@@ -1843,7 +1860,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     SV *lsv = LvTARG(sv);
 
     if (!lsv) {
-       (void)SvOK_off(sv);
+       SvOK_off(sv);
        return 0;
     }
 
@@ -1950,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;
-           (void)SvOK_off(svp[i]);
+           SvOK_off(svp[i]);
            SvWEAKREF_off(svp[i]);
            svp[i] = Nullsv;
        }
@@ -2053,7 +2070,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     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;
@@ -2101,7 +2118,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        if (PL_inplace)
            Safefree(PL_inplace);
        if (SvOK(sv))
-           PL_inplace = savepv(SvPV(sv,len));
+           PL_inplace = savesvpv(sv);
        else
            PL_inplace = Nullch;
        break;
@@ -2113,7 +2130,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            }
            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")) {
@@ -2189,13 +2206,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        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)));
-       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));
@@ -2252,7 +2269,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     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);
@@ -2599,7 +2616,7 @@ Perl_sighandler(int sig)
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-       Perl_die(aTHX_ Nullformat);
+       DieNull;
     }
 cleanup:
     if (flags & 1)