[flang-commits] [flang] [flang] Ensure overrides of special procedures (PR #142465)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/142465

>From a331f8c361bdf1f25c1e7e9d71f9dc4524faa8f4 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 2 Jun 2025 12:32:57 -0700
Subject: [PATCH] [flang] Ensure overrides of special procedures

When a derived type declares a generic procedure binding of
interest to the runtime library, such as for ASSIGNMENT(=), it
overrides any binding that might have been present for the
parent type.

Fixes https://github.com/llvm/llvm-project/issues/142414.
---
 flang/lib/Semantics/runtime-type-info.cpp |  4 ++--
 flang/test/Lower/namelist.f90             | 12 +++++------
 flang/test/Semantics/typeinfo13.f90       | 26 +++++++++++++++++++++++
 3 files changed, 34 insertions(+), 8 deletions(-)
 create mode 100644 flang/test/Semantics/typeinfo13.f90

diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 98295f3705a71..15dfd0401d980 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -1061,7 +1061,7 @@ RuntimeTableBuilder::DescribeSpecialGenerics(const Scope &dtScope,
     specials =
         DescribeSpecialGenerics(*parentScope, thisScope, derivedTypeSpec);
   }
-  for (auto pair : dtScope) {
+  for (const auto &pair : dtScope) {
     const Symbol &symbol{*pair.second};
     if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
       DescribeSpecialGeneric(*generic, specials, thisScope, derivedTypeSpec);
@@ -1235,7 +1235,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
     AddValue(values, specialSchema_, procCompName,
         SomeExpr{evaluate::ProcedureDesignator{specific}});
     // index might already be present in the case of an override
-    specials.emplace(*index,
+    specials.insert_or_assign(*index,
         evaluate::StructureConstructor{
             DEREF(specialSchema_.AsDerived()), std::move(values)});
   }
diff --git a/flang/test/Lower/namelist.f90 b/flang/test/Lower/namelist.f90
index ea97a0957c35b..dc8a65308aa26 100644
--- a/flang/test/Lower/namelist.f90
+++ b/flang/test/Lower/namelist.f90
@@ -125,20 +125,20 @@ subroutine global_pointer
 
 module mmm
   real rrr
-  namelist /aaa/ rrr
+  namelist /jkl/ rrr
 end
 
 ! CHECK-LABEL: c.func @_QPrename_sub
 subroutine rename_sub
-  use mmm, bbb => aaa
+  use mmm, ghi => jkl
   rrr = 3.
   ! CHECK:     %[[V_4:[0-9]+]] = fir.call @_FortranAioBeginExternalListOutput
-  ! CHECK:     %[[V_5:[0-9]+]] = fir.address_of(@_QMmmmNaaa) : !fir.ref<tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>>
+  ! CHECK:     %[[V_5:[0-9]+]] = fir.address_of(@_QMmmmNjkl) : !fir.ref<tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>>
   ! CHECK:     %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (!fir.ref<tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>>) -> !fir.ref<tuple<>>
   ! CHECK:     %[[V_7:[0-9]+]] = fir.call @_FortranAioOutputNamelist(%[[V_4]], %[[V_6]]) fastmath<contract> : (!fir.ref<i8>, !fir.ref<tuple<>>) -> i1
   ! CHECK:     %[[V_8:[0-9]+]] = fir.call @_FortranAioEndIoStatement(%[[V_4]]) fastmath<contract> : (!fir.ref<i8>) -> i32
-  write(*,bbb)
+  write(*,ghi)
 end
 
-! CHECK-NOT:   bbb
-! CHECK:       fir.string_lit "aaa\00"(4) : !fir.char<1,4>
+! CHECK-NOT:   ghi
+! CHECK:       fir.string_lit "jkl\00"(4) : !fir.char<1,4>
diff --git a/flang/test/Semantics/typeinfo13.f90 b/flang/test/Semantics/typeinfo13.f90
new file mode 100644
index 0000000000000..cf4abf9e38181
--- /dev/null
+++ b/flang/test/Semantics/typeinfo13.f90
@@ -0,0 +1,26 @@
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+!Ensure ASSIGNMENT(=) overrides are applied to the special procedures table.
+module m
+  type base
+   contains
+    procedure :: baseAssign
+    generic :: assignment(=) => baseAssign
+  end type
+  type, extends(base) :: child
+   contains
+    procedure :: override
+    generic :: assignment(=) => override
+  end type
+ contains
+  impure elemental subroutine baseAssign(to, from)
+    class(base), intent(out) :: to
+    type(base), intent(in) :: from
+  end
+  impure elemental subroutine override(to, from)
+    class(child), intent(out) :: to
+    type(child), intent(in) :: from
+  end
+end
+
+!CHECK: .s.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=override)]
+!CHECK: .v.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=baseassign,name=.n.baseassign),binding(proc=override,name=.n.override)]