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.

8 files changed, 27 insertions, 0 deletions

diff --git a/embedvar.h b/embedvar.h
index 0c25f34092..beb3bd2187 100644
--- 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 0ec3e3a2f7..8aa2acefce 100644
--- 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 5a6a4f1827..52b45ba2b9 100644
--- 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 7afc35ff04..0593342462 100644
--- 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 0ebaeacbf3..fe71325da3 100644
--- 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 3e2d6a0e30..d115ec3ae0 100644
--- 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 8f59f3608c..b46f615023 100755
--- 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 6a700e6ff8..d8d0ff8add 100644
--- 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;