1N/A#!./perl
1N/A
1N/ABEGIN {
1N/A unless (-d 'blib') {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require Config; import Config;
1N/A keys %Config; # Silence warning
1N/A if ($Config{extensions} !~ /\bList\/Util\b/) {
1N/A print "1..0 # Skip: List::Util was not built\n";
1N/A exit 0;
1N/A }
1N/A }
1N/A}
1N/A
1N/A
1N/Ause Scalar::Util qw(reftype);
1N/Ause vars qw($t $y $x *F);
1N/Ause Symbol qw(gensym);
1N/A
1N/A# Ensure we do not trigger and tied methods
1N/Atie *F, 'MyTie';
1N/A
1N/A@test = (
1N/A [ undef, 1],
1N/A [ undef, 'A'],
1N/A [ HASH => {} ],
1N/A [ ARRAY => [] ],
1N/A [ SCALAR => \$t ],
1N/A [ REF => \(\$t) ],
1N/A [ GLOB => \*F ],
1N/A [ GLOB => gensym ],
1N/A [ CODE => sub {} ],
1N/A# [ IO => *STDIN{IO} ] the internal sv_reftype returns UNKNOWN
1N/A);
1N/A
1N/Aprint "1..", @test*4, "\n";
1N/A
1N/Amy $i = 1;
1N/Aforeach $test (@test) {
1N/A my($type,$what) = @$test;
1N/A my $pack;
1N/A foreach $pack (undef,"ABC","0",undef) {
1N/A print "# $what\n";
1N/A my $res = reftype($what);
1N/A printf "# %s - %s\n", map { defined($_) ? $_ : 'undef' } $type,$res;
1N/A print "not " if $type ? $res ne $type : defined($res);
1N/A bless $what, $pack if $type && defined $pack;
1N/A print "ok ",$i++,"\n";
1N/A }
1N/A}
1N/A
1N/Apackage MyTie;
1N/A
1N/Asub TIEHANDLE { bless {} }
1N/Asub DESTROY {}
1N/A
1N/Asub AUTOLOAD {
1N/A warn "$AUTOLOAD called";
1N/A exit 1; # May be in an eval
1N/A}