This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #108780] Make ‘no overloading’ work with qr//
[perl5.git] / lib / overloading.t
1 #./perl
2
3 use Test::More tests => 46;
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     {
54         no overloading;
55         is( "$x", overload::StrVal($x), "no stringification" );
56         is( "$y", overload::StrVal($y), "no stringification of qr//" );
57         is( 0 + $x, refaddr($x), "no numification" );
58         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
59     }
60
61     use overloading '""';
62
63     is( "$x", "foo", "stringifies" );
64     is( "$y", $ystr, "stringifies qr//" );
65     is( 0 + $x, 42, "numifies" );
66     is( cos($x), "far side of overload table", "cosinusfies" );
67
68     no overloading '0+';
69     is( "$x", "foo", "stringifies" );
70     is( "$y", $ystr, "stringifies qr//" );
71     is( 0 + $x, refaddr($x), "no numification" );
72     is( cos($x), "far side of overload table", "cosinusfies" );
73
74     {
75         no overloading '""';
76         is( "$x", overload::StrVal($x), "no stringification" );
77         is( "$y", overload::StrVal($y), "no stringification of qr//" );
78         is( 0 + $x, refaddr($x), "no numification" );
79         is( cos($x), "far side of overload table", "cosinusfies" );
80
81         {
82             use overloading;
83             is( "$x", "foo", "stringifies" );
84             is( "$y", $ystr, "stringifies qr//" );
85             is( 0 + $x, 42, "numifies" );
86             is( cos($x), "far side of overload table", "cosinusfies" );
87         }
88     }
89
90     is( "$x", "foo", "stringifies" );
91     is( "$y", $ystr, "stringifies qr//" );
92     is( 0 + $x, refaddr($x), "no numification" );
93     is( cos($x), "far side of overload table", "cosinusfies" );
94
95     no overloading "cos";
96     is( "$x", "foo", "stringifies" );
97     is( "$y", $ystr, "stringifies qr//" );
98     is( 0 + $x, refaddr($x), "no numification" );
99     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
100
101     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
102
103     use overloading;
104
105     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
106 }