[p5sagit/p5-mst-13.2.git] / t / lib / u-reftype.t

BEGIN {
	chdir 't' if -d 't';
	@INC = '../lib';
	require Config; import Config;
	if ($Config{extensions} !~ /\bList\/Util\b/) {
	    print "1..0 # Skip: List::Util was not built\n";
	    exit 0;
	}
}

use Scalar::Util qw(reftype);
use vars qw($t $y $x *F);
use Symbol qw(gensym);

# 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 : defined($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
}
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	}