perl-5.16.2/cpan/List-Util/t/proto.t

#!./perl

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

use Scalar::Util ();
use Test::More  (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL)
			? (skip_all => 'set_prototype requires XS version')
			: (tests => 13);

Scalar::Util->import('set_prototype');

sub f { }
is( prototype('f'),	undef,	'no prototype');

$r = set_prototype(\&f,'$');
is( prototype('f'),	'$',	'set prototype');
is( $r,			\&f,	'return value');

set_prototype(\&f,undef);
is( prototype('f'),	undef,	'remove prototype');

set_prototype(\&f,'');
is( prototype('f'),	'',	'empty prototype');

sub g (@) { }
is( prototype('g'),	'@',	'@ prototype');

set_prototype(\&g,undef);
is( prototype('g'),	undef,	'remove prototype');

sub stub;
is( prototype('stub'),	undef,	'non existing sub');

set_prototype(\&stub,'$$$');
is( prototype('stub'),	'$$$',	'change non existing sub');

sub f_decl ($$$$);
is( prototype('f_decl'),	'$$$$',	'forward declaration');

set_prototype(\&f_decl,'\%');
is( prototype('f_decl'),	'\%',	'change forward declaration');

eval { &set_prototype( 'f', '' ); };
print "not " unless 
ok($@ =~ /^set_prototype: not a reference/,	'not a reference');

eval { &set_prototype( \'f', '' ); };
ok($@ =~ /^set_prototype: not a subroutine reference/,	'not a sub reference');