Commit | Line | Data |
---|---|---|
afebc493 GS |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
20822f61 | 5 | @INC = '../lib'; |
09b1b8c1 | 6 | require './test.pl'; |
afebc493 GS |
7 | } |
8 | ||
afebc493 | 9 | sub t1; |
d152a4c4 | 10 | sub t2 : lvalue; |
afebc493 GS |
11 | sub t3 (); |
12 | sub t4 ($); | |
13 | sub t5 {1;} | |
14 | { | |
15 | package P1; | |
16 | sub tmc {1;} | |
17 | package P2; | |
18 | @ISA = 'P1'; | |
19 | } | |
20 | ||
09b1b8c1 CK |
21 | my $has_t1 = ok( exists &t1, 't1 sub declared' ); |
22 | SKIP: { | |
23 | skip 't1 sub was not declared', 1 if ! $has_t1; | |
24 | ok( ! defined &t1, 't1 not defined' ); | |
25 | } | |
26 | ||
27 | my $has_t2 = ok( exists &t2, 't2 sub declared' ); | |
28 | SKIP: { | |
29 | skip 't2 sub was not declared', 1 if ! $has_t2; | |
30 | ok( ! defined &t2, 't2 not defined' ); | |
31 | } | |
32 | ||
33 | my $has_t3 = ok( exists &t3, 't3 sub declared' ); | |
34 | SKIP: { | |
35 | skip 't3 sub was not declared', 1 if ! $has_t3; | |
36 | ok( ! defined &t3, 't3 not defined' ); | |
37 | } | |
38 | ||
39 | my $has_t4 = ok( exists &t4, 't4 sub declared' ); | |
40 | SKIP: { | |
41 | skip 't4 sub was not declared', 1 if ! $has_t4; | |
42 | ok( ! defined &t4, 't4 not defined' ); | |
43 | } | |
44 | ||
45 | my $has_t5 = ok( exists &t5, 't5 sub declared' ); | |
46 | SKIP: { | |
47 | skip 't5 sub was not declared', 1 if ! $has_t5; | |
48 | ok( defined &t5, , 't5 defined' ); | |
49 | } | |
50 | ||
51 | my $has_p2_tmc = ok(! exists &P2::tmc, 'P2::tmc not declared, it was inherited'); | |
52 | SKIP: { | |
53 | skip 'P2::tmc sub was not declared', 1 if ! $has_t5; | |
54 | ok( ! defined &P2::tmc, 'P2::tmc not defined' ); | |
55 | } | |
56 | ||
afebc493 GS |
57 | my $ref; |
58 | $ref->{A}[0] = \&t4; | |
09b1b8c1 CK |
59 | my $ref_exists = ok( exists &{$ref->{A}[0]}, 'references to subroutines exist'); |
60 | SKIP: { | |
61 | skip 1, 'Reference sub is not considered declared', 1 if ! $ref_exists; | |
62 | ok( ! defined &{$ref->{A}[0]}, 'Reference to a sub is not defined' ); | |
63 | } | |
64 | ||
65 | my $p1_tmc_exists = ok( exists &P1::tmc, 'test setup check'); | |
66 | SKIP: { | |
67 | skip 'Setup P1::tmc sub is not considered declared', 1 if ! $p1_tmc_exists; | |
68 | ok( defined P1::tmc, 'Setup sub is defined' ); | |
69 | } | |
70 | ||
afebc493 | 71 | undef &P1::tmc; |
09b1b8c1 CK |
72 | $p1_tmc_exists = ok( exists &P1::tmc, 'P1::tmc was once defined, and continues to be after being undeffed'); |
73 | SKIP: { | |
74 | skip( 'Sub P1::tmc still exists after having undef called on it', 1) if ! $p1_tmc_exists; | |
75 | ok( ! defined &P1::tmc, 'P1::tmc is not longer defined after undef was called on it' ); | |
76 | } | |
77 | ||
afebc493 | 78 | eval 'exists &t5()'; |
09b1b8c1 CK |
79 | like( $@, qr/not a subroutine name/, 'exists takes subroutine names with no argument list'); |
80 | ||
81 | done_testing(); | |
afebc493 GS |
82 | |
83 | exit 0; |