From 1a904fc88069e249a4bd0ef196a3f1a7f549e0fe Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 25 Nov 2012 12:57:04 -0800 Subject: [PATCH] Disable PL_sawampersand MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- embedvar.h | 2 ++ gv.c | 4 ++++ intrpvar.h | 2 ++ makedef.pl | 4 ++++ perl.c | 2 ++ perl.h | 5 +++++ regen/embed.pl | 6 ++++++ sv.c | 2 ++ 8 files changed, 27 insertions(+) diff --git a/embedvar.h b/embedvar.h index 0c25f34..beb3bd2 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 0ec3e3a..8aa2ace 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 5a6a4f1..52b45ba 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 7afc35f..0593342 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 0ebaeac..fe71325 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 3e2d6a0..d115ec3 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 8f59f36..b46f615 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 6a700e6..d8d0ff8 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; -- 1.8.3.1