lib/overloading.t

   1 #./perl
   2
   3 use Test::More tests => 35;
   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
  22 is( "$x", "foo", "stringifies" );
  23 is( 0 + $x, 42, "numifies" );
  24 is( cos($x), "far side of overload table", "cosinusfies" );
  25
  26 {
  27     no overloading;
  28     is( "$x", overload::StrVal($x), "no stringification" );
  29     is( 0 + $x, refaddr($x), "no numification" );
  30     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  31
  32     {
  33         no overloading '""';
  34         is( "$x", overload::StrVal($x), "no stringification" );
  35         is( 0 + $x, refaddr($x), "no numification" );
  36         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  37     }
  38 }
  39
  40 {
  41     no overloading '""';
  42
  43     is( "$x", overload::StrVal($x), "no stringification" );
  44     is( 0 + $x, 42, "numifies" );
  45     is( cos($x), "far side of overload table", "cosinusfies" );
  46
  47     {
  48         no overloading;
  49         is( "$x", overload::StrVal($x), "no stringification" );
  50         is( 0 + $x, refaddr($x), "no numification" );
  51         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  52     }
  53
  54     use overloading '""';
  55
  56     is( "$x", "foo", "stringifies" );
  57     is( 0 + $x, 42, "numifies" );
  58     is( cos($x), "far side of overload table", "cosinusfies" );
  59
  60     no overloading '0+';
  61     is( "$x", "foo", "stringifies" );
  62     is( 0 + $x, refaddr($x), "no numification" );
  63     is( cos($x), "far side of overload table", "cosinusfies" );
  64
  65     {
  66         no overloading '""';
  67         is( "$x", overload::StrVal($x), "no stringification" );
  68         is( 0 + $x, refaddr($x), "no numification" );
  69         is( cos($x), "far side of overload table", "cosinusfies" );
  70
  71         {
  72             use overloading;
  73             is( "$x", "foo", "stringifies" );
  74             is( 0 + $x, 42, "numifies" );
  75             is( cos($x), "far side of overload table", "cosinusfies" );
  76         }
  77     }
  78
  79     is( "$x", "foo", "stringifies" );
  80     is( 0 + $x, refaddr($x), "no numification" );
  81     is( cos($x), "far side of overload table", "cosinusfies" );
  82
  83     no overloading "cos";
  84     is( "$x", "foo", "stringifies" );
  85     is( 0 + $x, refaddr($x), "no numification" );
  86     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  87
  88     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
  89
  90     use overloading;
  91
  92     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
  93 }