1#./perl 2 3use Test::More tests => 50; 4 5use 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 20my $x = Stringifies->new; 21my $y = qr//; 22my $ystr = "$y"; 23 24is( "$x", "foo", "stringifies" ); 25is( "$y", $ystr, "stringifies qr//" ); 26is( 0 + $x, 42, "numifies" ); 27is( 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} 117