1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
use 5.024;
use strict;
use warnings;
sub outside {
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'";
}
package Package;
=head1 NAME
grammar - A Test resource for regular expressions
=head1 SYNOPSIS
A Perl file showing a variety of declarations
=head1 DESCRIPTION
This file offers several syntactical constructs for packages,
subroutines, and POD to test the imenu capabilities of CPerl mode.
Perl offers syntactical variations for package and subroutine
declarations. Packages may, or may not, have a version and may, or
may not, have a block of code attached to them. Subroutines can have
old-style prototypes, attributes, and signatures which are still
experimental but widely accepted.
Various Extensions and future Perl versions will probably add new
keywords for "class" and "method", both with syntactical extras of
their own.
This test file tries to keep up with them.
=head2 Details
The code is supposed to identify and exclude false positives,
e.g. declarations in a string or in POD, as well as POD in a string.
These should not go into the imenu index.
=cut
our $VERSION = 3.1415;
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
sub in_package {
# Special test for POD: A line which looks like POD, but actually
# is part of a multiline string. In the case shown here, the
# semicolon is not part of the string, but POD headings go to the
# end of the line. The code needs to distinguish between a POD
# heading "This Is Not A Pod/;" and a multiline string.
my $not_a_pod = q/Another false positive:
=head1 This Is Not A Pod/;
}
sub Shoved::elsewhere {
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', sub Shoved::elsewhere";
}
sub prototyped ($$) {
...;
}
package Versioned::Package 0.07;
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
sub versioned {
# This sub is in package Versioned::Package
say "sub 'versioned' in package '", __PACKAGE__, "'";
}
versioned();
my $false_positives = <<'EOH';
The following declarations are not supposed to be recorded for imenu.
They are in a HERE-doc, which is a generic comment in CPerl mode.
package Don::T::Report::This;
sub this_is_no_sub {
my $self = shuffle;
}
And this is not a POD heading:
=head1 Not a POD heading, just a string.
EOH
package Block {
our $VERSION = 2.7182;
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
sub attr:lvalue {
say "sub 'attr' in package '", __PACKAGE__, "'";
}
attr();
package Block::Inner {
# This hopefully doesn't happen too often.
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
}
# Now check that we're back to package "Block"
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
}
sub outer {
# This is in package Versioned::Package
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
}
outer();
package Versioned::Block 42 {
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
my sub lexical {
say "sub 'lexical' in package '", __PACKAGE__, "'";
}
lexical();
use experimental 'signatures';
sub signatured :prototype($@) ($self,@rest)
{
...;
}
}
# After all is said and done, we're back in package Versioned::Package.
say "We're in package '", __PACKAGE__, "' now.";
say "Now try to call a subroutine which went out of scope:";
eval { lexical() };
say $@ if $@;
# Now back to Package. This must not appear separately in the
# hierarchy list.
package Package;
our sub in_package_again {
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
}
package :: {
# This is just a weird, but legal, package name.
say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
in_package_again(); # weird, but calls the sub from above
}
Shoved::elsewhere();
1;
|
