Commit | Line | Data |
97605c51 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | unless (-d 'blib') { |
5 | chdir 't' if -d 't'; |
6 | @INC = '../lib'; |
7 | require Config; import Config; |
8 | keys %Config; # Silence warning |
9 | if ($Config{extensions} !~ /\bList\/Util\b/) { |
10 | print "1..0 # Skip: List::Util was not built\n"; |
11 | exit 0; |
12 | } |
13 | } |
14 | } |
15 | |
cf083cf9 |
16 | use Scalar::Util (); |
17 | use Test::More (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL) |
18 | ? (skip_all => 'set_prototype requires XS version') |
19 | : (tests => 13); |
97605c51 |
20 | |
cf083cf9 |
21 | Scalar::Util->import('set_prototype'); |
97605c51 |
22 | |
23 | sub f { } |
cf083cf9 |
24 | is( prototype('f'), undef, 'no prototype'); |
25 | |
97605c51 |
26 | $r = set_prototype(\&f,'$'); |
cf083cf9 |
27 | is( prototype('f'), '$', 'set prototype'); |
28 | is( $r, \&f, 'return value'); |
29 | |
97605c51 |
30 | set_prototype(\&f,undef); |
cf083cf9 |
31 | is( prototype('f'), undef, 'remove prototype'); |
32 | |
97605c51 |
33 | set_prototype(\&f,''); |
cf083cf9 |
34 | is( prototype('f'), '', 'empty prototype'); |
97605c51 |
35 | |
36 | sub g (@) { } |
cf083cf9 |
37 | is( prototype('g'), '@', '@ prototype'); |
38 | |
97605c51 |
39 | set_prototype(\&g,undef); |
cf083cf9 |
40 | is( prototype('g'), undef, 'remove prototype'); |
97605c51 |
41 | |
cf083cf9 |
42 | sub stub; |
43 | is( prototype('stub'), undef, 'non existing sub'); |
97605c51 |
44 | |
cf083cf9 |
45 | set_prototype(\&stub,'$$$'); |
46 | is( prototype('stub'), '$$$', 'change non existing sub'); |
47 | |
48 | sub f_decl ($$$$); |
49 | is( prototype('f_decl'), '$$$$', 'forward declaration'); |
50 | |
51 | set_prototype(\&f_decl,'\%'); |
52 | is( prototype('f_decl'), '\%', 'change forward declaration'); |
97605c51 |
53 | |
54 | eval { &set_prototype( 'f', '' ); }; |
cf083cf9 |
55 | print "not " unless |
56 | ok($@ =~ /^set_prototype: not a reference/, 'not a reference'); |
57 | |
97605c51 |
58 | eval { &set_prototype( \'f', '' ); }; |
cf083cf9 |
59 | ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference'); |