Make new regex type be 'REGEXP' and make all core qr//'s be in class Regexp (and...

p4raw-id: //depot/perl@32880

diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 087a613..47f8ab2 100644 (file)
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -284,11 +284,12 @@ do_test(15,
   RV = $ADDR
   SV = REGEXP\\($ADDR\\) at $ADDR
     REFCNT = 2
   RV = $ADDR
   SV = REGEXP\\($ADDR\\) at $ADDR
     REFCNT = 2

-    FLAGS = \\(POK,pPOK\\)
+    FLAGS = \\(OBJECT,POK,pPOK\\)

     IV = 0
     PV = $ADDR "\\(\\?-xism:tic\\)"\\\0
     CUR = 12
     IV = 0
     PV = $ADDR "\\(\\?-xism:tic\\)"\\\0
     CUR = 12

-    LEN = \\d+');
+    LEN = \\d+
+    STASH = $ADDR\\t"Regexp"');

 } else {
 do_test(15,
         qr(tic),
 } else {
 do_test(15,
         qr(tic),

diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index 8aaa28e..c385452 100644 (file)
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -8,7 +8,7 @@ $^C ||= 0;
 
 use strict;
 use vars qw($VERSION);
 
 use strict;
 use vars qw($VERSION);

-$VERSION = '0.74';
+$VERSION = '0.74_1';

 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 # Make Test::Builder thread-safe for ithreads.
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 # Make Test::Builder thread-safe for ithreads.


@@ -925,7 +925,11 @@ sub maybe_regex {
     my($re, $opts);
 
     # Check for qr/foo/
     my($re, $opts);
 
     # Check for qr/foo/

-    if( ref $regex eq 'Regexp' ) {
+    if (   $] >= 5.009004 
+              ? re::is_regexp($regex) 
+              : ref $regex eq 'Regexp'
+       ) 
+    {

         $usable_regex = $regex;
     }
     # Check for '/foo/' or 'm,foo,'
         $usable_regex = $regex;
     }
     # Check for '/foo/' or 'm,foo,'

diff --git a/lib/overload.t b/lib/overload.t
index 50ec4a7..44ead7e 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1125,7 +1125,7 @@ like ($@, qr/zap/);
     like(overload::StrVal(sub{1}),    qr/^CODE\(0x[0-9a-f]+\)$/);
     like(overload::StrVal(\*GLOB),    qr/^GLOB\(0x[0-9a-f]+\)$/);
     like(overload::StrVal(\$o),       qr/^REF\(0x[0-9a-f]+\)$/);
     like(overload::StrVal(sub{1}),    qr/^CODE\(0x[0-9a-f]+\)$/);
     like(overload::StrVal(\*GLOB),    qr/^GLOB\(0x[0-9a-f]+\)$/);
     like(overload::StrVal(\$o),       qr/^REF\(0x[0-9a-f]+\)$/);

-    like(overload::StrVal(qr/a/),     qr/^Regexp\(0x[0-9a-f]+\)$/);
+    like(overload::StrVal(qr/a/),     qr/^Regexp=REGEXP\(0x[0-9a-f]+\)$/);

     like(overload::StrVal($o),        qr/^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
     like(overload::StrVal($of),       qr/^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
     like(overload::StrVal($no),       qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
     like(overload::StrVal($o),        qr/^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
     like(overload::StrVal($of),       qr/^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
     like(overload::StrVal($no),       qr/^no_overload=ARRAY\(0x[0-9a-f]+\)$/);

diff --git a/regcomp.c b/regcomp.c
index 6e9c19a..fa8e0f1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5219,7 +5219,10 @@ SV*
 Perl_reg_qr_package(pTHX_ REGEXP * const rx)
 {
        PERL_UNUSED_ARG(rx);
 Perl_reg_qr_package(pTHX_ REGEXP * const rx)
 {
        PERL_UNUSED_ARG(rx);

-       return NULL;
+       if (0)
+           return NULL;
+       else
+           return newSVpvs("Regexp");

 }
 
 /* Scans the name of a named buffer from the pattern.
 }
 
 /* Scans the name of a named buffer from the pattern.

diff --git a/sv.c b/sv.c
index b99d937..f9afe84 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7842,7 +7842,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
        case SVt_BIND:          return "BIND";
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
        case SVt_BIND:          return "BIND";

-       case SVt_REGEXP:        return "Regexp"; /* FIXME? to "REGEXP"  */
+       case SVt_REGEXP:        return "REGEXP"; /* FIXME? to "REGEXP"  */

        default:                return "UNKNOWN";
        }
     }
        default:                return "UNKNOWN";
        }
     }