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).
castaway · Sep 8, 2012 · d3b9753 · d3b9753
1 parent 8fd1a95
commit d3b9753
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 11 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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)))