Quotes fixed, see also perl #36079

[p5sagit/p5-mst-13.2.git] / lib / overload.t

diff --git a/lib/overload.t b/lib/overload.t
index 519c6d8..a30a53b 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1097,8 +1097,6 @@ test ($a->xet('b'), 42);
 test (!defined eval { $a->{b} });
 test ($@ =~ /zap/);
 
-test (overload::StrVal(qr/a/) =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
-
 {
    package t229;
    use overload '='  => sub { 42 },
@@ -1139,6 +1137,27 @@ test (overload::StrVal(qr/a/) =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
     sub numify { ${$_[0]} }
 }
 
+{
+    package perl31793;
+    use overload cmp => sub { 0 };
+    package perl31793_fb;
+    use overload cmp => sub { 0 }, fallback => 1;
+    package main;
+    my $o  = bless [], 'perl31793';
+    my $of = bless [], 'perl31793_fb';
+    my $no = bless [], 'no_overload';
+    test (overload::StrVal(\"scalar") =~ /^SCALAR\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal([])        =~ /^ARRAY\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal({})        =~ /^HASH\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal(sub{1})    =~ /^CODE\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal(\*GLOB)    =~ /^GLOB\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal(\$o)       =~ /^REF\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal(qr/a/)     =~ /^Regexp=SCALAR\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal($o)        =~ /^perl31793=ARRAY\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal($of)       =~ /^perl31793_fb=ARRAY\(0x[0-9a-f]+\)$/);
+    test (overload::StrVal($no)       =~ /^no_overload=ARRAY\(0x[0-9a-f]+\)$/);
+}
+
 # These are all check that overloaded values rather than reference addressess
 # are what is getting tested.
 my ($two, $one, $un, $deux) = map {new Numify $_} 2, 1, 1, 2;
@@ -1159,5 +1178,29 @@ foreach my $op (qw(<=> == != < <= > >=)) {
        }
     }
 }
+{
+    # check that overloading works in regexes
+    {
+       package Foo493;
+       use overload
+           '""' => sub { "^$_[0][0]\$" },
+           '.'  => sub { 
+                   bless [
+                            $_[2]
+                           ? (ref $_[1] ? $_[1][0] : $_[1]) . ':' .$_[0][0] 
+                           : $_[0][0] . ':' . (ref $_[1] ? $_[1][0] : $_[1])
+                   ], 'Foo493'
+                       };
+    }
+
+    my $a = bless [ "a" ], 'Foo493';
+    test('a' =~ /$a/);
+    test('x:a' =~ /x$a/);
+    test('x:a:=' =~ /x$a=$/);
+    test('x:a:a:=' =~ /x$a$a=$/);
+
+}
+
+
 # Last test is:
-sub last {484}
+sub last {497}