From 8a326cb7f7ad08fa5124fa5fc65a577adf70d6bb Mon Sep 17 00:00:00 2001 From: peter klausler Date: Wed, 5 Jun 2019 15:40:59 -0700 Subject: [PATCH] [flang] Interpret intrinsic table more correctly Original-commit: flang-compiler/f18@ff34f32447a8675caeae5c96549f1659c3a98ec3 Reviewed-on: https://github.com/flang-compiler/f18/pull/488 Tree-same-pre-rewrite: false --- flang/documentation/Extensions.md | 7 +++ flang/lib/evaluate/characteristics.h | 5 ++ flang/lib/evaluate/intrinsics.cc | 96 ++++++++++++++++++++++++------------ flang/test/evaluate/intrinsics.cc | 16 +++--- 4 files changed, 85 insertions(+), 39 deletions(-) diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md index d11d515..138dacf 100644 --- a/flang/documentation/Extensions.md +++ b/flang/documentation/Extensions.md @@ -98,3 +98,10 @@ Extensions and legacy features deliberately not supported * Use of host FORMAT labels in internal subprograms (PGI-only feature) * ALLOCATE(TYPE(derived)::...) as variant of correct ALLOCATE(derived::...) (PGI only) * USE association of a procedure interface within that same procedure's definition +* After "TYPE,EXTENDS(T1)::T2;...", the nonstandard structure constructor + T2(T1(x)) is accepted by PGI/GNU/Intel. Use T2(T1=T1(x)) or T2(x) instead. +* NULL() as a structure constructor expression for an ALLOCATABLE component (PGI). +* Conversion of LOGICAL to INTEGER. +* IF (integer expression) THEN ... END IF (PGI/Intel) +* Comparsion of LOGICAL with ==/.EQ. rather than .EQV. (also .NEQV.) (PGI/Intel) +* Procedure pointers in COMMON blocks (PGI/Intel) diff --git a/flang/lib/evaluate/characteristics.h b/flang/lib/evaluate/characteristics.h index 7d8757c..4b60a0f 100644 --- a/flang/lib/evaluate/characteristics.h +++ b/flang/lib/evaluate/characteristics.h @@ -52,6 +52,10 @@ public: DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(TypeAndShape) DynamicType type() const { return type_; } + TypeAndShape &set_type(DynamicType t) { + type_ = t; + return *this; + } const Shape &shape() const { return shape_; } bool operator==(const TypeAndShape &) const; @@ -159,6 +163,7 @@ struct FunctionResult { const TypeAndShape *GetTypeAndShape() const { return std::get_if(&u); } + void SetType(DynamicType t) { std::get(u).set_type(t); } std::ostream &Dump(std::ostream &) const; diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index af76032..2586db0 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -641,6 +641,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ struct SpecificIntrinsicInterface : public IntrinsicInterface { const char *generic{nullptr}; bool isRestrictedSpecific{false}; + bool forceResultType{false}; }; static const SpecificIntrinsicInterface specificIntrinsicFunction[]{ @@ -654,22 +655,22 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{ {{"a1", DefaultInt}, {"a2", DefaultInt}, {"a3", DefaultInt, Rank::elemental, Optionality::repeats}}, DefaultReal}, - "max", true}, + "max", true, true}, {{"amax1", {{"a1", DefaultReal}, {"a2", DefaultReal}, {"a3", DefaultReal, Rank::elemental, Optionality::repeats}}, DefaultReal}, - "max", true}, + "max", true, true}, {{"amin0", {{"a1", DefaultInt}, {"a2", DefaultInt}, {"a3", DefaultInt, Rank::elemental, Optionality::repeats}}, DefaultReal}, - "min", true}, + "min", true, true}, {{"amin1", {{"a1", DefaultReal}, {"a2", DefaultReal}, {"a3", DefaultReal, Rank::elemental, Optionality::repeats}}, DefaultReal}, - "min", true}, + "min", true, true}, {{"amod", {{"a", DefaultReal}, {"p", DefaultReal}}, DefaultReal}, "mod"}, {{"anint", {{"a", DefaultReal}}, DefaultReal}}, {{"asin", {{"x", DefaultReal}}, DefaultReal}}, @@ -736,28 +737,36 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{ {{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"}, {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt, Rank::scalar}}, + {{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}}, + DefaultLogical}}, + {{"lgt", {{"string_a", DefaultChar}, {"string_b", DefaultChar}}, + DefaultLogical}}, + {{"lle", {{"string_a", DefaultChar}, {"string_b", DefaultChar}}, + DefaultLogical}}, + {{"llt", {{"string_a", DefaultChar}, {"string_b", DefaultChar}}, + DefaultLogical}}, {{"log", {{"x", DefaultReal}}, DefaultReal}}, {{"log10", {{"x", DefaultReal}}, DefaultReal}}, {{"max0", {{"a1", DefaultInt}, {"a2", DefaultInt}, {"a3", DefaultInt, Rank::elemental, Optionality::repeats}}, DefaultInt}, - "max", true}, + "max", true, true}, {{"max1", {{"a1", DefaultReal}, {"a2", DefaultReal}, {"a3", DefaultReal, Rank::elemental, Optionality::repeats}}, DefaultInt}, - "max", true}, + "max", true, true}, {{"min0", {{"a1", DefaultInt}, {"a2", DefaultInt}, {"a3", DefaultInt, Rank::elemental, Optionality::repeats}}, DefaultInt}, - "min", true}, + "min", true, true}, {{"min1", {{"a1", DefaultReal}, {"a2", DefaultReal}, {"a3", DefaultReal, Rank::elemental, Optionality::repeats}}, DefaultInt}, - "min", true}, + "min", true, true}, {{"mod", {{"a", DefaultInt}, {"p", DefaultInt}}, DefaultInt}}, {{"nint", {{"a", DefaultReal}}, DefaultInt}}, {{"sign", {{"a", DefaultReal}, {"b", DefaultReal}}, DefaultReal}}, @@ -1396,31 +1405,12 @@ std::optional IntrinsicProcTable::Implementation::Probe( } return result; } - // Probe the specific intrinsic function table first. - parser::Messages localBuffer, specificBuffer; + // Probe the generic intrinsic function table first. + parser::Messages localBuffer; parser::ContextualMessages localMessages{ call.name, finalBuffer ? &localBuffer : nullptr}; FoldingContext localContext{context, localMessages}; std::string name{call.name.ToString()}; - auto specificRange{specificFuncs_.equal_range(name)}; - for (auto iter{specificRange.first}; iter != specificRange.second; ++iter) { - CHECK(localBuffer.empty()); - if (auto specificCall{ - iter->second->Match(call, defaults_, arguments, localContext)}) { - if (const char *genericName{iter->second->generic}) { - specificCall->specificIntrinsic.name = genericName; - } - specificCall->specificIntrinsic.isRestrictedSpecific = - iter->second->isRestrictedSpecific; - if (finalBuffer != nullptr) { - finalBuffer->Annex(std::move(localBuffer)); - } - return specificCall; - } else { - specificBuffer.Annex(std::move(localBuffer)); - } - } - // Probe the generic intrinsic function table next. parser::Messages genericBuffer; auto genericRange{genericFuncs_.equal_range(name)}; for (auto iter{genericRange.first}; iter != genericRange.second; ++iter) { @@ -1450,12 +1440,54 @@ std::optional IntrinsicProcTable::Implementation::Probe( genericBuffer.Annex(std::move(localBuffer)); } } + // Probe the specific intrinsic function table next. + // Each specific intrinsic maps to a generic intrinsic. + parser::Messages specificBuffer; + auto specificRange{specificFuncs_.equal_range(name)}; + for (auto specIter{specificRange.first}; specIter != specificRange.second; + ++specIter) { + // We only need to check the cases with distinct generic names. + if (const char *genericName{specIter->second->generic}) { + auto genericRange{genericFuncs_.equal_range(genericName)}; + for (auto genIter{genericRange.first}; genIter != genericRange.second; + ++genIter) { + CHECK(localBuffer.empty()); + if (auto specificCall{genIter->second->Match( + call, defaults_, arguments, localContext)}) { + specificCall->specificIntrinsic.name = genericName; + specificCall->specificIntrinsic.isRestrictedSpecific = + specIter->second->isRestrictedSpecific; + if (finalBuffer != nullptr) { + finalBuffer->Annex(std::move(localBuffer)); + } + if (specIter->second->forceResultType) { + // Force the result type on AMAX0/1, MIN0/1, &c. + TypeCategory category{TypeCategory::Integer}; + switch (specIter->second->result.kindCode) { + case KindCode::defaultIntegerKind: break; + case KindCode::defaultRealKind: + category = TypeCategory::Real; + break; + default: CRASH_NO_CASE; + } + DynamicType newType{category, defaults_.GetDefaultKind(category)}; + specificCall->specificIntrinsic.characteristics.value() + .functionResult.value() + .SetType(newType); + } + return specificCall; + } else { + specificBuffer.Annex(std::move(localBuffer)); + } + } + } + } // No match; report the right errors, if any if (finalBuffer != nullptr) { - if (genericBuffer.empty()) { - finalBuffer->Annex(std::move(specificBuffer)); - } else { + if (specificBuffer.empty()) { finalBuffer->Annex(std::move(genericBuffer)); + } else { + finalBuffer->Annex(std::move(specificBuffer)); } } return std::nullopt; diff --git a/flang/test/evaluate/intrinsics.cc b/flang/test/evaluate/intrinsics.cc index 27503fd..0bb494a 100644 --- a/flang/test/evaluate/intrinsics.cc +++ b/flang/test/evaluate/intrinsics.cc @@ -200,21 +200,23 @@ void TestIntrinsics() { TestCall{table, "abs"}.Push(Const(Scalar{})).DoCall(); TestCall{table, "abs"}.Push(Const(Scalar{})).DoCall(); - TestCall maxCall{table, "max"}, max0Call{table, "max0"}, - max1Call{table, "max1"}; - TestCall amin0Call{table, "amin0"}, amin1Call{table, "amin1"}; + TestCall maxCallR{table, "max"}, maxCallI{table, "min"}, + max0Call{table, "max0"}, max1Call{table, "max1"}, + amin0Call{table, "amin0"}, amin1Call{table, "amin1"}; for (int j{0}; j < 10; ++j) { - maxCall.Push(Const(Scalar{})); + maxCallR.Push(Const(Scalar{})); + maxCallI.Push(Const(Scalar{})); max0Call.Push(Const(Scalar{})); max1Call.Push(Const(Scalar{})); amin0Call.Push(Const(Scalar{})); amin1Call.Push(Const(Scalar{})); } - maxCall.DoCall(Real4::GetType()); - max0Call.DoCall(); + maxCallR.DoCall(Real4::GetType()); + maxCallI.DoCall(Int4::GetType()); + max0Call.DoCall(Int4::GetType()); max1Call.DoCall(Int4::GetType()); amin0Call.DoCall(Real4::GetType()); - amin1Call.DoCall(); + amin1Call.DoCall(Real4::GetType()); // TODO: test other intrinsics } -- 2.7.4