ext/List-Util/t/reftype.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless (-d 'blib') {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Config; import Config;
   8         keys %Config; # Silence warning
   9         if ($Config{extensions} !~ /\bList\/Util\b/) {
  10             print "1..0 # Skip: List::Util was not built\n";
  11             exit 0;
  12         }
  13     }
  14 }
  15
  16 use Test::More tests => 29;
  17
  18 use Scalar::Util qw(reftype);
  19 use vars qw($t $y $x *F);
  20 use Symbol qw(gensym);
  21
  22 # Ensure we do not trigger and tied methods
  23 tie *F, 'MyTie';
  24 my $RE = $] < 5.011 ? 'SCALAR' : 'REGEXP';
  25
  26 @test = (
  27  [ undef, 1,            'number'        ],
  28  [ undef, 'A',          'string'        ],
  29  [ HASH   => {},        'HASH ref'      ],
  30  [ ARRAY  => [],        'ARRAY ref'     ],
  31  [ SCALAR => \$t,       'SCALAR ref'    ],
  32  [ REF    => \(\$t),    'REF ref'       ],
  33  [ GLOB   => \*F,       'tied GLOB ref' ],
  34  [ GLOB   => gensym,    'GLOB ref'      ],
  35  [ CODE   => sub {},    'CODE ref'      ],
  36  [ IO     => *STDIN{IO},'IO ref'        ],
  37  [ $RE    => qr/x/,     'REGEEXP'       ],
  38 );
  39
  40 foreach $test (@test) {
  41   my($type,$what, $n) = @$test;
  42
  43   is( reftype($what), $type, $n);
  44   next unless ref($what);
  45
  46   bless $what, "ABC";
  47   is( reftype($what), $type, $n);
  48
  49   bless $what, "0";
  50   is( reftype($what), $type, $n);
  51 }
  52
  53 package MyTie;
  54
  55 sub TIEHANDLE { bless {} }
  56 sub DESTROY {}
  57
  58 sub AUTOLOAD {
  59   warn "$AUTOLOAD called";
  60   exit 1; # May be in an eval
  61 }