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 => 35);
  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         cos => sub { "far side of overload table" },
  23     );
  24
  25     sub new { bless {}, shift };
  26 }
  27
  28 my $x = Stringifies->new;
  29
  30 is( "$x", "foo", "stringifies" );
  31 is( 0 + $x, 42, "numifies" );
  32 is( cos($x), "far side of overload table", "cosinusfies" );
  33
  34 {
  35     no overloading;
  36     is( "$x", overload::StrVal($x), "no stringification" );
  37     is( 0 + $x, refaddr($x), "no numification" );
  38     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  39
  40     {
  41         no overloading '""';
  42         is( "$x", overload::StrVal($x), "no stringification" );
  43         is( 0 + $x, refaddr($x), "no numification" );
  44         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  45     }
  46 }
  47
  48 {
  49     no overloading '""';
  50
  51     is( "$x", overload::StrVal($x), "no stringification" );
  52     is( 0 + $x, 42, "numifies" );
  53     is( cos($x), "far side of overload table", "cosinusfies" );
  54
  55     {
  56         no overloading;
  57         is( "$x", overload::StrVal($x), "no stringification" );
  58         is( 0 + $x, refaddr($x), "no numification" );
  59         is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  60     }
  61
  62     use overloading '""';
  63
  64     is( "$x", "foo", "stringifies" );
  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( 0 + $x, refaddr($x), "no numification" );
  71     is( cos($x), "far side of overload table", "cosinusfies" );
  72
  73     {
  74         no overloading '""';
  75         is( "$x", overload::StrVal($x), "no stringification" );
  76         is( 0 + $x, refaddr($x), "no numification" );
  77         is( cos($x), "far side of overload table", "cosinusfies" );
  78
  79         {
  80             use overloading;
  81             is( "$x", "foo", "stringifies" );
  82             is( 0 + $x, 42, "numifies" );
  83             is( cos($x), "far side of overload table", "cosinusfies" );
  84         }
  85     }
  86
  87     is( "$x", "foo", "stringifies" );
  88     is( 0 + $x, refaddr($x), "no numification" );
  89     is( cos($x), "far side of overload table", "cosinusfies" );
  90
  91     no overloading "cos";
  92     is( "$x", "foo", "stringifies" );
  93     is( 0 + $x, refaddr($x), "no numification" );
  94     is( cos($x), cos(refaddr($x)), "no cosinusfication" );
  95
  96     BEGIN { ok(exists($^H{overloading}), "overloading hint present") }
  97
  98     use overloading;
  99
 100     BEGIN { ok(!exists($^H{overloading}), "overloading hint removed") }
 101 }