[flang-commits] [PATCH] D140141: [flang][runtime] Allow CLASS(*) components when creating descriptors

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: clementval.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

Extend the descriptor creation function for components to allow
unlimited polymorphic components (CLASS(*)) and to also properly set
the attributes of the established descriptors.


https://reviews.llvm.org/D140141

Files:
  flang/runtime/type-info.cpp


Index: flang/runtime/type-info.cpp
===================================================================
--- flang/runtime/type-info.cpp
+++ flang/runtime/type-info.cpp
@@ -87,6 +87,10 @@
 
 void Component::EstablishDescriptor(Descriptor &descriptor,
     const Descriptor &container, Terminator &terminator) const {
+  ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>(
+      genre_ == Genre::Allocatable   ? CFI_attribute_allocatable
+          : genre_ == Genre::Pointer ? CFI_attribute_pointer
+                                     : CFI_attribute_other)};
   TypeCategory cat{category()};
   if (cat == TypeCategory::Character) {
     std::size_t lengthInChars{0};
@@ -96,13 +100,17 @@
       RUNTIME_CHECK(
           terminator, characterLen_.genre() == Value::Genre::Deferred);
     }
-    descriptor.Establish(kind_, lengthInChars, nullptr, rank_);
+    descriptor.Establish(
+        kind_, lengthInChars, nullptr, rank_, nullptr, attribute);
   } else if (cat == TypeCategory::Derived) {
-    const DerivedType *type{derivedType()};
-    RUNTIME_CHECK(terminator, type != nullptr);
-    descriptor.Establish(*type, nullptr, rank_);
+    if (const DerivedType *type{derivedType()}) {
+      descriptor.Establish(*type, nullptr, rank_, nullptr, attribute);
+    } else { // unlimited polymorphic
+      descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,
+          rank_, nullptr, attribute, true);
+    }
   } else {
-    descriptor.Establish(cat, kind_, nullptr, rank_);
+    descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute);
   }
   if (rank_ && genre_ != Genre::Allocatable) {
     const typeInfo::Value *boundValues{bounds()};


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D140141.483267.patch
Type: text/x-patch
Size: 1693 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221215/32405c8a/attachment.bin>