Remove Windows 95 support from win32/makefile.mk

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 86f1eb6..bb4c04a 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1069,7 +1069,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))
@@ -1080,7 +1080,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
            sv_copypv(sv, PL_ors_sv);
        break;
     case '$': /* $$ */
-       sv_setiv(sv, (IV)PerlProc_getpid());
+       {
+           IV const pid = (IV)PerlProc_getpid();
+           if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid)
+               /* never set manually, or at least not since last fork */
+               sv_setiv(sv, pid);
+           /* else a value has been assigned manually, so do nothing */
+       }
        break;
 
     case '!':
@@ -1727,13 +1733,20 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 
 Invoke a magic method (like FETCH).
 
-* sv and mg are the tied thingy and the tie magic;
-* meth is the name of the method to call;
-* argc is the number of args (in addition to $self) to pass to the method;
-       the args themselves are any values following the argc argument.
-* flags:
-    G_DISCARD:     invoke method with G_DISCARD flag and don't return a value
-    G_UNDEF_FILL:  fill the stack with argc pointers to PL_sv_undef.
+C<sv> and C<mg> are the tied thingy and the tie magic.
+
+C<meth> is the name of the method to call.
+
+C<argc> is the number of args (in addition to $self) to pass to the method.
+
+The C<flags> can be:
+
+    G_DISCARD     invoke method with G_DISCARD flag and don't
+                  return a value
+    G_UNDEF_FILL  fill the stack with argc pointers to
+                  PL_sv_undef
+
+The arguments themselves are any values following the C<flags> argument.
 
 Returns the SV (if any) returned by the method, or NULL on failure.
 
@@ -2005,7 +2018,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);
     }
@@ -2021,7 +2034,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");
@@ -2069,7 +2082,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;
        }
     }
@@ -2110,7 +2123,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);
@@ -2352,9 +2365,8 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_ARGS_ASSERT_MAGIC_SETMGLOB;
     PERL_UNUSED_CONTEXT;
+    PERL_UNUSED_ARG(sv);
     mg->mg_len = -1;
-    if (!isGV_with_GP(sv))
-       SvSCREAM_off(sv);
     return 0;
 }
 
@@ -2381,6 +2393,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
     } else if (type == PERL_MAGIC_bm) {
        SvTAIL_off(sv);
        SvVALID_off(sv);
+    } else if (type == PERL_MAGIC_study) {
+       if (!isGV_with_GP(sv))
+           SvSCREAM_off(sv);
     } else {
        assert(type == PERL_MAGIC_fm);
     }
@@ -2468,6 +2483,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)
@@ -2705,7 +2728,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '[':
-       CopARYBASE_set(&PL_compiling, SvIV(sv));
+       if (SvIV(sv) != 0)
+           Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible");
        break;
     case '?':
 #ifdef COMPLEX_STATUS
@@ -2881,6 +2905,17 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case ':':
        PL_chopset = SvPV_force(sv,len);
        break;
+    case '$': /* $$ */
+       /* Store the pid in mg->mg_obj so we can tell when a fork has
+          occurred.  mg->mg_obj points to *$ by default, so clear it. */
+       if (isGV(mg->mg_obj)) {
+           if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */
+               SvREFCNT_dec(mg->mg_obj);
+           mg->mg_flags |= MGf_REFCOUNTED;
+           mg->mg_obj = newSViv((IV)PerlProc_getpid());
+       }
+       else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid());
+       break;
     case '0':
        LOCK_DOLLARZERO_MUTEX;
 #ifdef HAS_SETPROCTITLE