Commit | Line | Data |
f4a2945e |
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 | } |