Skip to content

Commit 88b1bc7

Browse files
blindpirateblindpirate
committed
Process @{namespace}::EXPORT correctly
1 parent 04e5f91 commit 88b1bc7

File tree

4 files changed

+114
-15
lines changed

4 files changed

+114
-15
lines changed

‎plugin/core/src/main/java/com/perl5/lang/perl/idea/PerlElementPatterns.java

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717
package com.perl5.lang.perl.idea;
1818

1919
import com.intellij.patterns.PsiElementPattern;
20+
import com.intellij.patterns.StandardPatterns;
2021
import com.intellij.psi.PsiElement;
2122
import com.perl5.lang.perl.psi.*;
2223
import com.perl5.lang.perl.psi.impl.PerlNoStatementElement;
@@ -162,7 +163,12 @@ private PerlElementPatterns() {
162163
);
163164

164165
public static final PsiElementPattern.Capture<PsiPerlArrayVariable> EXPORT_VARIABLE =
165-
psiElement(PsiPerlArrayVariable.class).withText("@EXPORT");
166+
psiElement(PsiPerlArrayVariable.class).withText(
167+
StandardPatterns.string().andOr(
168+
StandardPatterns.string().endsWith("::EXPORT"),
169+
StandardPatterns.string().equalTo("@EXPORT")
170+
)
171+
);
166172
public static final PsiElementPattern.Capture<PsiPerlVariableDeclarationGlobal> EXPORT_DECLARATION =
167173
psiElement(PsiPerlVariableDeclarationGlobal.class)
168174
.withChild(
@@ -177,7 +183,11 @@ private PerlElementPatterns() {
177183
);
178184

179185
public static final PsiElementPattern.Capture<PsiPerlArrayVariable> EXPORT_OK_VARIABLE =
180-
psiElement(PsiPerlArrayVariable.class).withText("@EXPORT_OK");
186+
psiElement(PsiPerlArrayVariable.class).withText(
187+
StandardPatterns.string().andOr(
188+
StandardPatterns.string().endsWith("::EXPORT_OK"),
189+
StandardPatterns.string().equalTo("@EXPORT_OK")
190+
));
181191
public static final PsiElementPattern.Capture<PsiPerlVariableDeclarationGlobal> EXPORT_OK_DECLARATION =
182192
psiElement(PsiPerlVariableDeclarationGlobal.class)
183193
.withChild(

‎plugin/core/src/main/java/com/perl5/lang/perl/psi/mixins/PerlNamespaceDefinitionMixin.java

Lines changed: 18 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@
4444
import java.util.ArrayList;
4545
import java.util.Collections;
4646
import java.util.List;
47+
import java.util.Set;
4748
import java.util.Map;
4849

4950
import static com.perl5.lang.perl.idea.PerlElementPatterns.*;
@@ -245,27 +246,31 @@ public void subtreeChanged() {
245246
myParentNamespaces.drop();
246247
}
247248

248-
public static class ExporterInfo implements Processor<PsiElement> {
249+
public class ExporterInfo implements Processor<PsiElement> {
249250
private final @NotNull List<String> EXPORT = new ArrayList<>();
250251
private final @NotNull List<String> EXPORT_OK = new ArrayList<>();
251252
private final @NotNull Map<String, List<String>> EXPORT_TAGS = Collections.emptyMap();
252253

254+
public void extractExport(PsiElement element, String exportName, List<String> target) {
255+
PsiElement rightSide = element.getFirstChild().getLastChild();
256+
String variableName = element.getFirstChild().getFirstChild().getText();
257+
258+
// @EXPORT or @{namespace}::EXPORT
259+
// @EXPORT_OK or @{namespace}::EXPORT_OK
260+
Set<String> acceptedVariableName = Set.of("@" + exportName, "@" + getNamespaceName() + "::" + exportName);
261+
if (acceptedVariableName.contains(variableName) && rightSide != null) {
262+
target.clear();
263+
target.addAll(getRightSideStrings(rightSide));
264+
}
265+
}
266+
253267
@Override
254268
public boolean process(PsiElement element) {
255269
if (ASSIGN_STATEMENT.accepts(element)) {
256270
if (EXPORT_ASSIGN_STATEMENT.accepts(element)) {
257-
PsiElement rightSide = element.getFirstChild().getLastChild();
258-
if (rightSide != null) {
259-
EXPORT.clear();
260-
EXPORT.addAll(getRightSideStrings(rightSide));
261-
}
262-
}
263-
else if (EXPORT_OK_ASSIGN_STATEMENT.accepts(element)) {
264-
PsiElement rightSide = element.getFirstChild().getLastChild();
265-
if (rightSide != null) {
266-
EXPORT_OK.clear();
267-
EXPORT_OK.addAll(getRightSideStrings(rightSide));
268-
}
271+
extractExport(element, "EXPORT", EXPORT);
272+
} else if (EXPORT_OK_ASSIGN_STATEMENT.accepts(element)) {
273+
extractExport(element, "EXPORT_OK", EXPORT_OK);
269274
}
270275
}
271276

‎plugin/src/test/java/unit/perl/ExporterTest.java

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ protected String getBaseDataPath() {
3333
@Test
3434
public void testExport() {
3535
doTest("export.pl", "Foo", new String[]{"this", "is", "the", "end"}, new String[]{});
36+
doTest("boolean.pl", "boolean", new String[]{"true", "false", "boolean"}, new String[]{"isTrue", "isFalse", "isBoolean"});
3637
}
3738

3839
@Test

‎plugin/src/test/resources/unit/perl/exporter/boolean.pl

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
use strict; use warnings;
2+
package boolean;
3+
our $VERSION = '0.46';
4+
5+
my ($true, $false);
6+
7+
use overload
8+
'""' => sub { ${$_[0]} },
9+
'!' => sub { ${$_[0]} ? $false : $true },
10+
fallback => 1;
11+
12+
use base 'Exporter';
13+
@boolean::EXPORT = qw(true false boolean);
14+
@boolean::EXPORT_OK = qw(isTrue isFalse isBoolean);
15+
%boolean::EXPORT_TAGS = (
16+
all => [@boolean::EXPORT, @boolean::EXPORT_OK],
17+
test => [qw(isTrue isFalse isBoolean)],
18+
);
19+
20+
sub import {
21+
my @options = grep $_ ne '-truth', @_;
22+
$_[0]->truth if @options != @_;
23+
@_ = @options;
24+
goto &Exporter::import;
25+
}
26+
27+
my ($true_val, $false_val, $bool_vals);
28+
29+
BEGIN {
30+
my $t = 1;
31+
my $f = 0;
32+
$true = do {bless \$t, 'boolean'};
33+
$false = do {bless \$f, 'boolean'};
34+
35+
$true_val = overload::StrVal($true);
36+
$false_val = overload::StrVal($false);
37+
$bool_vals = {$true_val => 1, $false_val => 1};
38+
}
39+
40+
# refaddrs change on thread spawn, so CLONE fixes them up
41+
sub CLONE {
42+
$true_val = overload::StrVal($true);
43+
$false_val = overload::StrVal($false);
44+
$bool_vals = {$true_val => 1, $false_val => 1};
45+
}
46+
47+
sub true() { $true }
48+
sub false() { $false }
49+
sub boolean($) {
50+
die "Not enough arguments for boolean::boolean" if scalar(@_) == 0;
51+
die "Too many arguments for boolean::boolean" if scalar(@_) > 1;
52+
return not(defined $_[0]) ? false :
53+
"$_[0]" ? $true : $false;
54+
}
55+
sub isTrue($) {
56+
not(defined $_[0]) ? false :
57+
(overload::StrVal($_[0]) eq $true_val) ? true : false;
58+
}
59+
sub isFalse($) {
60+
not(defined $_[0]) ? false :
61+
(overload::StrVal($_[0]) eq $false_val) ? true : false;
62+
}
63+
sub isBoolean($) {
64+
not(defined $_[0]) ? false :
65+
(exists $bool_vals->{overload::StrVal($_[0])}) ? true : false;
66+
}
67+
68+
sub truth {
69+
die "-truth not supported on Perl 5.22 or later" if $] >= 5.021005;
70+
# enable modifying true and false
71+
&Internals::SvREADONLY( \ !!0, 0);
72+
&Internals::SvREADONLY( \ !!1, 0);
73+
# turn perl internal booleans into blessed booleans:
74+
${ \ !!0 } = $false;
75+
${ \ !!1 } = $true;
76+
# make true and false read-only again
77+
&Internals::SvREADONLY( \ !!0, 1);
78+
&Internals::SvREADONLY( \ !!1, 1);
79+
}
80+
81+
sub TO_JSON { ${$_[0]} ? \1 : \0 }
82+
83+
1;

0 commit comments

Comments
 (0)