Commit | Line | Data |
---|---|---|
e46c382e YK |
1 | #./perl |
2 | ||
37c07a4b | 3 | use Test::More tests => 50; |
e46c382e YK |
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 }, | |
abb619ad | 14 | cos => sub { "far side of overload table" }, |
e46c382e YK |
15 | ); |
16 | ||
17 | sub new { bless {}, shift }; | |
18 | } | |
19 | ||
20 | my $x = Stringifies->new; | |
a75c6ed6 FC |
21 | my $y = qr//; |
22 | my $ystr = "$y"; | |
e46c382e YK |
23 | |
24 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 25 | is( "$y", $ystr, "stringifies qr//" ); |
e46c382e | 26 | is( 0 + $x, 42, "numifies" ); |
abb619ad | 27 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e YK |
28 | |
29 | { | |
30 | no overloading; | |
31 | is( "$x", overload::StrVal($x), "no stringification" ); | |
a75c6ed6 | 32 | is( "$y", overload::StrVal($y), "no stringification of qr//" ); |
e46c382e | 33 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 34 | is( cos($x), cos(refaddr($x)), "no cosinusfication" ); |
e46c382e YK |
35 | |
36 | { | |
37 | no overloading '""'; | |
38 | is( "$x", overload::StrVal($x), "no stringification" ); | |
a75c6ed6 | 39 | is( "$y", overload::StrVal($y), "no stringification of qr//" ); |
e46c382e | 40 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 41 | is( cos($x), cos(refaddr($x)), "no cosinusfication" ); |
e46c382e YK |
42 | } |
43 | } | |
44 | ||
45 | { | |
46 | no overloading '""'; | |
47 | ||
48 | is( "$x", overload::StrVal($x), "no stringification" ); | |
a75c6ed6 | 49 | is( "$y", overload::StrVal($y), "no stringification of qr//" ); |
e46c382e | 50 | is( 0 + $x, 42, "numifies" ); |
abb619ad | 51 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e | 52 | |
37c07a4b FC |
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 | ||
e46c382e YK |
63 | { |
64 | no overloading; | |
65 | is( "$x", overload::StrVal($x), "no stringification" ); | |
a75c6ed6 | 66 | is( "$y", overload::StrVal($y), "no stringification of qr//" ); |
e46c382e | 67 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 68 | is( cos($x), cos(refaddr($x)), "no cosinusfication" ); |
e46c382e YK |
69 | } |
70 | ||
71 | use overloading '""'; | |
72 | ||
73 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 74 | is( "$y", $ystr, "stringifies qr//" ); |
e46c382e | 75 | is( 0 + $x, 42, "numifies" ); |
abb619ad | 76 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e YK |
77 | |
78 | no overloading '0+'; | |
79 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 80 | is( "$y", $ystr, "stringifies qr//" ); |
e46c382e | 81 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 82 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e YK |
83 | |
84 | { | |
85 | no overloading '""'; | |
86 | is( "$x", overload::StrVal($x), "no stringification" ); | |
a75c6ed6 | 87 | is( "$y", overload::StrVal($y), "no stringification of qr//" ); |
e46c382e | 88 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 89 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e YK |
90 | |
91 | { | |
92 | use overloading; | |
93 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 94 | is( "$y", $ystr, "stringifies qr//" ); |
e46c382e | 95 | is( 0 + $x, 42, "numifies" ); |
abb619ad | 96 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e YK |
97 | } |
98 | } | |
99 | ||
100 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 101 | is( "$y", $ystr, "stringifies qr//" ); |
e46c382e | 102 | is( 0 + $x, refaddr($x), "no numification" ); |
abb619ad | 103 | is( cos($x), "far side of overload table", "cosinusfies" ); |
e46c382e | 104 | |
abb619ad RGS |
105 | no overloading "cos"; |
106 | is( "$x", "foo", "stringifies" ); | |
a75c6ed6 | 107 | is( "$y", $ystr, "stringifies qr//" ); |
abb619ad RGS |
108 | is( 0 + $x, refaddr($x), "no numification" ); |
109 | is( cos($x), cos(refaddr($x)), "no cosinusfication" ); | |
e46c382e YK |
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 | } |