[flang-commits] [flang] 8dfd883 - [flang] Add ClassIs runtime function

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-11-18T21:17:15+01:00
New Revision: 8dfd883531bf27163aa429daeb9691219875db1c

URL: https://github.com/llvm/llvm-project/commit/8dfd883531bf27163aa429daeb9691219875db1c
DIFF: https://github.com/llvm/llvm-project/commit/8dfd883531bf27163aa429daeb9691219875db1c.diff

LOG: [flang] Add ClassIs runtime function

Add a `ClassIs` function that takes a descriptor and a
type desc to implement the check needed by the CLASS IS type guard
in SELECT TYPE construct.
Since the kind type parameter are directly folded in the type itself
in Flang and the type descriptor is a global, the function just check
if the type descriptor address of the descriptor is equivalent to
the type descriptor address of the global. If not, it check in the
parents of the descriptor's type descriptor.

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D138279

Added: 
    

Modified: 
    flang/include/flang/Runtime/derived-api.h
    flang/runtime/derived-api.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Runtime/derived-api.h b/flang/include/flang/Runtime/derived-api.h
index 515905d6c22cf..5d08694dd58c7 100644
--- a/flang/include/flang/Runtime/derived-api.h
+++ b/flang/include/flang/Runtime/derived-api.h
@@ -20,6 +20,10 @@
 namespace Fortran::runtime {
 class Descriptor;
 
+namespace typeInfo {
+class DerivedType;
+}
+
 extern "C" {
 
 // Initializes and allocates an object's components, if it has a derived type
@@ -38,6 +42,10 @@ void RTNAME(Destroy)(const Descriptor &);
 void RTNAME(Assign)(const Descriptor &, const Descriptor &,
     const char *sourceFile = nullptr, int sourceLine = 0);
 
+// Perform the test of the CLASS IS type guard statement of the SELECT TYPE
+// construct.
+bool RTNAME(ClassIs)(const Descriptor &, const typeInfo::DerivedType &);
+
 } // extern "C"
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_DERIVED_API_H_

diff  --git a/flang/runtime/derived-api.cpp b/flang/runtime/derived-api.cpp
index fa76b963aafb2..5817296b0b1a1 100644
--- a/flang/runtime/derived-api.cpp
+++ b/flang/runtime/derived-api.cpp
@@ -39,6 +39,25 @@ void RTNAME(Destroy)(const Descriptor &descriptor) {
   }
 }
 
+bool RTNAME(ClassIs)(
+    const Descriptor &descriptor, const typeInfo::DerivedType &derivedType) {
+  if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
+    if (const auto *derived{addendum->derivedType()}) {
+      if (derived == &derivedType) {
+        return true;
+      }
+      const typeInfo::DerivedType *parent{derived->GetParentType()};
+      while (parent) {
+        if (parent == &derivedType) {
+          return true;
+        }
+        parent = parent->GetParentType();
+      }
+    }
+  }
+  return false;
+}
+
 // TODO: Assign()
 
 } // extern "C"