make overload, Data::Dumper, and dumpvar understand qr// stringify

overloading

p4raw-id: //depot/perl@3570

2 files changed, 43 insertions, 17 deletions

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index d653af336b..3828d7b390 100644
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -259,14 +259,22 @@ sub _dump {
       }
     }
 
+    if ($realpack) {
+      if ($realpack eq 'Regexp') {
+	$out = "$val";
+	$out =~ s,/,\\/,g;
+	return "qr/$out/";
+      }
+      else {          # we have a blessed ref
+	$out = $s->{'bless'} . '( ';
+	$blesspad = $s->{apad};
+	$s->{apad} .= '       ' if ($s->{indent} >= 2);
+      }
+    }
+
     $s->{level}++;
     $ipad = $s->{xpad} x $s->{level};
 
-    if ($realpack) {          # we have a blessed ref
-      $out = $s->{'bless'} . '( ';
-      $blesspad = $s->{apad};
-      $s->{apad} .= '       ' if ($s->{indent} >= 2);
-    }
     
     if ($realtype eq 'SCALAR') {
       if ($realpack) {
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index e0ca4035d3..27d128b6ea 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -251,22 +251,40 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		SvREFCNT_dec(seenentry);
 	    }
 	}
-	
-	(*levelp)++;
-	ipad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
 
-	if (realpack) {   /* we have a blessed ref */
-	    STRLEN blesslen;
-	    char *blessstr = SvPV(bless, blesslen);
-	    sv_catpvn(retval, blessstr, blesslen);
-	    sv_catpvn(retval, "( ", 2);
-	    if (indent >= 2) {
-		blesspad = apad;
-		apad = newSVsv(apad);
-		sv_x(aTHX_ apad, " ", 1, blesslen+2);
+	if (realpack) {
+	    if (*realpack == 'R' && strEQ(realpack, "Regexp")) {
+		STRLEN rlen;
+		char *rval = SvPV(val, rlen);
+		char *slash = strchr(rval, '/');
+		sv_catpvn(retval, "qr/", 3);
+		while (slash) {
+		    sv_catpvn(retval, rval, slash-rval);
+		    sv_catpvn(retval, "\\/", 2);
+		    rlen -= slash-rval+1;
+		    rval = slash+1;
+		    slash = strchr(rval, '/');
+		}
+		sv_catpvn(retval, rval, rlen);
+		sv_catpvn(retval, "/", 1);
+		return 1;
+	    }
+	    else {				/* we have a blessed ref */
+		STRLEN blesslen;
+		char *blessstr = SvPV(bless, blesslen);
+		sv_catpvn(retval, blessstr, blesslen);
+		sv_catpvn(retval, "( ", 2);
+		if (indent >= 2) {
+		    blesspad = apad;
+		    apad = newSVsv(apad);
+		    sv_x(aTHX_ apad, " ", 1, blesslen+2);
+		}
 	    }
 	}
 
+	(*levelp)++;
+	ipad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
+
 	if (realtype <= SVt_PVBM) {			     /* scalar ref */
 	    SV *namesv = newSVpvn("${", 2);
 	    sv_catpvn(namesv, name, namelen);