Index: flang/include/flang/Evaluate/characteristics.h =================================================================== --- flang/include/flang/Evaluate/characteristics.h +++ flang/include/flang/Evaluate/characteristics.h @@ -144,8 +144,8 @@ int Rank() const { return GetRank(shape_); } bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that, const char *thisIs = "pointer", const char *thatIs = "target", - bool isElemental = false, bool thisIsDeferredShape = false, - bool thatIsDeferredShape = false) const; + bool isElemental = false, + enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const; std::optional> MeasureElementSizeInBytes( FoldingContext &, bool align) const; std::optional> MeasureSizeInBytes( Index: flang/include/flang/Evaluate/shape.h =================================================================== --- flang/include/flang/Evaluate/shape.h +++ flang/include/flang/Evaluate/shape.h @@ -239,12 +239,30 @@ } // Compilation-time shape conformance checking, when corresponding extents -// are known. -bool CheckConformance(parser::ContextualMessages &, const Shape &left, - const Shape &right, const char *leftIs = "left operand", - const char *rightIs = "right operand", bool leftScalarExpandable = true, - bool rightScalarExpandable = true, bool leftIsDeferredShape = false, - bool rightIsDeferredShape = false); +// are or should be known. The result is an optional Boolean: +// - nullopt: no error found or reported, but conformance cannot +// be guaranteed during compilation; this result is possible only +// when one or both arrays are allowed to have deferred shape +// - true: no error found or reported, arrays conform +// - false: errors found and reported +// Use "CheckConformance(...).value_or()" to specify a default result +// when you don't care whether messages have been emitted. +struct CheckConformanceFlags { + enum Flags { + None = 0, + LeftScalarExpandable = 1, + RightScalarExpandable = 2, + LeftIsDeferredShape = 4, + RightIsDeferredShape = 8, + EitherScalarExpandable = LeftScalarExpandable | RightScalarExpandable, + BothDeferredShape = LeftIsDeferredShape | RightIsDeferredShape, + RightIsExpandableDeferred = RightScalarExpandable | RightIsDeferredShape, + }; +}; +std::optional CheckConformance(parser::ContextualMessages &, + const Shape &left, const Shape &right, + CheckConformanceFlags::Flags flags = CheckConformanceFlags::None, + const char *leftIs = "left operand", const char *rightIs = "right operand"); // Increments one-based subscripts in element order (first varies fastest) // and returns true when they remain in range; resets them all to one and Index: flang/lib/Evaluate/characteristics.cpp =================================================================== --- flang/lib/Evaluate/characteristics.cpp +++ flang/lib/Evaluate/characteristics.cpp @@ -149,8 +149,7 @@ bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages, const TypeAndShape &that, const char *thisIs, const char *thatIs, - bool isElemental, bool thisIsDeferredShape, - bool thatIsDeferredShape) const { + bool isElemental, enum CheckConformanceFlags::Flags flags) const { if (!type_.IsTkCompatibleWith(that.type_)) { messages.Say( "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US, @@ -158,9 +157,8 @@ return false; } return isElemental || - CheckConformance(messages, shape_, that.shape_, thisIs, thatIs, false, - false /* no scalar expansion */, thisIsDeferredShape, - thatIsDeferredShape); + CheckConformance(messages, shape_, that.shape_, flags, thisIs, thatIs) + .value_or(true /*fail only when nonconformance is known now*/); } std::optional> TypeAndShape::MeasureElementSizeInBytes( Index: flang/lib/Evaluate/check-expression.cpp =================================================================== --- flang/lib/Evaluate/check-expression.cpp +++ flang/lib/Evaluate/check-expression.cpp @@ -390,8 +390,9 @@ .Expand(std::move(folded)); } else if (auto resultShape{GetShape(context, folded)}) { if (CheckConformance(context.messages(), symTS->shape(), - *resultShape, "initialized object", - "initialization expression", false, false)) { + *resultShape, CheckConformanceFlags::None, + "initialized object", "initialization expression") + .value_or(false /*fail if not known now to conform*/)) { // make a constant array with adjusted lower bounds return ArrayConstantBoundChanger{ std::move(*AsConstantExtents( Index: flang/lib/Evaluate/fold-implementation.h =================================================================== --- flang/lib/Evaluate/fold-implementation.h +++ flang/lib/Evaluate/fold-implementation.h @@ -1030,8 +1030,9 @@ if (rightExpr.Rank() > 0) { if (std::optional rightShape{GetShape(context, rightExpr)}) { if (auto right{AsFlatArrayConstructor(rightExpr)}) { - if (CheckConformance( - context.messages(), *leftShape, *rightShape)) { + if (CheckConformance(context.messages(), *leftShape, *rightShape, + CheckConformanceFlags::EitherScalarExpandable) + .value_or(false /*fail if not known now to conform*/)) { return MapOperation(context, std::move(f), *leftShape, std::move(*left), std::move(*right)); } else { Index: flang/lib/Evaluate/shape.cpp =================================================================== --- flang/lib/Evaluate/shape.cpp +++ flang/lib/Evaluate/shape.cpp @@ -759,18 +759,16 @@ return std::nullopt; } -// Check conformance of the passed shapes. Only return true if we can verify -// that they conform -bool CheckConformance(parser::ContextualMessages &messages, const Shape &left, - const Shape &right, const char *leftIs, const char *rightIs, - bool leftScalarExpandable, bool rightScalarExpandable, - bool leftIsDeferredShape, bool rightIsDeferredShape) { +// Check conformance of the passed shapes. +std::optional CheckConformance(parser::ContextualMessages &messages, + const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags, + const char *leftIs, const char *rightIs) { int n{GetRank(left)}; - if (n == 0 && leftScalarExpandable) { + if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) { return true; } int rn{GetRank(right)}; - if (rn == 0 && rightScalarExpandable) { + if (rn == 0 && (flags & CheckConformanceFlags::RightScalarExpandable)) { return true; } if (n != rn) { @@ -787,11 +785,11 @@ j + 1, leftIs, *leftDim, rightIs, *rightDim); return false; } - } else if (!rightIsDeferredShape) { - return false; + } else if (!(flags & CheckConformanceFlags::RightIsDeferredShape)) { + return std::nullopt; } - } else if (!leftIsDeferredShape) { - return false; + } else if (!(flags & CheckConformanceFlags::LeftIsDeferredShape)) { + return std::nullopt; } } return true; Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -160,7 +160,8 @@ // Let CheckConformance accept scalars; storage association // cases are checked here below. CheckConformance(messages, dummy.type.shape(), actualType.shape(), - "dummy argument", "actual argument", true, true); + evaluate::CheckConformanceFlags::EitherScalarExpandable, + "dummy argument", "actual argument"); } } else { const auto &len{actualType.LEN()}; Index: flang/lib/Semantics/expression.cpp =================================================================== --- flang/lib/Semantics/expression.cpp +++ flang/lib/Semantics/expression.cpp @@ -1655,17 +1655,21 @@ "Rank-%d array value is not compatible with scalar component '%s'"_err_en_US, GetRank(*valueShape), symbol->name()), *symbol); - } else if (CheckConformance(messages, *componentShape, - *valueShape, "component", "value", false, - true /* can expand scalar value */)) { - if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0 && + } else { + auto checked{ + CheckConformance(messages, *componentShape, *valueShape, + CheckConformanceFlags::RightIsExpandableDeferred, + "component", "value")}; + if (checked && *checked && GetRank(*componentShape) > 0 && + GetRank(*valueShape) == 0 && !IsExpandableScalar(*converted)) { AttachDeclaration( Say(expr.source, "Scalar value cannot be expanded to shape of array component '%s'"_err_en_US, symbol->name()), *symbol); - } else { + } + if (checked.value_or(true)) { result.Add(*symbol, std::move(*converted)); } } @@ -3146,8 +3150,9 @@ auto rhShape{GetShape(foldingContext, *rhs)}; if (lhShape && rhShape) { return evaluate::CheckConformance(foldingContext.messages(), *lhShape, - *rhShape, "left operand", "right operand", true, - true /* scalar expansion is allowed */); + *rhShape, CheckConformanceFlags::EitherScalarExpandable, + "left operand", "right operand") + .value_or(false /*fail when conformance is not known now*/); } } } Index: flang/lib/Semantics/pointer-assignment.cpp =================================================================== --- flang/lib/Semantics/pointer-assignment.cpp +++ flang/lib/Semantics/pointer-assignment.cpp @@ -171,7 +171,7 @@ CHECK(frTypeAndShape); if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape, "pointer", "function result", false /*elemental*/, - true /*left: deferred shape*/, true /*right: deferred shape*/)) { + evaluate::CheckConformanceFlags::BothDeferredShape)) { msg = "%s is associated with the result of a reference to function '%s'" " whose pointer result has an incompatible type or shape"_err_en_US; }