[flang-commits] [flang] bf0870d - [flang] Fix bug in IMPLICIT NONE(EXTERNAL)

[Tim Keith via flang-commits]

Author: Tim Keith
Date: 2020-12-18T17:43:53-08:00
New Revision: bf0870d8640df27b6bb082de0347008240cb0e67

URL: https://github.com/llvm/llvm-project/commit/bf0870d8640df27b6bb082de0347008240cb0e67
DIFF: https://github.com/llvm/llvm-project/commit/bf0870d8640df27b6bb082de0347008240cb0e67.diff

LOG: [flang] Fix bug in IMPLICIT NONE(EXTERNAL)

We were only checking the restrictions of IMPLICIT NONE(EXTERNAL) when a
procedure name is first encountered. But it can also happen with an
existing symbol, e.g. if an external function's return type is declared
before is it called. This change adds a check in that branch too.

Differential Revision: https://reviews.llvm.org/D93552

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/implicit07.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 495d7d0f8584..8d5284131cc0 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1364,6 +1364,7 @@ class ResolveNamesVisitor : public virtual ScopeHandler,
   void CheckImport(const SourceName &, const SourceName &);
   void HandleCall(Symbol::Flag, const parser::Call &);
   void HandleProcedureName(Symbol::Flag, const parser::Name &);
+  bool CheckImplicitNoneExternal(const SourceName &, const Symbol &);
   bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
   void ResolveSpecificationParts(ProgramTree &);
   void AddSubpNames(ProgramTree &);
@@ -5853,10 +5854,7 @@ void ResolveNamesVisitor::HandleProcedureName(
       return;
     }
     if (!symbol->attrs().test(Attr::INTRINSIC)) {
-      if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) {
-        Say(name,
-            "'%s' is an external procedure without the EXTERNAL"
-            " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
+      if (!CheckImplicitNoneExternal(name.source, *symbol)) {
         return;
       }
       MakeExternal(*symbol);
@@ -5877,6 +5875,7 @@ void ResolveNamesVisitor::HandleProcedureName(
     if (!SetProcFlag(name, *symbol, flag)) {
       return; // reported error
     }
+    CheckImplicitNoneExternal(name.source, *symbol);
     if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
         symbol->has<ObjectEntityDetails>() ||
         symbol->has<AssocEntityDetails>()) {
@@ -5895,6 +5894,18 @@ void ResolveNamesVisitor::HandleProcedureName(
   }
 }
 
+bool ResolveNamesVisitor::CheckImplicitNoneExternal(
+    const SourceName &name, const Symbol &symbol) {
+  if (isImplicitNoneExternal() && !symbol.attrs().test(Attr::EXTERNAL) &&
+      !symbol.attrs().test(Attr::INTRINSIC) && !symbol.HasExplicitInterface()) {
+    Say(name,
+        "'%s' is an external procedure without the EXTERNAL"
+        " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US);
+    return false;
+  }
+  return true;
+}
+
 // Variant of HandleProcedureName() for use while skimming the executable
 // part of a subprogram to catch calls to dummy procedures that are part
 // of the subprogram's interface, and to mark as procedures any symbols

diff  --git a/flang/test/Semantics/implicit07.f90 b/flang/test/Semantics/implicit07.f90
index df015f7bcc62..5362f91dcb02 100644
--- a/flang/test/Semantics/implicit07.f90
+++ b/flang/test/Semantics/implicit07.f90
@@ -1,9 +1,12 @@
 ! RUN: %S/test_errors.sh %s %t %f18
 implicit none(external)
 external x
+integer :: f, i
 call x
 !ERROR: 'y' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)
 call y
+!ERROR: 'f' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)
+i = f()
 block
   !ERROR: 'z' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL)
   call z