xref: /openbsd/gnu/usr.bin/perl/t/op/exists_sub.t (revision 5759b3d2) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc('../lib');
7}
8
9sub t1;
10sub t2 : lvalue;
11sub t3 ();
12sub t4 ($);
13sub t5 {1;}
14{
15    package P1;
16    sub tmc {1;}
17    package P2;
18    @ISA = 'P1';
19}
20
21my $has_t1 = ok( exists &t1, 't1 sub declared' );
22SKIP: {
23    skip 't1 sub was not declared', 1 if ! $has_t1;
24    ok( ! defined &t1, 't1 not defined' );
25}
26
27my $has_t2 = ok( exists &t2, 't2 sub declared' );
28SKIP: {
29    skip 't2 sub was not declared', 1 if ! $has_t2;
30    ok( ! defined &t2, 't2 not defined' );
31}
32
33my $has_t3 = ok( exists &t3, 't3 sub declared' );
34SKIP: {
35    skip 't3 sub was not declared', 1 if ! $has_t3;
36    ok( ! defined &t3, 't3 not defined' );
37}
38
39my $has_t4 = ok( exists &t4, 't4 sub declared' );
40SKIP: {
41    skip 't4 sub was not declared', 1 if ! $has_t4;
42    ok( ! defined &t4, 't4 not defined' );
43}
44
45my $has_t5 = ok( exists &t5, 't5 sub declared' );
46SKIP: {
47    skip 't5 sub was not declared', 1 if ! $has_t5;
48    ok( defined &t5, , 't5 defined' );
49}
50
51my $has_p2_tmc = ok(! exists &P2::tmc, 'P2::tmc not declared, it was inherited');
52SKIP: {
53    skip 'P2::tmc sub was not declared', 1 if ! $has_t5;
54    ok( ! defined &P2::tmc, 'P2::tmc not defined' );
55}
56
57my $ref;
58$ref->{A}[0] = \&t4;
59my $ref_exists = ok( exists &{$ref->{A}[0]}, 'references to subroutines exist');
60SKIP: {
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
65my $p1_tmc_exists = ok( exists &P1::tmc, 'test setup check');
66SKIP: {
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
71undef &P1::tmc;
72$p1_tmc_exists = ok( exists &P1::tmc, 'P1::tmc was once defined, and continues to be after being undeffed');
73SKIP: {
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
78eval 'exists &t5()';
79like( $@, qr/not a subroutine name/, 'exists takes subroutine names with no argument list');
80
81done_testing();
82
83exit 0;
84