[flang-commits] [flang] [flang][runtime] Fix odd "invalid descriptor" runtime crash (PR #107785)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sun Sep 8 16:28:58 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/107785
A defined assignment generic interface for a given LHS/RHS type & rank combination may have a specific procedure with LHS dummy argument that is neither allocatable nor pointer, or specific procedure(s) whose LHS dummy arguments are allocatable or pointer. It is possible to have two specific procedures if one's LHS dummy argument is allocatable and the other's is pointer.
However, the runtime doesn't work with LHS dummy arguments that are allocatable, and will crash with a mysterious "invalid descriptor" error message.
Extend the list of special bindings to include ScalarAllocatableAssignment and ScalarPointerAssignment, use them when appropriate in the runtime type information tables, and handle them in Assign() in the runtime support library.
>From c45fafd77e7e00f2d541d15e7019c90b999cd6ba Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sun, 8 Sep 2024 15:57:03 -0700
Subject: [PATCH] [flang][runtime] Fix odd "invalid descriptor" runtime crash
A defined assignment generic interface for a given LHS/RHS type & rank
combination may have a specific procedure with LHS dummy argument
that is neither allocatable nor pointer, or specific procedure(s)
whose LHS dummy arguments are allocatable or pointer. It is possible
to have two specific procedures if one's LHS dummy argument is allocatable
and the other's is pointer.
However, the runtime doesn't work with LHS dummy arguments that
are allocatable, and will crash with a mysterious "invalid descriptor"
error message.
Extend the list of special bindings to include ScalarAllocatableAssignment
and ScalarPointerAssignment, use them when appropriate in the runtime
type information tables, and handle them in Assign() in the runtime
support library.
---
flang/lib/Semantics/expression.cpp | 3 +-
flang/lib/Semantics/runtime-type-info.cpp | 21 +++++++--
flang/module/__fortran_type_info.f90 | 13 +++---
flang/runtime/assign.cpp | 16 +++++--
flang/runtime/descriptor-io.h | 2 +-
flang/runtime/namelist.cpp | 4 +-
flang/runtime/type-info.cpp | 9 +++-
flang/runtime/type-info.h | 20 +++++----
flang/test/Semantics/typeinfo01.f90 | 18 ++++----
flang/test/Semantics/typeinfo02.f90 | 4 +-
flang/test/Semantics/typeinfo04.f90 | 2 +-
flang/test/Semantics/typeinfo12.f90 | 52 +++++++++++++++++++++++
12 files changed, 125 insertions(+), 39 deletions(-)
create mode 100644 flang/test/Semantics/typeinfo12.f90
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 3684839c187e68..50f5cd7f8b2e76 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4605,7 +4605,8 @@ std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
}
for (std::size_t i{0}; !proc && i < actuals_.size(); ++i) {
const Symbol *generic{nullptr};
- if (const Symbol *binding{FindBoundOp(oprName, i, generic, true)}) {
+ if (const Symbol *
+ binding{FindBoundOp(oprName, i, generic, /*isSubroutine=*/true)}) {
if (CheckAccessibleSymbol(scope, DEREF(generic))) {
// ignore inaccessible type-bound ASSIGNMENT(=) generic
} else if (const Symbol *
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 9f3eb5fbe11a15..427a8421aeaf9d 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -149,6 +149,10 @@ class RuntimeTableBuilder {
SomeExpr explicitEnum_; // Value::Genre::Explicit
SomeExpr lenParameterEnum_; // Value::Genre::LenParameter
SomeExpr scalarAssignmentEnum_; // SpecialBinding::Which::ScalarAssignment
+ SomeExpr
+ scalarAllocatableAssignmentEnum_; // SpecialBinding::Which::ScalarAllocatableAssignment
+ SomeExpr
+ scalarPointerAssignmentEnum_; // SpecialBinding::Which::ScalarPointerAssignment
SomeExpr
elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment
SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
@@ -174,6 +178,9 @@ RuntimeTableBuilder::RuntimeTableBuilder(
explicitEnum_{GetEnumValue("explicit")},
lenParameterEnum_{GetEnumValue("lenparameter")},
scalarAssignmentEnum_{GetEnumValue("scalarassignment")},
+ scalarAllocatableAssignmentEnum_{
+ GetEnumValue("scalarallocatableassignment")},
+ scalarPointerAssignmentEnum_{GetEnumValue("scalarpointerassignment")},
elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
readFormattedEnum_{GetEnumValue("readformatted")},
readUnformattedEnum_{GetEnumValue("readunformatted")},
@@ -1122,10 +1129,10 @@ void RuntimeTableBuilder::DescribeSpecialProc(
// Non-type-bound generic INTERFACEs and assignments from distinct
// types must not be used for component intrinsic assignment.
CHECK(proc->dummyArguments.size() == 2);
- const auto t1{
+ const auto &ddo1{
DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
- &proc->dummyArguments[0].u))
- .type.type()};
+ &proc->dummyArguments[0].u))};
+ const auto t1{ddo1.type.type()};
const auto t2{
DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
&proc->dummyArguments[1].u))
@@ -1137,7 +1144,13 @@ void RuntimeTableBuilder::DescribeSpecialProc(
return;
}
which = proc->IsElemental() ? elementalAssignmentEnum_
- : scalarAssignmentEnum_;
+ : ddo1.attrs.test(
+ evaluate::characteristics::DummyDataObject::Attr::Allocatable)
+ ? scalarAllocatableAssignmentEnum_
+ : ddo1.attrs.test(
+ evaluate::characteristics::DummyDataObject::Attr::Pointer)
+ ? scalarPointerAssignmentEnum_
+ : scalarAssignmentEnum_;
if (binding && binding->passName() &&
*binding->passName() == proc->dummyArguments[1].name) {
argThatMightBeDescriptor = 1;
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index 5f2273de1e3d1e..7dfcfe71fcb321 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -106,11 +106,14 @@
end type
enum, bind(c) ! SpecialBinding::Which
- enumerator :: ScalarAssignment = 1, ElementalAssignment = 2
- enumerator :: ReadFormatted = 3, ReadUnformatted = 4
- enumerator :: WriteFormatted = 5, WriteUnformatted = 6
- enumerator :: ElementalFinal = 7, AssumedRankFinal = 8
- enumerator :: ScalarFinal = 9 ! higher-rank final procedures follow
+ enumerator :: ScalarAssignment = 1
+ enumerator :: ScalarAllocatableAssignment = 2
+ enumerator :: ScalarPointerAssignment = 3
+ enumerator :: ElementalAssignment = 4
+ enumerator :: ReadFormatted = 5, ReadUnformatted = 6
+ enumerator :: WriteFormatted = 7, WriteUnformatted = 8
+ enumerator :: ElementalFinal = 9, AssumedRankFinal = 10
+ enumerator :: ScalarFinal = 11 ! higher-rank final procedures follow
end enum
type, bind(c) :: SpecialBinding
diff --git a/flang/runtime/assign.cpp b/flang/runtime/assign.cpp
index d558ada51cd21a..166cf547789211 100644
--- a/flang/runtime/assign.cpp
+++ b/flang/runtime/assign.cpp
@@ -352,6 +352,17 @@ RT_API_ATTRS static void Assign(
// the Assign() is invoked recursively for component-per-component
// assignments.
if (to.rank() == 0) {
+ if (to.IsAllocatable()) {
+ if (const auto *special{toDerived->FindSpecialBinding(typeInfo::
+ SpecialBinding::Which::ScalarAllocatableAssignment)}) {
+ return DoScalarDefinedAssignment(to, from, *special);
+ }
+ } else if (to.IsPointer()) {
+ if (const auto *special{toDerived->FindSpecialBinding(
+ typeInfo::SpecialBinding::Which::ScalarPointerAssignment)}) {
+ return DoScalarDefinedAssignment(to, from, *special);
+ }
+ }
if (const auto *special{toDerived->FindSpecialBinding(
typeInfo::SpecialBinding::Which::ScalarAssignment)}) {
return DoScalarDefinedAssignment(to, from, *special);
@@ -417,9 +428,8 @@ RT_API_ATTRS static void Assign(
StaticDescriptor<maxRank, true, 10 /*?*/> statDesc[2];
Descriptor &toCompDesc{statDesc[0].descriptor()};
Descriptor &fromCompDesc{statDesc[1].descriptor()};
- comp.CreatePointerDescriptor(toCompDesc, to, terminator, toAt);
- comp.CreatePointerDescriptor(
- fromCompDesc, from, terminator, fromAt);
+ comp.CreateTargetDescriptor(toCompDesc, to, terminator, toAt);
+ comp.CreateTargetDescriptor(fromCompDesc, from, terminator, fromAt);
Assign(toCompDesc, fromCompDesc, terminator, nestedFlags);
} else { // Component has intrinsic type; simply copy raw bytes
std::size_t componentByteSize{comp.SizeInBytes(to)};
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index ff5f683c6da52f..66158b4076164f 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -255,7 +255,7 @@ static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io,
// Create a descriptor for the component
StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
Descriptor &desc{statDesc.descriptor()};
- component.CreatePointerDescriptor(
+ component.CreateTargetDescriptor(
desc, origDescriptor, terminator, origSubscripts);
return DescriptorIO<DIR>(io, desc, table);
} else {
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index af092de70f7819..fe26a0d3a6e895 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -362,7 +362,7 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
io.HandleRelativePosition(byteCount); // skip over '('
StaticDescriptor<maxRank, true, 16> staticDesc;
Descriptor &tmpDesc{staticDesc.descriptor()};
- comp->CreatePointerDescriptor(tmpDesc, source, handler);
+ comp->CreateTargetDescriptor(tmpDesc, source, handler);
if (!HandleSubscripts(io, desc, tmpDesc, compName)) {
return false;
}
@@ -370,7 +370,7 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
}
}
if (!createdDesc) {
- comp->CreatePointerDescriptor(desc, source, handler);
+ comp->CreateTargetDescriptor(desc, source, handler);
}
if (source.rank() > 0) {
if (desc.rank() > 0) {
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index cb18c5669b5ffc..531944086c7f74 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -134,7 +134,7 @@ RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
}
}
-RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor,
+RT_API_ATTRS void Component::CreateTargetDescriptor(Descriptor &descriptor,
const Descriptor &container, Terminator &terminator,
const SubscriptValue *subscripts) const {
RUNTIME_CHECK(terminator, genre_ == Genre::Data);
@@ -144,7 +144,6 @@ RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor,
} else {
descriptor.set_base_addr(container.OffsetElement<char>() + offset_);
}
- descriptor.raw().attribute = CFI_attribute_pointer;
}
RT_API_ATTRS const DerivedType *DerivedType::GetParentType() const {
@@ -297,6 +296,12 @@ FILE *SpecialBinding::Dump(FILE *f) const {
case Which::ScalarAssignment:
std::fputs(" ScalarAssignment", f);
break;
+ case Which::ScalarAllocatableAssignment:
+ std::fputs(" ScalarAllocatableAssignment", f);
+ break;
+ case Which::ScalarPointerAssignment:
+ std::fputs(" ScalarPointerAssignment", f);
+ break;
case Which::ElementalAssignment:
std::fputs(" ElementalAssignment", f);
break;
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
index c3f3595e32ef28..51e360cc20b5c8 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -91,7 +91,7 @@ class Component {
// Creates a pointer descriptor from this component description, possibly
// with subscripts
- RT_API_ATTRS void CreatePointerDescriptor(Descriptor &,
+ RT_API_ATTRS void CreateTargetDescriptor(Descriptor &,
const Descriptor &container, Terminator &,
const SubscriptValue * = nullptr) const;
@@ -126,14 +126,16 @@ class SpecialBinding {
enum class Which : std::uint8_t {
None = 0,
ScalarAssignment = 1,
- ElementalAssignment = 2,
- ReadFormatted = 3,
- ReadUnformatted = 4,
- WriteFormatted = 5,
- WriteUnformatted = 6,
- ElementalFinal = 7,
- AssumedRankFinal = 8,
- ScalarFinal = 9,
+ ScalarAllocatableAssignment = 2,
+ ScalarPointerAssignment = 3,
+ ElementalAssignment = 4,
+ ReadFormatted = 5,
+ ReadUnformatted = 6,
+ WriteFormatted = 7,
+ WriteUnformatted = 8,
+ ElementalFinal = 9,
+ AssumedRankFinal = 10,
+ ScalarFinal = 11,
// higher-ranked final procedures follow
};
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 0d381f10b04831..b6f0e2e12ff6fe 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -102,8 +102,8 @@ impure elemental subroutine s1(x, y)
class(t), intent(out) :: x
class(t), intent(in) :: y
end subroutine
-!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=4_4,hasparent=0_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=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
+!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=16_4,hasparent=0_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=4_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
!CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
end module
@@ -125,8 +125,8 @@ impure elemental subroutine s3(x)
subroutine s4(x)
type(t), contiguous :: x(:,:,:)
end subroutine
-!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=7296_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=0_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=1_1,proc=s2),specialbinding(which=12_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=1_1,proc=s4)]
+!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=29184_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=9_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=0_1,proc=s3),specialbinding(which=12_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1),specialbinding(which=13_1,isargdescriptorset=0_1,istypebound=1_1,isargcontiguousset=1_1,proc=s2),specialbinding(which=14_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=1_1,proc=s4)]
end module
module m09
@@ -167,8 +167,8 @@ subroutine wu(x,u,iostat,iomsg)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
end subroutine
-!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=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wu)]
+!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=480_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=6_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=7_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=8_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wu)]
!CHECK: .v.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
end module
@@ -216,8 +216,8 @@ subroutine wu(x,u,iostat,iomsg)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
end subroutine
-!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=120_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
-!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=3_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=4_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wu)]
+!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=480_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=rf),specialbinding(which=6_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=ru),specialbinding(which=7_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wf),specialbinding(which=8_1,isargdescriptorset=0_1,istypebound=0_1,isargcontiguousset=0_1,proc=wu)]
end module
module m11
@@ -260,7 +260,7 @@ module m13
contains
procedure :: assign1, assign2
generic :: assignment(=) => assign1, assign2
- ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=assign1)]
+ ! CHECK: .s.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=4_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=assign1)]
end type
contains
impure elemental subroutine assign1(to, from)
diff --git a/flang/test/Semantics/typeinfo02.f90 b/flang/test/Semantics/typeinfo02.f90
index 29d14c7a0f196b..2b911e7238f881 100644
--- a/flang/test/Semantics/typeinfo02.f90
+++ b/flang/test/Semantics/typeinfo02.f90
@@ -29,5 +29,5 @@ subroutine wf2(x,u,iot,v,iostat,iomsg)
character(len=*), intent(inout) :: iomsg
end subroutine
end module
-!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf1)]
-!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf2)]
+!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf1)]
+!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=1_1,istypebound=1_1,isargcontiguousset=0_1,proc=wf2)]
diff --git a/flang/test/Semantics/typeinfo04.f90 b/flang/test/Semantics/typeinfo04.f90
index de8464321a409e..2527f656da3d1d 100644
--- a/flang/test/Semantics/typeinfo04.f90
+++ b/flang/test/Semantics/typeinfo04.f90
@@ -7,7 +7,7 @@ module m
contains
final :: final
end type
-!CHECK: .dt.finalizable, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.finalizable,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.finalizable,specialbitset=128_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
+!CHECK: .dt.finalizable, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.finalizable,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.finalizable,specialbitset=512_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
type, abstract :: t1
end type
!CHECK: .dt.t1, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t1,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
diff --git a/flang/test/Semantics/typeinfo12.f90 b/flang/test/Semantics/typeinfo12.f90
new file mode 100644
index 00000000000000..eb1792fd74e0f7
--- /dev/null
+++ b/flang/test/Semantics/typeinfo12.f90
@@ -0,0 +1,52 @@
+!RUN: bbc --dump-symbols %s | FileCheck %s
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+
+! Test defined assignment with allocatable / pointer LHS arguments.
+! The special bindings for the defined assignmnts must reflect that
+! their LHS arguments are allocatables and pointers.
+! (This program is executable and should print 1; 102; 3 204.)
+
+module m
+ type :: base
+ integer :: i
+ contains
+ procedure, pass(src) :: ass1, ass2
+ generic :: assignment(=) => ass1, ass2
+ end type base
+ type, extends(base) :: derived
+ end type
+
+!CHECK: .dt.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.base,name=.n.base,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.base,procptr=NULL(),special=.s.base,specialbitset=12_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .dt.derived, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.derived,name=.n.derived,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.derived,procptr=NULL(),special=.s.derived,specialbitset=12_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
+!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:1_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=ass1),specialbinding(which=3_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=ass2)]
+!CHECK: .s.derived, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:1_8 init:[specialbinding::specialbinding(which=2_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=ass1),specialbinding(which=3_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=ass2)]
+
+contains
+ subroutine ass1(res, src)
+ class(base), allocatable, intent(out) :: res
+ class(base), intent(in) :: src
+ allocate(res, source=src)
+ res%i = res%i + 100
+ end subroutine
+ subroutine ass2(res, src)
+ class(base), pointer, intent(in out) :: res
+ class(base), intent(in) :: src
+ allocate(res, source=src)
+ res%i = src%i + 200
+ end subroutine
+end
+program genext
+ use m
+ type(derived) :: od1
+ class(base), allocatable :: od2
+ class(base), pointer :: od3a, od3b
+ od1 = derived(1)
+ print *, od1%i
+ od2 = derived(2)
+ print *, od2%i
+ allocate(od3a)
+ od3a%i = 3
+ od3b => od3a
+ od3b = derived(4)
+ print *, od3a%i, od3b%i
+end program genext
More information about the flang-commits
mailing list