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