mirror of
https://github.com/llvm/llvm-project.git
synced 2025-04-26 02:56:08 +00:00
8dfd883531
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
65 lines
1.8 KiB
C++
65 lines
1.8 KiB
C++
//===-- runtime/derived-api.cpp
|
|
//-----------------------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Runtime/derived-api.h"
|
|
#include "derived.h"
|
|
#include "terminator.h"
|
|
#include "type-info.h"
|
|
#include "flang/Runtime/descriptor.h"
|
|
|
|
namespace Fortran::runtime {
|
|
|
|
extern "C" {
|
|
|
|
void RTNAME(Initialize)(
|
|
const Descriptor &descriptor, const char *sourceFile, int sourceLine) {
|
|
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
|
|
if (const auto *derived{addendum->derivedType()}) {
|
|
if (!derived->noInitializationNeeded()) {
|
|
Terminator terminator{sourceFile, sourceLine};
|
|
Initialize(descriptor, *derived, terminator);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
void RTNAME(Destroy)(const Descriptor &descriptor) {
|
|
if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
|
|
if (const auto *derived{addendum->derivedType()}) {
|
|
if (!derived->noDestructionNeeded()) {
|
|
Destroy(descriptor, true, *derived);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
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"
|
|
} // namespace Fortran::runtime
|