Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -56,8 +56,8 @@ // that can also be typeless values are encoded with an "elementalOrBOZ" // rank pattern. // Assumed-type (TYPE(*)) dummy arguments can be forwarded along to some -// intrinsic functions that accept AnyType + Rank::anyOrAssumedRank or -// AnyType + Kind::addressable. +// intrinsic functions that accept AnyType + Rank::anyOrAssumedRank, +// AnyType + Rank::arrayOrAssumedRank, or AnyType + Kind::addressable. using CategorySet = common::EnumSet; static constexpr CategorySet IntType{TypeCategory::Integer}; static constexpr CategorySet RealType{TypeCategory::Real}; @@ -203,7 +203,8 @@ coarray, // rank is known and can be scalar; has nonzero corank atom, // is scalar and has nonzero corank or is coindexed known, // rank is known and can be scalar - anyOrAssumedRank, // rank can be unknown; assumed-type TYPE(*) allowed + anyOrAssumedRank, // any rank, or assumed; assumed-type TYPE(*) allowed + arrayOrAssumedRank, // rank >= 1 or assumed; assumed-type TYPE(*) allowed conformable, // scalar, or array of same rank & shape as "array" argument reduceOperation, // a pure function with constraints for REDUCE dimReduced, // scalar if no DIM= argument, else rank(array)-1 @@ -554,7 +555,7 @@ {{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM, SizeDefaultKIND}, KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction}, - {"lbound", {{"array", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND}, + {"lbound", {{"array", AnyData, Rank::arrayOrAssumedRank}, SizeDefaultKIND}, KINDInt, Rank::vector, IntrinsicClass::inquiryFunction}, {"lcobound", {{"coarray", AnyData, Rank::coarray}, OptionalDIM, SizeDefaultKIND}, @@ -802,7 +803,7 @@ {"sind", {{"x", SameFloating}}, SameFloating}, {"sinh", {{"x", SameFloating}}, SameFloating}, {"size", - {{"array", AnyData, Rank::anyOrAssumedRank}, + {{"array", AnyData, Rank::arrayOrAssumedRank}, OptionalDIM, // unless array is assumed-size SizeDefaultKIND}, KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction}, @@ -862,7 +863,7 @@ {{"array", AnyData, Rank::anyOrAssumedRank}, RequiredDIM, SizeDefaultKIND}, KINDInt, Rank::scalar, IntrinsicClass::inquiryFunction}, - {"ubound", {{"array", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND}, + {"ubound", {{"array", AnyData, Rank::arrayOrAssumedRank}, SizeDefaultKIND}, KINDInt, Rank::vector, IntrinsicClass::inquiryFunction}, {"ucobound", {{"coarray", AnyData, Rank::coarray}, OptionalDIM, SizeDefaultKIND}, @@ -1675,7 +1676,8 @@ if (arg->GetAssumedTypeDummy()) { // TYPE(*) assumed-type dummy argument forwarded to intrinsic if (d.typePattern.categorySet == AnyType && - d.rank == Rank::anyOrAssumedRank && + (d.rank == Rank::anyOrAssumedRank || + d.rank == Rank::arrayOrAssumedRank) && (d.typePattern.kindCode == KindCode::any || d.typePattern.kindCode == KindCode::addressable)) { continue; @@ -1857,7 +1859,8 @@ const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]}; if (const ActualArgument *arg{actualForDummy[j]}) { bool isAssumedRank{IsAssumedRank(*arg)}; - if (isAssumedRank && d.rank != Rank::anyOrAssumedRank) { + if (isAssumedRank && d.rank != Rank::anyOrAssumedRank && + d.rank != Rank::arrayOrAssumedRank) { messages.Say(arg->sourceLocation(), "Assumed-rank array cannot be forwarded to '%s=' argument"_err_en_US, d.keyword); @@ -1935,6 +1938,11 @@ argOk = rank == knownArg->Rank(); break; case Rank::anyOrAssumedRank: + case Rank::arrayOrAssumedRank: + if (d.rank == Rank::arrayOrAssumedRank && rank == 0) { + argOk = false; + break; + } if (!dimArg && rank > 0 && !isAssumedRank && (std::strcmp(name, "shape") == 0 || std::strcmp(name, "size") == 0 || @@ -2231,6 +2239,7 @@ case Rank::atom: case Rank::known: case Rank::anyOrAssumedRank: + case Rank::arrayOrAssumedRank: case Rank::reduceOperation: case Rank::dimRemovedOrScalar: common::die("INTERNAL: bad Rank code on intrinsic '%s' result", name); Index: flang/test/Semantics/misc-intrinsics.f90 =================================================================== --- flang/test/Semantics/misc-intrinsics.f90 +++ flang/test/Semantics/misc-intrinsics.f90 @@ -1,6 +1,7 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 ! Miscellaneous constraint and requirement checking on intrinsics program test_size + real :: scalar real, dimension(5, 5) :: array call test(array) contains @@ -12,6 +13,12 @@ print *, ubound(arg) !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size print *, shape(arg) + !ERROR: missing mandatory 'dim=' argument + print *, lbound(scalar) + !ERROR: 'array=' argument has unacceptable rank 0 + print *, size(scalar) + !ERROR: missing mandatory 'dim=' argument + print *, ubound(scalar) ! But these cases are fine: print *, size(arg, dim=1) print *, ubound(arg, dim=1) @@ -21,6 +28,7 @@ print *, lbound(array) print *, size(arg(:,1)) print *, ubound(arg(:,1)) + print *, shape(scalar) print *, shape(arg(:,1)) end subroutine end Index: flang/test/Semantics/symbol14.f90 =================================================================== --- flang/test/Semantics/symbol14.f90 +++ flang/test/Semantics/symbol14.f90 @@ -15,10 +15,6 @@ !DEF: /MainProgram1/t2/b ObjectEntity REAL(4) !REF: /MainProgram1/t1/k real :: b(k) - !DEF: /MainProgram1/t2/c ObjectEntity REAL(4) - !DEF: /MainProgram1/size INTRINSIC, PURE (Function) ProcEntity - !DEF: /MainProgram1/a (Implicit) ObjectEntity REAL(4) - real :: c(size(a)) !REF: /MainProgram1/t1 !DEF: /MainProgram1/t2/x ObjectEntity TYPE(t1(k=666_4)) type(t1) :: x