@@ -95,10 +95,16 @@ RT_API_ATTRS std::size_t Component::SizeInBytes(
9595RT_API_ATTRS void Component::EstablishDescriptor (Descriptor &descriptor,
9696 const Descriptor &container, Terminator &terminator) const {
9797 ISO::CFI_attribute_t attribute{static_cast <ISO::CFI_attribute_t>(
98- genre_ == Genre::Allocatable ? CFI_attribute_allocatable
99- : genre_ == Genre::Pointer ? CFI_attribute_pointer
100- : CFI_attribute_other)};
98+ genre_ == Genre::Allocatable || genre_ == Genre::AllocatableDevice
99+ ? CFI_attribute_allocatable
100+ : genre_ == Genre::Pointer || genre_ == Genre::PointerDevice
101+ ? CFI_attribute_pointer
102+ : CFI_attribute_other)};
101103 TypeCategory cat{category ()};
104+ unsigned allocatorIdx{
105+ genre_ == Genre::AllocatableDevice || genre_ == Genre::PointerDevice
106+ ? kDeviceAllocatorPos
107+ : kDefaultAllocator };
102108 if (cat == TypeCategory::Character) {
103109 std::size_t lengthInChars{0 };
104110 if (auto length{characterLen_.GetValue (&container)}) {
@@ -107,19 +113,22 @@ RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
107113 RUNTIME_CHECK (
108114 terminator, characterLen_.genre () == Value::Genre::Deferred);
109115 }
110- descriptor.Establish (
111- kind_, lengthInChars, nullptr , rank_, nullptr , attribute );
116+ descriptor.Establish (kind_, lengthInChars, nullptr , rank_, nullptr ,
117+ attribute, false , allocatorIdx );
112118 } else if (cat == TypeCategory::Derived) {
113119 if (const DerivedType * type{derivedType ()}) {
114- descriptor.Establish (*type, nullptr , rank_, nullptr , attribute);
120+ descriptor.Establish (
121+ *type, nullptr , rank_, nullptr , attribute, allocatorIdx);
115122 } else { // unlimited polymorphic
116123 descriptor.Establish (TypeCode{TypeCategory::Derived, 0 }, 0 , nullptr ,
117- rank_, nullptr , attribute, true );
124+ rank_, nullptr , attribute, true , allocatorIdx );
118125 }
119126 } else {
120- descriptor.Establish (cat, kind_, nullptr , rank_, nullptr , attribute);
127+ descriptor.Establish (
128+ cat, kind_, nullptr , rank_, nullptr , attribute, false , allocatorIdx);
121129 }
122- if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) {
130+ if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer &&
131+ genre_ != Genre::AllocatableDevice && genre_ != Genre::PointerDevice) {
123132 const typeInfo::Value *boundValues{bounds ()};
124133 RUNTIME_CHECK (terminator, boundValues != nullptr );
125134 auto byteStride{static_cast <SubscriptValue>(descriptor.ElementBytes ())};
@@ -267,13 +276,17 @@ FILE *Component::Dump(FILE *f) const {
267276 std::fputs (" name: " , f);
268277 DumpScalarCharacter (f, name (), " Component::name" );
269278 if (genre_ == Genre::Data) {
270- std::fputs (" Data " , f);
279+ std::fputs (" Data " , f);
271280 } else if (genre_ == Genre::Pointer) {
272- std::fputs (" Pointer " , f);
281+ std::fputs (" Pointer " , f);
282+ } else if (genre_ == Genre::PointerDevice) {
283+ std::fputs (" PointerDevice " , f);
273284 } else if (genre_ == Genre::Allocatable) {
274- std::fputs (" Allocatable" , f);
285+ std::fputs (" Allocatable. " , f);
286+ } else if (genre_ == Genre::AllocatableDevice) {
287+ std::fputs (" AllocatableDevice" , f);
275288 } else if (genre_ == Genre::Automatic) {
276- std::fputs (" Automatic " , f);
289+ std::fputs (" Automatic " , f);
277290 } else {
278291 std::fprintf (f, " (bad genre 0x%x)" , static_cast <int >(genre_));
279292 }
0 commit comments