PL_sawampersand: use 3 bit flags rather than bool

Set a separate flag for each of $`, $& and $'.
It still works fine in boolean context.

This will allow us to have more refined control over what parts
of a match string to copy (we currently copy the whole string).

diff --git a/gv.c b/gv.c
index c6e474e..e29f2fd 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1655,12 +1655,23 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
              }
              if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
-              if (*name == '[')
-               require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
-              else if (*name == '&' || *name == '`' || *name == '\'') {
-               PL_sawampersand = TRUE;
-               (void)GvSVn(gv);
-              }
+                switch (*name) {
+               case '[':
+                   require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+                    break;
+               case '`':
+                   PL_sawampersand |= SAWAMPERSAND_LEFT;
+                    (void)GvSVn(gv);
+                    break;
+               case '&':
+                   PL_sawampersand |= SAWAMPERSAND_MIDDLE;
+                    (void)GvSVn(gv);
+                    break;
+               case '\'':
+                   PL_sawampersand |= SAWAMPERSAND_RIGHT;
+                    (void)GvSVn(gv);
+                    break;
+                }
              }
            }
            else if (len == 3 && sv_type == SVt_PVAV
@@ -1866,7 +1877,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                sv_type == SVt_PVCV ||
                sv_type == SVt_PVFM ||
                sv_type == SVt_PVIO
-               )) { PL_sawampersand = TRUE; }
+               )) { PL_sawampersand |=
+                        (*name == '`')
+                            ? SAWAMPERSAND_LEFT
+                            : (*name == '&')
+                                ? SAWAMPERSAND_MIDDLE
+                                : SAWAMPERSAND_RIGHT;
+                }
            goto magicalize;
 
        case ':':               /* $: */

diff --git a/intrpvar.h b/intrpvar.h
index f57fa7d..94b7425 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -292,7 +292,7 @@ The C variable which corresponds to Perl's $^W warning variable.
 */
 
 PERLVAR(I, dowarn,     U8)
-PERLVAR(I, sawampersand, bool)         /* must save all match strings */
+PERLVAR(I, sawampersand, U8)           /* must save all match strings */
 PERLVAR(I, unsafe,     bool)
 PERLVAR(I, exit_flags, U8)             /* was exit() unexpected, etc. */
 

diff --git a/perl.c b/perl.c
index 8444218..7d65719 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -860,7 +860,7 @@ perl_destruct(pTHXx)
     PL_minus_F      = FALSE;
     PL_doswitches   = FALSE;
     PL_dowarn       = G_WARN_OFF;
-    PL_sawampersand = FALSE;   /* must save all match strings */
+    PL_sawampersand = 0;       /* must save all match strings */
     PL_unsafe       = FALSE;
 
     Safefree(PL_inplace);
@@ -2343,8 +2343,9 @@ STATIC void
 S_run_body(pTHX_ I32 oldscope)
 {
     dVAR;
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
-                    PL_sawampersand ? "Enabling" : "Omitting"));
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support (0x%x).\n",
+                    PL_sawampersand ? "Enabling" : "Omitting",
+                    (unsigned int)(PL_sawampersand)));
 
     if (!PL_restartop) {
 #ifdef PERL_MAD

diff --git a/perl.h b/perl.h
index 2cc4e91..b299432 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4854,6 +4854,12 @@ typedef enum {
 #define HINT_SORT_MERGESORT    0x00000002
 #define HINT_SORT_STABLE       0x00000100 /* sort styles (currently one) */
 
+/* flags for PL_sawampersand */
+
+#define SAWAMPERSAND_LEFT       1   /* saw $` */
+#define SAWAMPERSAND_MIDDLE     2   /* saw $& */
+#define SAWAMPERSAND_RIGHT      4   /* saw $' */
+
 /* Various states of the input record separator SV (rs) */
 #define RsSNARF(sv)   (! SvOK(sv))
 #define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))