Add s///r (non-destructive substitution).

This changes s/// so that it doesn't act destructively on its target.
Instead it returns the result of the substitution (or the original string if
there was no match).

In addition this patch:

  * Adds a new warning when s///r happens in void context.
  * Adds a error when you try to use s///r with !~
  * Makes it so constant strings can be bound to s///r with =~
  * Adds documentation.
  * Adds some tests.
  * Updates various debug code so it knows about the /r flag.
  * Adds some new 'r' words to B::Deparse.

1 files changed, 25 insertions, 5 deletions

diff --git a/pp_hot.c b/pp_hot.c
index edc48547c0..ea24062bc5 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2110,6 +2110,11 @@ PP(pp_subst)
 	EXTEND(SP,1);
     }
 
+    /* In non-destructive replacement mode, duplicate target scalar so it
+     * remains unchanged. */
+    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+	TARG = newSVsv(TARG);
+
 #ifdef PERL_OLD_COPY_ON_WRITE
     /* Awooga. Awooga. "bool" types that are actually char are dangerous,
        because they make integers such as 256 "false".  */
@@ -2233,7 +2238,10 @@ PP(pp_subst)
 	if (!matched)
 	{
 	    SPAGAIN;
-	    PUSHs(&PL_sv_no);
+	    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+		PUSHs(TARG);
+	    else
+		PUSHs(&PL_sv_no);
 	    LEAVE_SCOPE(oldsave);
 	    RETURN;
 	}
@@ -2287,7 +2295,10 @@ PP(pp_subst)
 	    }
 	    TAINT_IF(rxtainted & 1);
 	    SPAGAIN;
-	    PUSHs(&PL_sv_yes);
+	    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+		PUSHs(TARG);
+	    else
+		PUSHs(&PL_sv_yes);
 	}
 	else {
 	    do {
@@ -2316,7 +2327,10 @@ PP(pp_subst)
 	    }
 	    TAINT_IF(rxtainted & 1);
 	    SPAGAIN;
-	    mPUSHi((I32)iters);
+	    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+		PUSHs(TARG);
+	    else
+		mPUSHi((I32)iters);
 	}
 	(void)SvPOK_only_UTF8(TARG);
 	TAINT_IF(rxtainted);
@@ -2402,7 +2416,10 @@ PP(pp_subst)
 
 	TAINT_IF(rxtainted & 1);
 	SPAGAIN;
-	mPUSHi((I32)iters);
+	if (rpm->op_pmflags & PMf_NONDESTRUCT)
+	    PUSHs(TARG);
+	else
+	    mPUSHi((I32)iters);
 
 	(void)SvPOK_only(TARG);
 	if (doutf8)
@@ -2418,7 +2435,10 @@ PP(pp_subst)
 nope:
 ret_no:
     SPAGAIN;
-    PUSHs(&PL_sv_no);
+    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+	PUSHs(TARG);
+    else
+	PUSHs(&PL_sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
 }