diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h index ee83d9fc04f3b..71be7906d2fe2 100644 --- a/flang/include/flang/Evaluate/constant.h +++ b/flang/include/flang/Evaluate/constant.h @@ -186,6 +186,8 @@ class Constant> : public ConstantBounds { const Scalar &values() const { return values_; } ConstantSubscript LEN() const { return length_; } + bool wasHollerith() const { return wasHollerith_; } + void set_wasHollerith(bool yes = true) { wasHollerith_ = yes; } std::optional> GetScalarValue() const { if (Rank() == 0) { @@ -210,6 +212,7 @@ class Constant> : public ConstantBounds { private: Scalar values_; // one contiguous string ConstantSubscript length_; + bool wasHollerith_{false}; }; class StructureConstructor; diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 3adbd7cc41774..d625f8c2f7fc1 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -332,7 +332,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, bool typesCompatible{typesCompatibleWithIgnoreTKR || dummy.type.type().IsTkCompatibleWith(actualType.type())}; int dummyRank{dummy.type.Rank()}; - if (!typesCompatible && dummyRank == 0 && allowActualArgumentConversions) { + if (typesCompatible) { + if (const auto *constantChar{ + evaluate::UnwrapConstantValue(actual)}; + constantChar && constantChar->wasHollerith() && + dummy.type.type().IsUnlimitedPolymorphic()) { + messages.Say( + "passing Hollerith to unlimited polymorphic as if it were CHARACTER"_port_en_US); + } + } else if (dummyRank == 0 && allowActualArgumentConversions) { // Extension: pass Hollerith literal to scalar as if it had been BOZ if (auto converted{evaluate::HollerithToBOZ( foldingContext, actual, dummy.type.type())}) { diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 54bfe0f2e1563..1015a9e6efcef 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -875,8 +875,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CharLiteralConstant &x) { MaybeExpr ExpressionAnalyzer::Analyze( const parser::HollerithLiteralConstant &x) { int kind{GetDefaultKind(TypeCategory::Character)}; - auto value{x.v}; - return AnalyzeString(std::move(value), kind); + auto result{AnalyzeString(std::string{x.v}, kind)}; + if (auto *constant{UnwrapConstantValue(result)}) { + constant->set_wasHollerith(true); + } + return result; } // .TRUE. and .FALSE. of various kinds diff --git a/flang/test/Semantics/call41.f90 b/flang/test/Semantics/call41.f90 new file mode 100644 index 0000000000000..a4c7514d99ba5 --- /dev/null +++ b/flang/test/Semantics/call41.f90 @@ -0,0 +1,12 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror +module m + contains + subroutine unlimited(x) + class(*), intent(in) :: x + end + subroutine test + !PORTABILITY: passing Hollerith to unlimited polymorphic as if it were CHARACTER + call unlimited(6HHERMAN) + call unlimited('abc') ! ok + end +end