diff options
| -rw-r--r-- | flang/docs/Extensions.md | 5 | ||||
| -rw-r--r-- | flang/lib/Evaluate/type.cpp | 20 |
2 files changed, 22 insertions, 3 deletions
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index a032052..86ac6ae 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -522,3 +522,8 @@ end module or `BLOCK DATA` subprogram to also be the name of an local entity in its scope, with a portability warning, since that global name is not actually capable of being "used" in its scope. + +## De Facto Standard Features + +* `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the + same type, a case that is technically implementation-defined. diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 5b356aa..85e4315 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -371,9 +371,23 @@ std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const { std::optional<bool> DynamicType::ExtendsTypeOf(const DynamicType &that) const { if (IsUnlimitedPolymorphic() || that.IsUnlimitedPolymorphic()) { return std::nullopt; // unknown - } else if (!AreCompatibleDerivedTypes(evaluate::GetDerivedTypeSpec(that), - evaluate::GetDerivedTypeSpec(*this), true)) { - return false; + } + const auto *thisDts{evaluate::GetDerivedTypeSpec(*this)}; + const auto *thatDts{evaluate::GetDerivedTypeSpec(that)}; + if (!thisDts || !thatDts) { + return std::nullopt; + } else if (!AreCompatibleDerivedTypes(thatDts, thisDts, true)) { + // Note that I check *thisDts, not its parent, so that EXTENDS_TYPE_OF() + // is .true. when they are the same type. This is technically + // an implementation-defined case in the standard, but every other + // compiler works this way. + if (IsPolymorphic() && AreCompatibleDerivedTypes(thisDts, thatDts, true)) { + // 'that' is *this or an extension of *this, and so runtime *this + // could be an extension of 'that' + return std::nullopt; + } else { + return false; + } } else if (that.IsPolymorphic()) { return std::nullopt; // unknown } else { |