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