OSDN Git Service

[flang] Fix bug in IMPLICIT NONE(EXTERNAL)
authorTim Keith <tkeith@nvidia.com>
Sat, 19 Dec 2020 01:43:51 +0000 (17:43 -0800)
committerTim Keith <tkeith@nvidia.com>
Sat, 19 Dec 2020 01:43:53 +0000 (17:43 -0800)
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

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

index 495d7d0..8d52841 100644 (file)
@@ -1364,6 +1364,7 @@ private:
   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
index df015f7..5362f91 100644 (file)
@@ -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