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