Fix distclean for "pm_to_blib directly" extensions.
[perl.git] / lib / overloading.t
1 #./perl
2
3 use Test::More tests => 50;
4
5 use Scalar::Util qw(refaddr);
6
7 {
8     package Stringifies;
9
10     use overload (
11         fallback => 1,
12         '""' => sub { "foo" },
13         '0+' => sub { 42 },
14         cos => sub { "far side of overload table" },
15     );
16
17     sub new { bless {}, shift };
18 }
19
20 my $x = Stringifies->new;
21 my $y = qr//;
22 my $ystr = "$y";
23
24 is( "$x", "foo", "stringifies" );
25 is( "$y", $ystr, "stringifies qr//" );
26 is( 0 + $x, 42, "numifies" );
27 is( cos($x), "far side of overload table", "cosinusfies" );
28
29 {
30     no overloading;
31     is( "$x", overload::StrVal($x), "no stringification" );
32     is( "$y", overload::StrVal($y), "no stringification of qr//" );
33     is( 0 + $x, refaddr($x), "no numification" );
34     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
35
36     {
37         no overloading '""';
38         is( "$x", overload::StrVal($x), "no stringification" );
39         is( "$y", overload::StrVal($y), "no stringification of qr//" );
40         is( 0 + $x, refaddr($x), "no numification" );
41         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
42     }
43 }
44
45 {
46     no overloading '""';
47
48     is( "$x", overload::StrVal($x), "no stringification" );
49     is( "$y", overload::StrVal($y), "no stringification of qr//" );
50     is( 0 + $x, 42, "numifies" );
51     is( cos($x), "far side of overload table", "cosinusfies" );
52
53     my $q = qr/abc/;
54     ok "abc" =~ $q, '=~ qr// with no "" overloading';
55     ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" overloading';
56     {
57         no overloading 'qr';
58         my $q = qr/abc/;
59         ok "abc" =~ $q, '=~ qr// with no "" or qr overloading';
60         ok "abcd" =~ /${q}d/, '=~ /foo$qr/ with no "" or qr overloading';
61     }
62
63     {
64         no overloading;
65         is( "$x", overload::StrVal($x), "no stringification" );
66         is( "$y", overload::StrVal($y), "no stringification of qr//" );
67         is( 0 + $x, refaddr($x), "no numification" );
68         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
69     }
70
71     use overloading '""';
72
73     is( "$x", "foo", "stringifies" );
74     is( "$y", $ystr, "stringifies qr//" );
75     is( 0 + $x, 42, "numifies" );
76     is( cos($x), "far side of overload table", "cosinusfies" );
77
78     no overloading '0+';
79     is( "$x", "foo", "stringifies" );
80     is( "$y", $ystr, "stringifies qr//" );
81     is( 0 + $x, refaddr($x), "no numification" );
82     is( cos($x), "far side of overload table", "cosinusfies" );
83
84     {
85         no overloading '""';
86         is( "$x", overload::StrVal($x), "no stringification" );
87         is( "$y", overload::StrVal($y), "no stringification of qr//" );
88         is( 0 + $x, refaddr($x), "no numification" );
89         is( cos($x), "far side of overload table", "cosinusfies" );
90
91         {
92             use overloading;
93             is( "$x", "foo", "stringifies" );
94             is( "$y", $ystr, "stringifies qr//" );
95             is( 0 + $x, 42, "numifies" );
96             is( cos($x), "far side of overload table", "cosinusfies" );
97         }
98     }
99
100     is( "$x", "foo", "stringifies" );
101     is( "$y", $ystr, "stringifies qr//" );
102     is( 0 + $x, refaddr($x), "no numification" );
103     is( cos($x), "far side of overload table", "cosinusfies" );
104
105     no overloading "cos";
106     is( "$x", "foo", "stringifies" );
107     is( "$y", $ystr, "stringifies qr//" );
108     is( 0 + $x, refaddr($x), "no numification" );
109     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
110
111     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
112
113     use overloading;
114
115     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
116 }