[flang] Fix bugs in .mod file for abstract interface

When an abstract interface is defined, add the ABSTRACT attribute to
subprogram symbols that define the interface body. Make use of that
when writing .mod files to include "abstract" on the interface statement.

Also, fix a problem with the order of symbols in a .mod file. Sometimes
a name is mentioned before the "real" declaration, e.g. in an access
statement. We want the order to be based on the real definitions. In
these cases we replace the symbol name with an identical name with a
different source location. Then by sorting based on the source location
we get symbols in the right order.

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

diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 99ea65b..f8e5889 100644 (file)
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -319,6 +319,10 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
     bindAttrs.set(Attr::BIND_C, true);
     attrs.set(Attr::BIND_C, false);
   }
+  bool isAbstract{attrs.test(Attr::ABSTRACT)};
+  if (isAbstract) {
+    attrs.set(Attr::ABSTRACT, false);
+  }
   Attrs prefixAttrs{subprogramPrefixAttrs & attrs};
   // emit any non-prefix attributes in an attribute statement
   attrs &= ~subprogramPrefixAttrs;
@@ -331,7 +335,7 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
   bool isInterface{details.isInterface()};
   llvm::raw_ostream &os{isInterface ? decls_ : contains_};
   if (isInterface) {
-    os << "interface\n";
+    os << (isAbstract ? "abstract " : "") << "interface\n";
   }
   PutAttrs(os, prefixAttrs, std::nullopt, ""s, " "s);
   os << (details.isFunction() ? "function " : "subroutine ");
@@ -457,6 +461,11 @@ void CollectSymbols(
       }
     }
   }
+  // Sort most symbols by name: use of Symbol::ReplaceName ensures the source
+  // location of a symbol's name is the first "real" use.
+  std::sort(sorted.begin(), sorted.end(), [](SymbolRef x, SymbolRef y) {
+    return x->name().begin() < y->name().begin();
+  });
   sorted.insert(sorted.end(), namelist.begin(), namelist.end());
   for (const auto &pair : scope.commonBlocks()) {
     sorted.push_back(*pair.second);

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 8d52841..73c624a 100644 (file)
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3085,11 +3085,14 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
   symbol->set(subpFlag);
+  symbol->ReplaceName(name.source);
   PushScope(Scope::Kind::Subprogram, symbol);
   auto &details{symbol->get<SubprogramDetails>()};
   if (inInterfaceBlock()) {
     details.set_isInterface();
-    if (!isAbstract()) {
+    if (isAbstract()) {
+      symbol->attrs().set(Attr::ABSTRACT);
+    } else {
       MakeExternal(*symbol);
     }
     if (isGeneric()) {

diff --git a/flang/test/Semantics/modfile10.f90 b/flang/test/Semantics/modfile10.f90
index ef10f1f..996178f 100644 (file)
--- a/flang/test/Semantics/modfile10.f90
+++ b/flang/test/Semantics/modfile10.f90
@@ -90,3 +90,40 @@ end module
 !  subroutine test()
 !  end
 !end
+
+! Ensure the type is emitted before its use
+module m2
+  private s
+  type :: t
+  contains
+    procedure :: foo
+  end type
+  abstract interface
+    subroutine s(x)
+      import
+      type(t) :: x
+    end subroutine
+  end interface
+contains
+  subroutine foo(x)
+    class(t) :: x
+  end subroutine
+end module
+!Expect: m2.mod
+!module m2
+!  type::t
+!  contains
+!    procedure::foo
+!  end type
+!  private::s
+!  abstract interface
+!    subroutine s(x)
+!      import::t
+!      type(t)::x
+!    end
+!  end interface
+!contains
+!  subroutine foo(x)
+!    class(t)::x
+!  end
+!end

diff --git a/flang/test/Semantics/procinterface01.f90 b/flang/test/Semantics/procinterface01.f90
index a960922..dd9fd3b 100644 (file)
--- a/flang/test/Semantics/procinterface01.f90
+++ b/flang/test/Semantics/procinterface01.f90
@@ -5,7 +5,7 @@
 !DEF: /module1 Module
 module module1
  abstract interface
-  !DEF: /module1/abstract1 PUBLIC (Function) Subprogram REAL(4)
+  !DEF: /module1/abstract1 ABSTRACT, PUBLIC (Function) Subprogram REAL(4)
   !DEF: /module1/abstract1/x INTENT(IN) ObjectEntity REAL(4)
   real function abstract1(x)
    !REF: /module1/abstract1/x

diff --git a/flang/test/Semantics/symbol15.f90 b/flang/test/Semantics/symbol15.f90
index ddd3772..cc230ff 100644 (file)
--- a/flang/test/Semantics/symbol15.f90
+++ b/flang/test/Semantics/symbol15.f90
@@ -5,7 +5,7 @@
 module m
  implicit none
  abstract interface
-  !DEF: /m/iface PUBLIC (Subroutine) Subprogram
+  !DEF: /m/iface ABSTRACT, PUBLIC (Subroutine) Subprogram
   subroutine iface
   end subroutine
  end interface