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

overloading

p4raw-id: //depot/perl@3570

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index d653af3..3828d7b 100644 (file)
--- 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 e0ca403..27d128b 100644 (file)
--- 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);

diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm
index 5bcd58f..9c596ff 100644 (file)
--- a/lib/Dumpvalue.pm
+++ b/lib/Dumpvalue.pm
@@ -181,6 +181,13 @@ sub unwrap {
     }
   }
 
+  if (ref $v eq 'Regexp') {
+    my $re = "$v";
+    $re =~ s,/,\\/,g;
+    print "$sp-> qr/$re/\n";
+    return;
+  }
+
   if ( UNIVERSAL::isa($v, 'HASH') ) {
     my @sortKeys = sort keys(%$v) ;
     my $more;

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 32d4692..fb0bb23 100644 (file)
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -143,6 +143,13 @@ sub unwrap {
       } 
     }
 
+    if (ref $v eq 'Regexp') {
+      my $re = "$v";
+      $re =~ s,/,\\/,g;
+      print "$sp-> qr/$re/\n";
+      return;
+    }
+
     if ( UNIVERSAL::isa($v, 'HASH') ) { 
        @sortKeys = sort keys(%$v) ;
        undef $more ; 

diff --git a/lib/overload.pm b/lib/overload.pm
index bcb56c3..c46be83 100644 (file)
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -87,7 +87,7 @@ sub AddrRef {
 }
 
 sub StrVal {
-  (OverloadedStringify($_[0])) ?
+  (OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
     (AddrRef(shift)) :
     "$_[0]";
 }

diff --git a/pp_ctl.c b/pp_ctl.c
index 9b5c932..64e695b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2817,7 +2817,7 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode)
     STRLEN namelen = strlen(name);
     PerlIO *fp;
 
-    if (namelen > 3 && strcmp(name + namelen - 3, ".pm") == 0) {
+    if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
        SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
        char *pmc = SvPV_nolen(pmcsv);
        Stat_t pmstat;