lib/overloading.t

   1 #./perl
   2
   3 use Test::More tests => 46;
   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     {
  54         no overloading;
  55         is( "$x", overload::StrVal($x), "no stringification" );
  56         is( "$y", overload::StrVal($y), "no stringification of qr//" );
  57         is( 0 + $x, refaddr($x), "no numification" );
  58         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  59     }
  60
  61     use overloading '""';
  62
  63     is( "$x", "foo", "stringifies" );
  64     is( "$y", $ystr, "stringifies qr//" );
  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( "$y", $ystr, "stringifies qr//" );
  71     is( 0 + $x, refaddr($x), "no numification" );
  72     is( cos($x), "far side of overload table", "cosinusfies" );
  73
  74     {
  75         no overloading '""';
  76         is( "$x", overload::StrVal($x), "no stringification" );
  77         is( "$y", overload::StrVal($y), "no stringification of qr//" );
  78         is( 0 + $x, refaddr($x), "no numification" );
  79         is( cos($x), "far side of overload table", "cosinusfies" );
  80
  81         {
  82             use overloading;
  83             is( "$x", "foo", "stringifies" );
  84             is( "$y", $ystr, "stringifies qr//" );
  85             is( 0 + $x, 42, "numifies" );
  86             is( cos($x), "far side of overload table", "cosinusfies" );
  87         }
  88     }
  89
  90     is( "$x", "foo", "stringifies" );
  91     is( "$y", $ystr, "stringifies qr//" );
  92     is( 0 + $x, refaddr($x), "no numification" );
  93     is( cos($x), "far side of overload table", "cosinusfies" );
  94
  95     no overloading "cos";
  96     is( "$x", "foo", "stringifies" );
  97     is( "$y", $ystr, "stringifies qr//" );
  98     is( 0 + $x, refaddr($x), "no numification" );
  99     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
 100
 101     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
 102
 103     use overloading;
 104
 105     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
 106 }