@@ -254,7 +254,8 @@ class GetLowerBoundHelper
254254 if (dimension_ < rank) {
255255 const semantics::ShapeSpec &shapeSpec{object->shape ()[dimension_]};
256256 if (shapeSpec.lbound ().isExplicit ()) {
257- if (const auto &lbound{shapeSpec.lbound ().GetExplicit ()}) {
257+ if (const auto &lbound{shapeSpec.lbound ().GetExplicit ()};
258+ lbound && lbound->Rank () == 0 ) {
258259 if constexpr (LBOUND_SEMANTICS) {
259260 bool ok{false };
260261 auto lbValue{ToInt64 (*lbound)};
@@ -266,7 +267,8 @@ class GetLowerBoundHelper
266267 } else if (lbValue.value_or (0 ) == 1 ) {
267268 // Lower bound is 1, regardless of extent
268269 ok = true ;
269- } else if (const auto &ubound{shapeSpec.ubound ().GetExplicit ()}) {
270+ } else if (const auto &ubound{shapeSpec.ubound ().GetExplicit ()};
271+ ubound && ubound->Rank () == 0 ) {
270272 // If we can't prove that the dimension is nonempty,
271273 // we must be conservative.
272274 // TODO: simple symbolic math in expression rewriting to
@@ -459,7 +461,7 @@ static MaybeExtentExpr GetNonNegativeExtent(
459461 } else {
460462 return ExtentExpr{*uval - *lval + 1 };
461463 }
462- } else if (lbound && ubound &&
464+ } else if (lbound && ubound && lbound-> Rank () == 0 && ubound-> Rank () == 0 &&
463465 (!invariantOnly ||
464466 (IsScopeInvariantExpr (*lbound) && IsScopeInvariantExpr (*ubound)))) {
465467 // Apply effective IDIM (MAX calculation with 0) so thet the
@@ -608,7 +610,8 @@ MaybeExtentExpr GetRawUpperBound(
608610 int rank{details->shape ().Rank ()};
609611 if (dimension < rank) {
610612 const auto &bound{details->shape ()[dimension].ubound ().GetExplicit ()};
611- if (bound && (!invariantOnly || IsScopeInvariantExpr (*bound))) {
613+ if (bound && bound->Rank () == 0 &&
614+ (!invariantOnly || IsScopeInvariantExpr (*bound))) {
612615 return *bound;
613616 } else if (semantics::IsAssumedSizeArray (symbol) &&
614617 dimension + 1 == symbol.Rank ()) {
@@ -640,7 +643,8 @@ MaybeExtentExpr GetRawUpperBound(FoldingContext &context,
640643static MaybeExtentExpr GetExplicitUBOUND (FoldingContext *context,
641644 const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
642645 const auto &ubound{shapeSpec.ubound ().GetExplicit ()};
643- if (ubound && (!invariantOnly || IsScopeInvariantExpr (*ubound))) {
646+ if (ubound && ubound->Rank () == 0 &&
647+ (!invariantOnly || IsScopeInvariantExpr (*ubound))) {
644648 if (auto extent{GetNonNegativeExtent (shapeSpec, invariantOnly)}) {
645649 if (auto cstExtent{ToInt64 (
646650 context ? Fold (*context, std::move (*extent)) : *extent)}) {
@@ -731,7 +735,8 @@ MaybeExtentExpr GetLCOBOUND(
731735 if (dimension < corank) {
732736 const semantics::ShapeSpec &shapeSpec{object->coshape ()[dimension]};
733737 if (const auto &lcobound{shapeSpec.lbound ().GetExplicit ()}) {
734- if (!invariantOnly || IsScopeInvariantExpr (*lcobound)) {
738+ if (lcobound->Rank () == 0 &&
739+ (!invariantOnly || IsScopeInvariantExpr (*lcobound))) {
735740 return *lcobound;
736741 }
737742 }
@@ -748,7 +753,8 @@ MaybeExtentExpr GetUCOBOUND(
748753 if (dimension < corank - 1 ) {
749754 const semantics::ShapeSpec &shapeSpec{object->coshape ()[dimension]};
750755 if (const auto ucobound{shapeSpec.ubound ().GetExplicit ()}) {
751- if (!invariantOnly || IsScopeInvariantExpr (*ucobound)) {
756+ if (ucobound->Rank () == 0 &&
757+ (!invariantOnly || IsScopeInvariantExpr (*ucobound))) {
752758 return *ucobound;
753759 }
754760 }
@@ -822,7 +828,7 @@ auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
822828 if (subp.isFunction ()) {
823829 auto resultShape{(*this )(subp.result ())};
824830 if (resultShape && !useResultSymbolShape_) {
825- // Ensure the shape is constant. Otherwise, it may be referring
831+ // Ensure the shape is constant. Otherwise, it may be reerring
826832 // to symbols that belong to the function's scope and are
827833 // meaningless on the caller side without the related call
828834 // expression.
@@ -908,23 +914,33 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
908914 if (auto chars{characteristics::Procedure::FromActuals (
909915 call.proc (), call.arguments (), *context_)}) {
910916 std::size_t j{0 };
911- std::size_t anyArrayArgRank{0 };
917+ const ActualArgument *nonOptionalArrayArg{nullptr };
918+ int anyArrayArgRank{0 };
912919 for (const auto &arg : call.arguments ()) {
913920 if (arg && arg->Rank () > 0 && j < chars->dummyArguments .size ()) {
914- anyArrayArgRank = arg->Rank ();
915- if (!chars->dummyArguments [j].IsOptional ()) {
916- return (*this )(*arg);
921+ if (!anyArrayArgRank) {
922+ anyArrayArgRank = arg->Rank ();
923+ } else if (arg->Rank () != anyArrayArgRank) {
924+ return std::nullopt ; // error recovery
925+ }
926+ if (!nonOptionalArrayArg &&
927+ !chars->dummyArguments [j].IsOptional ()) {
928+ nonOptionalArrayArg = &*arg;
917929 }
918930 }
919931 ++j;
920932 }
921933 if (anyArrayArgRank) {
922- // All dummy array arguments of the procedure are OPTIONAL.
923- // We cannot take the shape from just any array argument,
924- // because all of them might be OPTIONAL dummy arguments
925- // of the caller. Return unknown shape ranked according
926- // to the last actual array argument.
927- return Shape (anyArrayArgRank, MaybeExtentExpr{});
934+ if (nonOptionalArrayArg) {
935+ return (*this )(*nonOptionalArrayArg);
936+ } else {
937+ // All dummy array arguments of the procedure are OPTIONAL.
938+ // We cannot take the shape from just any array argument,
939+ // because all of them might be OPTIONAL dummy arguments
940+ // of the caller. Return unknown shape ranked according
941+ // to the last actual array argument.
942+ return Shape (anyArrayArgRank, MaybeExtentExpr{});
943+ }
928944 }
929945 }
930946 }
0 commit comments