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