[flang-commits] [flang] [flang] Reject interface name declared by a later PROCEDURE statement (PR #232928)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Demo_mod (Glitch-On)

<details>
<summary>Changes</summary>

C1515 requires that a name used as a procedure interface, when it is
itself declared by a procedure declaration statement, be declared before
that use. Name resolution creates a placeholder symbol for a forward
reference and only checks it after the whole specification part, by which
point the later PROCEDURE statement has given it an explicit interface, so
the program was accepted.

In the deferred check, report an error when the interface name resolves to
a procedure entity whose declaration comes after the use. Forward
references to interface bodies and module procedures are still accepted.

Fixes #<!-- -->229229



---
Full diff: https://github.com/llvm/llvm-project/pull/232928.diff


2 Files Affected:

- (modified) flang/lib/Semantics/resolve-names.cpp (+19) 
- (added) flang/test/Semantics/procinterface06.f90 (+36) 


``````````diff
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d0964294d10c0..cf315147bdf02 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1187,6 +1187,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   void LegacyDataInitialization(const parser::Name &,
       const std::list<common::Indirection<parser::DataStmtValue>> &values);
   void CheckExplicitInterface(const parser::Name &);
+  void CheckInterfaceNameDeclaredBeforeUse(const parser::Name &);
   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 
   const parser::Name *ResolveDesignator(const parser::Designator &);
@@ -8816,6 +8817,23 @@ void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
   }
 }
 
+// C1515: a name that is declared by a procedure-declaration-stmt may be
+// used as an interface name only after that declaration.
+void DeclarationVisitor::CheckInterfaceNameDeclaredBeforeUse(
+    const parser::Name &name) {
+  if (const Symbol * symbol{name.symbol}) {
+    if (!context().HasError(*symbol) && symbol->has<ProcEntityDetails>() &&
+        symbol->HasExplicitInterface() &&
+        context().allCookedSources().Precedes(name.source, symbol->name())) {
+      Say(name,
+          "'%s' must be declared before it is used as a procedure interface"_err_en_US,
+          symbol->name())
+          .Attach(symbol->name(), "Later declaration of '%s'"_en_US,
+              symbol->name());
+    }
+  }
+}
+
 // Create a symbol for a type parameter, component, or procedure binding in
 // the current derived type scope. Return false on error.
 Symbol *DeclarationVisitor::MakeTypeSymbol(
@@ -11977,6 +11995,7 @@ class DeferredCheckVisitor {
   void Post(const parser::ProcInterface &pi) {
     if (const auto *name{std::get_if<parser::Name>(&pi.u)}) {
       resolver_.CheckExplicitInterface(*name);
+      resolver_.CheckInterfaceNameDeclaredBeforeUse(*name);
     }
   }
   bool Pre(const parser::EntityDecl &decl) {
diff --git a/flang/test/Semantics/procinterface06.f90 b/flang/test/Semantics/procinterface06.f90
new file mode 100644
index 0000000000000..ed2570cdaa0a1
--- /dev/null
+++ b/flang/test/Semantics/procinterface06.f90
@@ -0,0 +1,36 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! C1515: a name declared by a PROCEDURE statement may be used as an
+! interface name only after that declaration.
+module m
+  implicit none
+  abstract interface
+    subroutine s_iface()
+    end subroutine
+  end interface
+  !ERROR: 'q' must be declared before it is used as a procedure interface
+  procedure(q), pointer :: r
+  !ERROR: 'q' must be declared before it is used as a procedure interface
+  procedure(q) :: r2
+  procedure(s_iface), pointer :: q
+  procedure(q), pointer :: t ! ok, q is declared above
+  procedure(later), pointer :: u ! ok, later is declared by an interface body
+  interface
+    subroutine later()
+    end subroutine
+  end interface
+  type dt
+    !ERROR: 'q2' must be declared before it is used as a procedure interface
+    procedure(q2), pointer, nopass :: comp
+  end type
+  procedure(s_iface), pointer :: q2
+end module
+
+subroutine sub(a, b)
+  abstract interface
+    subroutine s_iface()
+    end subroutine
+  end interface
+  !ERROR: 'b' must be declared before it is used as a procedure interface
+  procedure(b), pointer :: a
+  procedure(s_iface) :: b
+end subroutine

``````````

</details>


https://github.com/llvm/llvm-project/pull/232928