|
Server : Apache/2.2.22 (Unix) mod_ssl/2.2.22 OpenSSL/1.0.0-fips mod_auth_passthrough/2.1 mod_bwlimited/1.4 System : Linux server.jackjohnson.com 2.6.32-279.5.2.el6.x86_64 #1 SMP Fri Aug 24 01:07:11 UTC 2012 x86_64 User : jackjohn ( 502) PHP Version : 5.3.17 Disable Function : NONE Directory : /installd/perl588installer/Scalar-List-Utils-1.19/t/ |
Upload File : |
#!./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');