Added the git tag step for releases from Yves
[perl.git] / lib / overloading.t
1 #./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 BEGIN {
9     require "./test.pl";
10     plan(tests => 35);
11 }
12
13 use Scalar::Util qw(refaddr);
14
15 {
16     package Stringifies;
17
18     use overload (
19         fallback => 1,
20         '""' => sub { "foo" },
21         '0+' => sub { 42 },
22         cos => sub { "far side of overload table" },
23     );
24
25     sub new { bless {}, shift };
26 }
27
28 my $x = Stringifies->new;
29
30 is( "$x", "foo", "stringifies" );
31 is( 0 + $x, 42, "numifies" );
32 is( cos($x), "far side of overload table", "cosinusfies" );
33
34 {
35     no overloading;
36     is( "$x", overload::StrVal($x), "no stringification" );
37     is( 0 + $x, refaddr($x), "no numification" );
38     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
39
40     {
41         no overloading '""';
42         is( "$x", overload::StrVal($x), "no stringification" );
43         is( 0 + $x, refaddr($x), "no numification" );
44         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
45     }
46 }
47
48 {
49     no overloading '""';
50
51     is( "$x", overload::StrVal($x), "no stringification" );
52     is( 0 + $x, 42, "numifies" );
53     is( cos($x), "far side of overload table", "cosinusfies" );
54
55     {
56         no overloading;
57         is( "$x", overload::StrVal($x), "no stringification" );
58         is( 0 + $x, refaddr($x), "no numification" );
59         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
60     }
61
62     use overloading '""';
63
64     is( "$x", "foo", "stringifies" );
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( 0 + $x, refaddr($x), "no numification" );
71     is( cos($x), "far side of overload table", "cosinusfies" );
72
73     {
74         no overloading '""';
75         is( "$x", overload::StrVal($x), "no stringification" );
76         is( 0 + $x, refaddr($x), "no numification" );
77         is( cos($x), "far side of overload table", "cosinusfies" );
78
79         {
80             use overloading;
81             is( "$x", "foo", "stringifies" );
82             is( 0 + $x, 42, "numifies" );
83             is( cos($x), "far side of overload table", "cosinusfies" );
84         }
85     }
86
87     is( "$x", "foo", "stringifies" );
88     is( 0 + $x, refaddr($x), "no numification" );
89     is( cos($x), "far side of overload table", "cosinusfies" );
90
91     no overloading "cos";
92     is( "$x", "foo", "stringifies" );
93     is( 0 + $x, refaddr($x), "no numification" );
94     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
95
96     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
97
98     use overloading;
99
100     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
101 }