lib/overloading.t

   1 #./perl
   2
   3 use Test::More tests => 50;
   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     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 }