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 => 22);
  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     );
  23
  24     sub new { bless {}, shift };
  25 }
  26
  27 my $x = Stringifies->new;
  28
  29 is( "$x", "foo", "stringifies" );
  30 is( 0 + $x, 42, "numifies" );
  31
  32 {
  33     no overloading;
  34     is( "$x", overload::StrVal($x), "no stringification" );
  35     is( 0 + $x, refaddr($x), "no numification" );
  36
  37     {
  38         no overloading '""';
  39         is( "$x", overload::StrVal($x), "no stringification" );
  40         is( 0 + $x, refaddr($x), "no numification" );
  41     }
  42 }
  43
  44 {
  45     no overloading '""';
  46
  47     is( "$x", overload::StrVal($x), "no stringification" );
  48     is( 0 + $x, 42, "numifies" );
  49
  50     {
  51         no overloading;
  52         is( "$x", overload::StrVal($x), "no stringification" );
  53         is( 0 + $x, refaddr($x), "no numification" );
  54     }
  55
  56     use overloading '""';
  57
  58     is( "$x", "foo", "stringifies" );
  59     is( 0 + $x, 42, "numifies" );
  60
  61     no overloading '0+';
  62     is( "$x", "foo", "stringifies" );
  63     is( 0 + $x, refaddr($x), "no numification" );
  64
  65     {
  66         no overloading '""';
  67         is( "$x", overload::StrVal($x), "no stringification" );
  68         is( 0 + $x, refaddr($x), "no numification" );
  69
  70         {
  71             use overloading;
  72             is( "$x", "foo", "stringifies" );
  73             is( 0 + $x, 42, "numifies" );
  74         }
  75     }
  76
  77     is( "$x", "foo", "stringifies" );
  78     is( 0 + $x, refaddr($x), "no numification" );
  79
  80
  81     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
  82
  83     use overloading;
  84
  85     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
  86 }