scalarutil-proto.t (perl-5.32.0-RC0.tar.xz) | : | scalarutil-proto.t (perl-5.32.0-RC1.tar.xz) | ||
---|---|---|---|---|
#!./perl | #!./perl | |||
use strict; | use strict; | |||
use warnings; | use warnings; | |||
use Scalar::Util (); | use Scalar::Util (); | |||
use Test::More (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL) | use Test::More (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL) | |||
? (skip_all => 'set_prototype requires XS version') | ? (skip_all => 'set_prototype requires XS version') | |||
: (tests => 14); | : (tests => 14); | |||
Scalar::Util->import('set_prototype'); | Scalar::Util->import('set_prototype'); | |||
sub f { } | sub f { } | |||
is( prototype('f'), undef, 'no prototype'); | is( prototype('f'), undef, 'no prototype'); | |||
my $r = set_prototype(\&f,'$'); | my $r = set_prototype(\&f,'$'); | |||
is( prototype('f'), '$', 'set prototype'); | is( prototype('f'), '$', 'set prototype'); | |||
is( $r, \&f, 'return value'); | is( $r, \&f, 'return value'); | |||
set_prototype(\&f,undef); | set_prototype(\&f,undef); | |||
is( prototype('f'), undef, 'remove prototype'); | is( prototype('f'), undef, 'remove prototype'); | |||
set_prototype(\&f,''); | set_prototype(\&f,''); | |||
is( prototype('f'), '', 'empty prototype'); | is( prototype('f'), '', 'empty prototype'); | |||
sub g (@) { } | sub g (@) { } | |||
is( prototype('g'), '@', '@ prototype'); | is( prototype('g'), '@', '@ prototype'); | |||
set_prototype(\&g,undef); | set_prototype(\&g,undef); | |||
is( prototype('g'), undef, 'remove prototype'); | is( prototype('g'), undef, 'remove prototype'); | |||
sub stub; | sub stub; | |||
is( prototype('stub'), undef, 'non existing sub'); | is( prototype('stub'), undef, 'non existing sub'); | |||
set_prototype(\&stub,'$$$'); | set_prototype(\&stub,'$$$'); | |||
is( prototype('stub'), '$$$', 'change non existing sub'); | is( prototype('stub'), '$$$', 'change non existing sub'); | |||
sub f_decl ($$$$); | sub f_decl ($$$$); | |||
is( prototype('f_decl'), '$$$$', 'forward declaration'); | is( prototype('f_decl'), '$$$$', 'forward declaration'); | |||
set_prototype(\&f_decl,'\%'); | set_prototype(\&f_decl,'\%'); | |||
is( prototype('f_decl'), '\%', 'change forward declaration'); | is( prototype('f_decl'), '\%', 'change forward declaration'); | |||
eval { &set_prototype( 'f', '' ); }; | eval { &set_prototype( 'f', '' ); }; | |||
print "not " unless | print "not " unless | |||
ok($@ =~ /^set_prototype: not a reference/, 'not a reference'); | ok($@ =~ /^set_prototype: not a reference/, 'not a reference'); | |||
eval { &set_prototype( \'f', '' ); }; | eval { &set_prototype( \'f', '' ); }; | |||
ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference'); | ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference'); | |||
# RT 72080 | # RT 72080 | |||
{ | { | |||
package TiedCV; | package TiedCV; | |||
sub TIESCALAR { | sub TIESCALAR { | |||
my $class = shift; | my $class = shift; | |||
return bless {@_}, $class; | return bless {@_}, $class; | |||
} | } | |||
sub FETCH { | sub FETCH { | |||
End of changes. 13 change blocks. | ||||
15 lines changed or deleted | 15 lines changed or added |