t/lib/u-reftype.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4 }
   5
   6 use Scalar::Util qw(reftype);
   7 use vars qw($t $y $x *F);
   8 use Symbol qw(gensym);
   9
  10 # Ensure we do not trigger and tied methods
  11 tie *F, 'MyTie';
  12
  13 @test = (
  14  [ undef, 1],
  15  [ undef, 'A'],
  16  [ HASH => {} ],
  17  [ ARRAY => [] ],
  18  [ SCALAR => \$t ],
  19  [ REF    => \(\$t) ],
  20  [ GLOB   => \*F ],
  21  [ GLOB   => gensym ],
  22  [ CODE   => sub {} ],
  23 # [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
  24 );
  25
  26 print "1..", @test*4, "\n";
  27
  28 my $i = 1;
  29 foreach $test (@test) {
  30   my($type,$what) = @$test;
  31   my $pack;
  32   foreach $pack (undef,"ABC","0",undef) {
  33     print "# $what\n";
  34     my $res = reftype($what);
  35     printf "# %s - %s\n", map { defined($_) ? $_ : 'undef' } $type,$res;
  36     print "not " if $type ? $res ne $type : defined($res);
  37     bless $what, $pack if $type && defined $pack;
  38     print "ok ",$i++,"\n";
  39   }
  40 }
  41
  42 package MyTie;
  43
  44 sub TIEHANDLE { bless {} }
  45 sub DESTROY {}
  46
  47 sub AUTOLOAD {
  48   warn "$AUTOLOAD called";
  49   exit 1; # May be in an eval
  50 }