Process @{namespace}::EXPORT correctly

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

@@ -17,6 +17,7 @@
 package com.perl5.lang.perl.idea;
 
 import com.intellij.patterns.PsiElementPattern;
+import com.intellij.patterns.StandardPatterns;
 import com.intellij.psi.PsiElement;
 import com.perl5.lang.perl.psi.*;
 import com.perl5.lang.perl.psi.impl.PerlNoStatementElement;
@@ -162,7 +163,12 @@ private PerlElementPatterns() {
   );
 
   public static final PsiElementPattern.Capture<PsiPerlArrayVariable> EXPORT_VARIABLE =
-    psiElement(PsiPerlArrayVariable.class).withText("@EXPORT");
+    psiElement(PsiPerlArrayVariable.class).withText(
+      StandardPatterns.string().andOr(
+        StandardPatterns.string().endsWith("::EXPORT"),
+        StandardPatterns.string().equalTo("@EXPORT")
+      )
+    );
   public static final PsiElementPattern.Capture<PsiPerlVariableDeclarationGlobal> EXPORT_DECLARATION =
     psiElement(PsiPerlVariableDeclarationGlobal.class)
       .withChild(
@@ -177,7 +183,11 @@ private PerlElementPatterns() {
     );
 
   public static final PsiElementPattern.Capture<PsiPerlArrayVariable> EXPORT_OK_VARIABLE =
-    psiElement(PsiPerlArrayVariable.class).withText("@EXPORT_OK");
+    psiElement(PsiPerlArrayVariable.class).withText(
+      StandardPatterns.string().andOr(
+        StandardPatterns.string().endsWith("::EXPORT_OK"),
+        StandardPatterns.string().equalTo("@EXPORT_OK")
+      ));
   public static final PsiElementPattern.Capture<PsiPerlVariableDeclarationGlobal> EXPORT_OK_DECLARATION =
     psiElement(PsiPerlVariableDeclarationGlobal.class)
       .withChild(

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

@@ -44,6 +44,7 @@
 import java.util.ArrayList;
 import java.util.Collections;
 import java.util.List;
+import java.util.Set;
 import java.util.Map;
 
 import static com.perl5.lang.perl.idea.PerlElementPatterns.*;
@@ -245,27 +246,45 @@ public void subtreeChanged() {
     myParentNamespaces.drop();
   }
 
-  public static class ExporterInfo implements Processor<PsiElement> {
+  public class ExporterInfo implements Processor<PsiElement> {
     private final @NotNull List<String> EXPORT = new ArrayList<>();
     private final @NotNull List<String> EXPORT_OK = new ArrayList<>();
     private final @NotNull Map<String, List<String>> EXPORT_TAGS = Collections.emptyMap();
 
+    // Deals with the following cases:
+    // use subs our @EXPORT_OK = qw( a b c );
+    public PsiElement findAssignExpr(PsiElement element) {
+      PsiElement target = element.getFirstChild();
+      while (target != null && !(target instanceof PsiPerlAssignExpr)) {
+        target = target.getNextSibling();
+      }
+      return target;
+    }
+
+    public void extractExport(PsiElement element, String exportName, List<String> target) {
+      PsiElement assignExpr = findAssignExpr(element);
+      PsiElement leftSide = assignExpr.getFirstChild();
+      PsiElement rightSide = assignExpr.getLastChild();
+      String variableName = leftSide instanceof PerlVariableDeclarationExpr ?
+        leftSide.getLastChild().getText() :
+        leftSide.getText();
+
+      // @EXPORT or @{namespace}::EXPORT
+      // @EXPORT_OK or @{namespace}::EXPORT_OK
+      Set<String> acceptedVariableName = Set.of("@" + exportName, "@" + getNamespaceName() + "::" + exportName);
+      if (acceptedVariableName.contains(variableName) && rightSide != null) {
+        target.clear();
+        target.addAll(getRightSideStrings(rightSide));
+      }
+    }
+
     @Override
     public boolean process(PsiElement element) {
       if (ASSIGN_STATEMENT.accepts(element)) {
         if (EXPORT_ASSIGN_STATEMENT.accepts(element)) {
-          PsiElement rightSide = element.getFirstChild().getLastChild();
-          if (rightSide != null) {
-            EXPORT.clear();
-            EXPORT.addAll(getRightSideStrings(rightSide));
-          }
-        }
-        else if (EXPORT_OK_ASSIGN_STATEMENT.accepts(element)) {
-          PsiElement rightSide = element.getFirstChild().getLastChild();
-          if (rightSide != null) {
-            EXPORT_OK.clear();
-            EXPORT_OK.addAll(getRightSideStrings(rightSide));
-          }
+          extractExport(element, "EXPORT", EXPORT);
+        } else if (EXPORT_OK_ASSIGN_STATEMENT.accepts(element)) {
+          extractExport(element, "EXPORT_OK", EXPORT_OK);
         }
       }
 

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

@@ -33,6 +33,8 @@ protected String getBaseDataPath() {
   @Test
   public void testExport() {
     doTest("export.pl", "Foo", new String[]{"this", "is", "the", "end"}, new String[]{});
+    doTest("boolean.pl", "boolean", new String[]{"true", "false", "boolean"}, new String[]{"isTrue", "isFalse", "isBoolean"});
+    doTest("Opcode.pm", "Opcode", new String[]{}, new String[]{"opset", "opset_to_hex", "opdump"});
   }
 
   @Test

plugin/src/test/resources/unit/perl/exporter/Opcode.pm

@@ -0,0 +1,14 @@
+package Opcode 1.64;
+
+use strict;
+
+use Carp;
+use Exporter 'import';
+use XSLoader;
+
+sub opset (;@);
+sub opset_to_hex ($);
+sub opdump (;$);
+use subs our @EXPORT_OK = qw(
+        opset opset_to_hex opdump
+);

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

@@ -0,0 +1,83 @@
+use strict; use warnings;
+package boolean;
+our $VERSION = '0.46';
+
+my ($true, $false);
+
+use overload
+    '""' => sub { ${$_[0]} },
+    '!' => sub { ${$_[0]} ? $false : $true },
+    fallback => 1;
+
+use base 'Exporter';
+@boolean::EXPORT = qw(true false boolean);
+@boolean::EXPORT_OK = qw(isTrue isFalse isBoolean);
+%boolean::EXPORT_TAGS = (
+    all    => [@boolean::EXPORT, @boolean::EXPORT_OK],
+    test   => [qw(isTrue isFalse isBoolean)],
+);
+
+sub import {
+    my @options = grep $_ ne '-truth', @_;
+    $_[0]->truth if @options != @_;
+    @_ = @options;
+    goto &Exporter::import;
+}
+
+my ($true_val, $false_val, $bool_vals);
+
+BEGIN {
+    my $t = 1;
+    my $f = 0;
+    $true  = do {bless \$t, 'boolean'};
+    $false = do {bless \$f, 'boolean'};
+
+    $true_val  = overload::StrVal($true);
+    $false_val = overload::StrVal($false);
+    $bool_vals = {$true_val => 1, $false_val => 1};
+}
+
+# refaddrs change on thread spawn, so CLONE fixes them up
+sub CLONE {
+    $true_val  = overload::StrVal($true);
+    $false_val = overload::StrVal($false);
+    $bool_vals = {$true_val => 1, $false_val => 1};
+}
+
+sub true()  { $true }
+sub false() { $false }
+sub boolean($) {
+    die "Not enough arguments for boolean::boolean" if scalar(@_) == 0;
+    die "Too many arguments for boolean::boolean" if scalar(@_) > 1;
+    return not(defined $_[0]) ? false :
+    "$_[0]" ? $true : $false;
+}
+sub isTrue($)  {
+    not(defined $_[0]) ? false :
+    (overload::StrVal($_[0]) eq $true_val)  ? true : false;
+}
+sub isFalse($) {
+    not(defined $_[0]) ? false :
+    (overload::StrVal($_[0]) eq $false_val) ? true : false;
+}
+sub isBoolean($) {
+    not(defined $_[0]) ? false :
+    (exists $bool_vals->{overload::StrVal($_[0])}) ? true : false;
+}
+
+sub truth {
+    die "-truth not supported on Perl 5.22 or later" if $] >= 5.021005;
+    # enable modifying true and false
+    &Internals::SvREADONLY( \ !!0, 0);
+    &Internals::SvREADONLY( \ !!1, 0);
+    # turn perl internal booleans into blessed booleans:
+    ${ \ !!0 } = $false;
+    ${ \ !!1 } = $true;
+    # make true and false read-only again
+    &Internals::SvREADONLY( \ !!0, 1);
+    &Internals::SvREADONLY( \ !!1, 1);
+}
+
+sub TO_JSON { ${$_[0]} ? \1 : \0 }
+
+1;