Disable PL_sawampersand

PL_sawampersand actually causes bugs (e.g., perl #4289), because the
behaviour changes.  eval '$&' after a match will produce different
results depending on whether $& was seen before the match.

Using copy-on-write for the pre-match copy (preceding patches do that)
alleviates the slowdown caused by mentioning $&.  The copy doesn’t
happen unless the string is modified after the match.  It’s now a
post- match copy.  So we no longer need to do things differently
depending on whether $& has been seen.

PL_sawampersand is now #defined to be equal to what it would be if
every program began with $',$&,$`.

I left the PL_sawampersand code in place, in case this commit proves
immature.  Running Configure with -Accflags=PERL_SAWAMPERSAND will
reënable the PL_sawampersand mechanism.

diff --git a/embedvar.h b/embedvar.h
index 0c25f34..beb3bd2 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -287,7 +287,9 @@
 #define PL_savestack           (vTHX->Isavestack)
 #define PL_savestack_ix                (vTHX->Isavestack_ix)
 #define PL_savestack_max       (vTHX->Isavestack_max)
+#ifndef PL_sawampersand
 #define PL_sawampersand                (vTHX->Isawampersand)
+#endif
 #define PL_scopestack          (vTHX->Iscopestack)
 #define PL_scopestack_ix       (vTHX->Iscopestack_ix)
 #define PL_scopestack_max      (vTHX->Iscopestack_max)

diff --git a/gv.c b/gv.c
index 0ec3e3a..8aa2ace 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1638,6 +1638,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                case '[':
                    require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
                     break;
+#ifdef PERL_SAWAMPERSAND
                case '`':
                    PL_sawampersand |= SAWAMPERSAND_LEFT;
                     (void)GvSVn(gv);
@@ -1650,6 +1651,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    PL_sawampersand |= SAWAMPERSAND_RIGHT;
                     (void)GvSVn(gv);
                     break;
+#endif
                 }
              }
            }
@@ -1854,6 +1856,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
        case '&':               /* $& */
        case '`':               /* $` */
        case '\'':              /* $' */
+#ifdef PERL_SAWAMPERSAND
            if (!(
                sv_type == SVt_PVAV ||
                sv_type == SVt_PVHV ||
@@ -1867,6 +1870,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                                 ? SAWAMPERSAND_MIDDLE
                                 : SAWAMPERSAND_RIGHT;
                 }
+#endif
            goto magicalize;
 
        case ':':               /* $: */

diff --git a/intrpvar.h b/intrpvar.h
index 5a6a4f1..52b45ba 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -291,7 +291,9 @@ The C variable which corresponds to Perl's $^W warning variable.
 */
 
 PERLVAR(I, dowarn,     U8)
+#ifdef PERL_SAWAMPERSAND
 PERLVAR(I, sawampersand, U8)           /* must save all match strings */
+#endif
 PERLVAR(I, unsafe,     bool)
 PERLVAR(I, exit_flags, U8)             /* was exit() unexpected, etc. */
 

diff --git a/makedef.pl b/makedef.pl
index 7afc35f..0593342 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -279,6 +279,10 @@ unless ($define{'PERL_OLD_COPY_ON_WRITE'}
     ++$skip{Perl_sv_setsv_cow};
 }
 
+unless ($define{PERL_SAW_AMPERSAND}) {
+    ++$skip{PL_sawampersand};
+}
+
 unless ($define{'USE_REENTRANT_API'}) {
     ++$skip{PL_reentrant_buffer};
 }

diff --git a/perl.c b/perl.c
index 0ebaeac..fe71325 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -873,7 +873,9 @@ perl_destruct(pTHXx)
     PL_minus_F      = FALSE;
     PL_doswitches   = FALSE;
     PL_dowarn       = G_WARN_OFF;
+#ifdef PERL_SAWAMPERSAND
     PL_sawampersand = 0;       /* must save all match strings */
+#endif
     PL_unsafe       = FALSE;
 
     Safefree(PL_inplace);

diff --git a/perl.h b/perl.h
index 3e2d6a0..d115ec3 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4912,6 +4912,11 @@ typedef enum {
 #define SAWAMPERSAND_MIDDLE     2   /* saw $& */
 #define SAWAMPERSAND_RIGHT      4   /* saw $' */
 
+#ifndef PERL_SAWAMPERSAND
+# define PL_sawampersand \
+       (SAWAMPERSAND_LEFT|SAWAMPERSAND_MIDDLE|SAWAMPERSAND_RIGHT)
+#endif
+
 /* Various states of the input record separator SV (rs) */
 #define RsSNARF(sv)   (! SvOK(sv))
 #define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))

diff --git a/regen/embed.pl b/regen/embed.pl
index 8f59f36..b46f615 100755 (executable)
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -441,7 +441,13 @@ END
 my $sym;
 
 for $sym (@intrp) {
+    if ($sym eq 'sawampersand') {
+       print $em "#ifndef PL_sawampersand\n";
+    }
     print $em multon($sym,'I','vTHX->');
+    if ($sym eq 'sawampersand') {
+       print $em "#endif\n";
+    }
 }
 
 print $em <<'END';

diff --git a/sv.c b/sv.c
index 6a700e6..d8d0ff8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13057,7 +13057,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_minus_F         = proto_perl->Iminus_F;
     PL_doswitches      = proto_perl->Idoswitches;
     PL_dowarn          = proto_perl->Idowarn;
+#ifdef PERL_SAWAMPERSAND
     PL_sawampersand    = proto_perl->Isawampersand;
+#endif
     PL_unsafe          = proto_perl->Iunsafe;
     PL_perldb          = proto_perl->Iperldb;
     PL_perl_destruct_level = proto_perl->Iperl_destruct_level;