B/Deparse.pm: Rework deparsing of UTF-8 tr///

[perl5.git] / lib / overloading.t

diff --git a/lib/overloading.t b/lib/overloading.t
index 8121cc8..85fc7e2 100644 (file)
--- a/lib/overloading.t
+++ b/lib/overloading.t
@@ -1,14 +1,6 @@
 #./perl
 
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-}
-
-BEGIN {
-    require "./test.pl";
-    plan(tests => 22);
-}
+use Test::More tests => 50;
 
 use Scalar::Util qw(refaddr);
 
@@ -19,25 +11,34 @@ use Scalar::Util qw(refaddr);
        fallback => 1,
        '""' => sub { "foo" },
        '0+' => sub { 42 },
+       cos => sub { "far side of overload table" },
     );
 
     sub new { bless {}, shift };
 }
 
 my $x = Stringifies->new;
+my $y = qr//;
+my $ystr = "$y";
 
 is( "$x", "foo", "stringifies" );
+is( "$y", $ystr, "stringifies qr//" );
 is( 0 + $x, 42, "numifies" );
+is( cos($x), "far side of overload table", "cosinusfies" );
 
 {
     no overloading;
     is( "$x", overload::StrVal($x), "no stringification" );
+    is( "$y", overload::StrVal($y), "no stringification of qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
+    is( cos($x), cos(refaddr($x)), "no cosinusfication" );
 
     {
        no overloading '""';
        is( "$x", overload::StrVal($x), "no stringification" );
+       is( "$y", overload::StrVal($y), "no stringification of qr//" );
        is( 0 + $x, refaddr($x), "no numification" );
+       is( cos($x), cos(refaddr($x)), "no cosinusfication" );
     }
 }
 
@@ -45,38 +46,67 @@ is( 0 + $x, 42, "numifies" );
     no overloading '""';
 
     is( "$x", overload::StrVal($x), "no stringification" );
+    is( "$y", overload::StrVal($y), "no stringification of qr//" );
     is( 0 + $x, 42, "numifies" );
+    is( cos($x), "far side of overload table", "cosinusfies" );
+
+    my $q = qr/abc/;
+    ok "abc" =~ $q, '=~ qr// with no "" overloading';
+    ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" overloading';
+    {
+       no overloading 'qr';
+       my $q = qr/abc/;
+       ok "abc" =~ $q, '=~ qr// with no "" or qr overloading';
+       ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" or qr overloading';
+    }
 
     {
        no overloading;
        is( "$x", overload::StrVal($x), "no stringification" );
+       is( "$y", overload::StrVal($y), "no stringification of qr//" );
        is( 0 + $x, refaddr($x), "no numification" );
+       is( cos($x), cos(refaddr($x)), "no cosinusfication" );
     }
 
     use overloading '""';
 
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, 42, "numifies" );
+    is( cos($x), "far side of overload table", "cosinusfies" );
 
     no overloading '0+';
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
+    is( cos($x), "far side of overload table", "cosinusfies" );
 
     {
        no overloading '""';
        is( "$x", overload::StrVal($x), "no stringification" );
+       is( "$y", overload::StrVal($y), "no stringification of qr//" );
        is( 0 + $x, refaddr($x), "no numification" );
+       is( cos($x), "far side of overload table", "cosinusfies" );
 
        {
            use overloading;
            is( "$x", "foo", "stringifies" );
+           is( "$y", $ystr, "stringifies qr//" );
            is( 0 + $x, 42, "numifies" );
+           is( cos($x), "far side of overload table", "cosinusfies" );
        }
     }
 
     is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
     is( 0 + $x, refaddr($x), "no numification" );
+    is( cos($x), "far side of overload table", "cosinusfies" );
 
+    no overloading "cos";
+    is( "$x", "foo", "stringifies" );
+    is( "$y", $ystr, "stringifies qr//" );
+    is( 0 + $x, refaddr($x), "no numification" );
+    is( cos($x), cos(refaddr($x)), "no cosinusfication" );
 
     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }