diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 3684839c187e6..50f5cd7f8b2e7 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -4605,7 +4605,8 @@ std::optional 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 9f3eb5fbe11a1..427a8421aeaf9 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( - &proc->dummyArguments[0].u)) - .type.type()}; + &proc->dummyArguments[0].u))}; + const auto t1{ddo1.type.type()}; const auto t2{ DEREF(std::get_if( &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 5f2273de1e3d1..7dfcfe71fcb32 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 d558ada51cd21..166cf54778921 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 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 ff5f683c6da52..66158b4076164 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 statDesc; Descriptor &desc{statDesc.descriptor()}; - component.CreatePointerDescriptor( + component.CreateTargetDescriptor( desc, origDescriptor, terminator, origSubscripts); return DescriptorIO(io, desc, table); } else { diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp index af092de70f781..fe26a0d3a6e89 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 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 cb18c5669b5ff..531944086c7f7 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() + 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 c3f3595e32ef2..340971bfacf3e 100644 --- a/flang/runtime/type-info.h +++ b/flang/runtime/type-info.h @@ -89,9 +89,9 @@ class Component { RT_API_ATTRS void EstablishDescriptor( Descriptor &, const Descriptor &container, Terminator &) const; - // Creates a pointer descriptor from this component description, possibly + // Creates a 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 0d381f10b0483..b6f0e2e12ff6f 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 29d14c7a0f196..2b911e7238f88 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 de8464321a409..2527f656da3d1 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 0000000000000..983e09be0055b --- /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 assignments 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