[flang-commits] [flang] 43abd25 - [flang] Fix corner case of defined component assignment (#142201)

[via flang-commits]

Author: Peter Klausler
Date: 2025-06-04T09:22:58-07:00
New Revision: 43abd252db7245a2c3ea9c0c18aa6eb1955eea1a

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

LOG: [flang] Fix corner case of defined component assignment (#142201)

For componentwise assignment in derived type intrinsic assignment, the
runtime type information's special binding table is currently populated
only with type-bound ASSIGNMENT(=) procedures that have the same derived
type for both arguments. This restriction excludes all defined
assignments for cases that cannot arise in this context, like defined
assignments from intrinsic types or incompatible derived types.

However, this restriction also excludes defined assignments from
distinct but compatible derived types, i.e. ancestors. Loosen it a
little to allow them.

Fixes https://github.com/llvm/llvm-project/issues/142151.

Added: 
    

Modified: 
    flang/lib/Semantics/runtime-type-info.cpp
    flang/test/Semantics/typeinfo01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 98295f3705a71..378697237ba9b 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -1121,10 +1121,10 @@ void RuntimeTableBuilder::DescribeSpecialProc(
     int argThatMightBeDescriptor{0};
     MaybeExpr which;
     if (isAssignment) {
-      // Only type-bound asst's with the same type on both dummy arguments
+      // Only type-bound asst's with compatible types on both dummy arguments
       // are germane to the runtime, which needs only these to implement
       // component assignment as part of intrinsic assignment.
-      // Non-type-bound generic INTERFACEs and assignments from distinct
+      // Non-type-bound generic INTERFACEs and assignments from incompatible
       // types must not be used for component intrinsic assignment.
       CHECK(proc->dummyArguments.size() == 2);
       const auto t1{
@@ -1137,8 +1137,12 @@ void RuntimeTableBuilder::DescribeSpecialProc(
               .type.type()};
       if (!binding || t1.category() != TypeCategory::Derived ||
           t2.category() != TypeCategory::Derived ||
-          t1.IsUnlimitedPolymorphic() || t2.IsUnlimitedPolymorphic() ||
-          t1.GetDerivedTypeSpec() != t2.GetDerivedTypeSpec()) {
+          t1.IsUnlimitedPolymorphic() || t2.IsUnlimitedPolymorphic()) {
+        return;
+      }
+      if (!derivedTypeSpec ||
+          !derivedTypeSpec->MatchesOrExtends(t1.GetDerivedTypeSpec()) ||
+          !derivedTypeSpec->MatchesOrExtends(t2.GetDerivedTypeSpec())) {
         return;
       }
       which = proc->IsElemental() ? elementalAssignmentEnum_

diff  --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index c1427f28753cf..d228cd2a84ca4 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -73,7 +73,7 @@ module m06
   end type
   type, extends(t) :: t2
    contains
-    procedure :: s1 => s2 ! override
+    procedure :: s1 => s2
   end type
  contains
   subroutine s1(x, y)
@@ -86,8 +86,37 @@ subroutine s2(x, y)
   end subroutine
 !CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
 !CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
 !CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
+!CHECK: .s.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s2)]
+!CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
+!CHECK: .v.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
+end module
+
+module m06a
+  type :: t
+   contains
+    procedure, pass(y) :: s1
+    generic :: assignment(=) => s1
+  end type
+  type, extends(t) :: t2
+   contains
+    procedure, pass(y) :: s1 => s2
+  end type
+ contains
+  subroutine s1(x, y)
+    class(t), intent(out) :: x
+    class(t), intent(in) :: y
+  end subroutine
+  subroutine s2(x, y)
+    class(t), intent(out) :: x
+    class(t2), intent(in) :: y
+  end subroutine
+!CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=.s.t2,specialbitset=2_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
+!CHECK: .s.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s2)]
 !CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 !CHECK: .v.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
 end module