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 => 23;
  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
  25 @test = (
  26  [ undef, 1,            'number'        ],
  27  [ undef, 'A',          'string'        ],
  28  [ HASH   => {},        'HASH ref'      ],
  29  [ ARRAY  => [],        'ARRAY ref'     ],
  30  [ SCALAR => \$t,       'SCALAR ref'    ],
  31  [ REF    => \(\$t),    'REF ref'       ],
  32  [ GLOB   => \*F,       'tied GLOB ref' ],
  33  [ GLOB   => gensym,    'GLOB ref'      ],
  34  [ CODE   => sub {},    'CODE ref'      ],
  35 # [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
  36 );
  37
  38 foreach $test (@test) {
  39   my($type,$what, $n) = @$test;
  40
  41   is( reftype($what), $type, $n);
  42   next unless ref($what);
  43
  44   bless $what, "ABC";
  45   is( reftype($what), $type, $n);
  46
  47   bless $what, "0";
  48   is( reftype($what), $type, $n);
  49 }
  50
  51 package MyTie;
  52
  53 sub TIEHANDLE { bless {} }
  54 sub DESTROY {}
  55
  56 sub AUTOLOAD {
  57   warn "$AUTOLOAD called";
  58   exit 1; # May be in an eval
  59 }