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

[Tim Keith via Phabricator via llvm-commits]

tskeith created this revision.
tskeith added reviewers: klausler, PeteSteinfeld.
tskeith added a project: Flang.
Herald added a subscriber: jdoerfert.
tskeith requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

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.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D93552

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


Index: flang/test/Semantics/implicit07.f90
===================================================================
--- flang/test/Semantics/implicit07.f90
+++ 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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -1364,6 +1364,7 @@
   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 @@
       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 @@
     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 @@
   }
 }
 
+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


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D93552.312830.patch
Type: text/x-patch
Size: 2794 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20201218/061e40f2/attachment.bin>