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