[flang-commits] [flang] b631629 - [flang] Accept FINAL forward reference to separate module procedure

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-08-29T13:37:09-07:00
New Revision: b6316294be01e7b332e6fdb88ce8de5c9a98af8c

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

LOG: [flang] Accept FINAL forward reference to separate module procedure

When one of a derived type's FINAL procedures is in a submodule,
its separate module procedure interface must necessarily be a
forward reference from the FINAL statement, as its interface
could not appear before the definition of the type.  The implementation
of FINAL procedure name resolution doesn't work for forward references;
replace it.

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

Added: 
    flang/test/Semantics/symbol30.f90

Modified: 
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index c7058d40d7d32d..c401e9214524b4 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1000,7 +1000,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   void Post(const parser::TypeBoundProcBinding &) { EndAttrs(); }
   void Post(const parser::TypeBoundProcedureStmt::WithoutInterface &);
   void Post(const parser::TypeBoundProcedureStmt::WithInterface &);
-  void Post(const parser::FinalProcedureStmt &);
+  bool Pre(const parser::FinalProcedureStmt &);
   bool Pre(const parser::TypeBoundGenericStmt &);
   bool Pre(const parser::StructureDef &); // returns false
   bool Pre(const parser::Union::UnionStmt &);
@@ -5615,24 +5615,31 @@ void DeclarationVisitor::Post(
   }
 }
 
-void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) {
+bool DeclarationVisitor::Pre(const parser::FinalProcedureStmt &x) {
   if (currScope().IsDerivedType() && currScope().symbol()) {
     if (auto *details{currScope().symbol()->detailsIf<DerivedTypeDetails>()}) {
       for (const auto &subrName : x.v) {
-        if (const auto *name{ResolveName(subrName)}) {
-          auto pair{
-              details->finals().emplace(name->source, DEREF(name->symbol))};
-          if (!pair.second) { // C787
-            Say(name->source,
-                "FINAL subroutine '%s' already appeared in this derived type"_err_en_US,
-                name->source)
-                .Attach(pair.first->first,
-                    "earlier appearance of this FINAL subroutine"_en_US);
-          }
+        Symbol *symbol{FindSymbol(subrName)};
+        if (!symbol) {
+          // FINAL procedures must be module subroutines
+          symbol = &MakeSymbol(
+              currScope().parent(), subrName.source, Attrs{Attr::MODULE});
+          Resolve(subrName, symbol);
+          symbol->set_details(ProcEntityDetails{});
+          symbol->set(Symbol::Flag::Subroutine);
+        }
+        if (auto pair{details->finals().emplace(subrName.source, *symbol)};
+            !pair.second) { // C787
+          Say(subrName.source,
+              "FINAL subroutine '%s' already appeared in this derived type"_err_en_US,
+              subrName.source)
+              .Attach(pair.first->first,
+                  "earlier appearance of this FINAL subroutine"_en_US);
         }
       }
     }
   }
+  return false;
 }
 
 bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
@@ -7266,7 +7273,7 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
-  // Create the symbol then ensure it is accessible
+  // Create the symbol, then ensure that it is accessible
   if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
     Say(name,
         "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,

diff  --git a/flang/test/Semantics/symbol30.f90 b/flang/test/Semantics/symbol30.f90
new file mode 100644
index 00000000000000..0b096cf55cc7fb
--- /dev/null
+++ b/flang/test/Semantics/symbol30.f90
@@ -0,0 +1,19 @@
+! RUN: %python %S/test_symbols.py %s %flang_fc1
+!DEF: /m Module
+module m
+ !DEF: /m/t PUBLIC DerivedType
+ type :: t
+ contains
+  !DEF: /m/forwardreferenced ELEMENTAL, IMPURE, MODULE, PUBLIC (Subroutine) Subprogram
+  final :: forwardreferenced
+ end type
+ interface
+  !REF: /m/forwardreferenced
+  !DEF: /m/forwardreferenced/this INTENT(INOUT) ObjectEntity TYPE(t)
+  impure elemental module subroutine forwardreferenced (this)
+   !REF: /m/t
+   !REF: /m/forwardreferenced/this
+   type(t), intent(inout) :: this
+  end subroutine
+ end interface
+end module