diff --git a/flang/include/flang/Runtime/derived-api.h b/flang/include/flang/Runtime/derived-api.h --- 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(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 --- a/flang/runtime/derived-api.cpp +++ b/flang/runtime/derived-api.cpp @@ -39,6 +39,25 @@ } } +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"