Skip to content

Commit 8dfd883

Browse files
committed
[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
1 parent 29016d2 commit 8dfd883

File tree

2 files changed

+27
-0
lines changed

2 files changed

+27
-0
lines changed

flang/include/flang/Runtime/derived-api.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,10 @@
2020
namespace Fortran::runtime {
2121
class Descriptor;
2222

23+
namespace typeInfo {
24+
class DerivedType;
25+
}
26+
2327
extern "C" {
2428

2529
// Initializes and allocates an object's components, if it has a derived type
@@ -38,6 +42,10 @@ void RTNAME(Destroy)(const Descriptor &);
3842
void RTNAME(Assign)(const Descriptor &, const Descriptor &,
3943
const char *sourceFile = nullptr, int sourceLine = 0);
4044

45+
// Perform the test of the CLASS IS type guard statement of the SELECT TYPE
46+
// construct.
47+
bool RTNAME(ClassIs)(const Descriptor &, const typeInfo::DerivedType &);
48+
4149
} // extern "C"
4250
} // namespace Fortran::runtime
4351
#endif // FORTRAN_RUNTIME_DERIVED_API_H_

flang/runtime/derived-api.cpp

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,25 @@ void RTNAME(Destroy)(const Descriptor &descriptor) {
3939
}
4040
}
4141

42+
bool RTNAME(ClassIs)(
43+
const Descriptor &descriptor, const typeInfo::DerivedType &derivedType) {
44+
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
45+
if (const auto *derived{addendum->derivedType()}) {
46+
if (derived == &derivedType) {
47+
return true;
48+
}
49+
const typeInfo::DerivedType *parent{derived->GetParentType()};
50+
while (parent) {
51+
if (parent == &derivedType) {
52+
return true;
53+
}
54+
parent = parent->GetParentType();
55+
}
56+
}
57+
}
58+
return false;
59+
}
60+
4261
// TODO: Assign()
4362

4463
} // extern "C"

0 commit comments

Comments
 (0)