[flang] Preserve order of type parameters

Type parameters were sorted by the order of the type-param-def-stmts.
But we need to preserve the order of the type-param-name-list.
The is the order of positional parameters in a derived-type-spec.

So add `paramNames` to `DerivedTypeDetails` to preserve the original
order. Using this allows us to write module files with both the
type-param-name-list and type-param-def-stmts in the original order.

Also fix a bug where a duplicate type-param-def caused a spurious
extra error. If `MakeTypeSymbol()` reports an error we should not
call `SetType()` because it will just report another error.

Original-commit: flang-compiler/f18@3ca55b63333db3d779fe263583e3cb9fe7f4b2b1
Reviewed-on: https://github.com/flang-compiler/f18/pull/239

diff --git a/flang/lib/semantics/mod-file.cc b/flang/lib/semantics/mod-file.cc
index 452ab1c..d959d86 100644 (file)
--- a/flang/lib/semantics/mod-file.cc
+++ b/flang/lib/semantics/mod-file.cc
@@ -176,14 +176,12 @@ void ModFileWriter::PutDerivedType(const Symbol &typeSymbol) {
   }
   PutLower(decls_ << "::", typeSymbol);
   auto &typeScope{*typeSymbol.scope()};
-  if (details.hasTypeParams()) {
+  if (!details.paramNames().empty()) {
     bool first{true};
     decls_ << '(';
-    for (const auto *symbol : CollectSymbols(typeScope)) {
-      if (symbol->has<TypeParamDetails>()) {
-        PutLower(first ? decls_ : decls_ << ',', *symbol);
-        first = false;
-      }
+    for (const auto &name : details.paramNames()) {
+      PutLower(first ? decls_ : decls_ << ',', name.ToString());
+      first = false;
     }
     decls_ << ')';
   }

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 5dec603..b139e23 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -649,7 +649,7 @@ private:
   const Symbol *ResolveDerivedType(const parser::Name &);
   bool CanBeTypeBoundProc(const Symbol &);
   Symbol *FindExplicitInterface(const parser::Name &);
-  Symbol &MakeTypeSymbol(const parser::Name &, Details &&);
+  bool MakeTypeSymbol(const parser::Name &, Details &&);
   bool OkToAddComponent(const parser::Name &, bool isParentComp = false);
 
   // Declare an object or procedure entity.
@@ -2384,8 +2384,10 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeSpec &x) {
 void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
   std::set<SourceName> paramNames;
   auto &scope{currScope()};
+  auto &details{scope.symbol()->get<DerivedTypeDetails>()};
   auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
   for (auto &paramName : std::get<std::list<parser::Name>>(stmt.statement.t)) {
+    details.add_paramName(paramName.source);
     auto *symbol{FindInScope(scope, paramName)};
     if (!symbol) {
       Say(paramName,
@@ -2399,8 +2401,6 @@ void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
           "Duplicate type parameter name: '%s'"_err_en_US);  // C731
     }
   }
-  auto &details{scope.symbol()->get<DerivedTypeDetails>()};
-  details.set_hasTypeParams(!paramNames.empty());
   for (const auto &[name, symbol] : currScope()) {
     if (symbol->has<TypeParamDetails>() && !paramNames.count(name)) {
       SayDerivedType(name,
@@ -2414,7 +2414,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
       Say(stmt.source,
           "A sequence type may not have the EXTENDS attribute"_err_en_US);  // C735
     }
-    if (details.hasTypeParams()) {
+    if (!details.paramNames().empty()) {
       Say(stmt.source,
           "A sequence type may not have type parameters"_err_en_US);  // C740
     }
@@ -2460,8 +2460,9 @@ void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
             std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)}) {
       details.set_init(EvaluateExpr(*init));
     }
-    MakeTypeSymbol(name, std::move(details));
-    SetType(name, *type);
+    if (MakeTypeSymbol(name, std::move(details))) {
+      SetType(name, *type);
+    }
   }
   EndDecl();
 }
@@ -2717,8 +2718,8 @@ Symbol *DeclarationVisitor::FindExplicitInterface(const parser::Name &name) {
 }
 
 // Create a symbol for a type parameter, component, or procedure binding in
-// the current derived type scope.
-Symbol &DeclarationVisitor::MakeTypeSymbol(
+// the current derived type scope. Return false on error.
+bool DeclarationVisitor::MakeTypeSymbol(
     const parser::Name &name, Details &&details) {
   Scope &derivedType{currScope()};
   CHECK(derivedType.kind() == Scope::Kind::DerivedType);
@@ -2727,7 +2728,7 @@ Symbol &DeclarationVisitor::MakeTypeSymbol(
         "Type parameter, component, or procedure binding '%s'"
         " already defined in this type"_err_en_US,
         *symbol, "Previous definition of '%s'"_en_US);
-    return *symbol;
+    return false;
   } else {
     auto attrs{GetAttrs()};
     // Apply binding-private-stmt if present and this is a procedure binding
@@ -2736,7 +2737,8 @@ Symbol &DeclarationVisitor::MakeTypeSymbol(
         std::holds_alternative<ProcBindingDetails>(details)) {
       attrs.set(Attr::PRIVATE);
     }
-    return MakeSymbol(name, attrs, details);
+    MakeSymbol(name, attrs, details);
+    return true;
   }
 }
 

diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h
index ac16c6f..f6e6c0d 100644 (file)
--- a/flang/lib/semantics/symbol.h
+++ b/flang/lib/semantics/symbol.h
@@ -160,15 +160,15 @@ private:
 
 class DerivedTypeDetails {
 public:
-  bool hasTypeParams() const { return hasTypeParams_; }
+  const std::list<SourceName> &paramNames() const { return paramNames_; }
   const Symbol *extends() const { return extends_; }
   bool sequence() const { return sequence_; }
-  void set_hasTypeParams(bool x = true) { hasTypeParams_ = x; }
+  void add_paramName(const SourceName &name) { paramNames_.emplace_back(name); }
   void set_extends(const Symbol *extends) { extends_ = extends; }
   void set_sequence(bool x = true) { sequence_ = x; }
 
 private:
-  bool hasTypeParams_{false};
+  std::list<SourceName> paramNames_;
   const Symbol *extends_{nullptr};
   bool sequence_{false};
 };

diff --git a/flang/test/semantics/modfile12.f90 b/flang/test/semantics/modfile12.f90
index 8534ab8..8c08970 100644 (file)
--- a/flang/test/semantics/modfile12.f90
+++ b/flang/test/semantics/modfile12.f90
@@ -24,6 +24,11 @@ module m
   type(t(a+3,:)), allocatable :: z
   real*2 :: f
   complex*32 :: g
+  type t2(i, j, h)
+    integer, len :: h
+    integer, kind :: j
+    integer, len :: i
+  end type
 contains
   subroutine foo(x)
     real :: x(2:)
@@ -49,6 +54,11 @@ end
 !  type(t(4_4,:)),allocatable::z
 !  real(2)::f
 !  complex(16)::g
+!  type::t2(i,j,h)
+!    integer(4),len::h
+!    integer(4),kind::j
+!    integer(4),len::i
+!  end type
 !contains
 !  subroutine foo(x)
 !    real(4)::x(2_4:)

diff --git a/flang/test/semantics/resolve33.f90 b/flang/test/semantics/resolve33.f90
index 929d9f9..f5bc58b 100644 (file)
--- a/flang/test/semantics/resolve33.f90
+++ b/flang/test/semantics/resolve33.f90
@@ -35,4 +35,10 @@ module m
     !ERROR: 'd' is not a type parameter of this derived type
     integer(8), len :: d
   end type
+  type t5(a, b)
+    integer, len :: a
+    integer, len :: b
+    !ERROR: Type parameter, component, or procedure binding 'a' already defined in this type
+    integer, len :: a
+  end type
 end module