From c6ec6e30867d07d5f641cdc34463a9588bdb9d22 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Mon, 20 Mar 2023 11:44:56 -0700 Subject: [PATCH] [flang] Disallow scalar argument to SIZE/LBOUND/UBOUND The compiler accepts arguments of any rank, or assumed rank, to a host of intrinsic inquiry functions. For scalars, this is correct for most of them, but the standard (and other compilers) prohibit scalar arguments to SIZE, LBOUND, and UBOUND (without DIM=). There are meaningful interpretations for these intrinsic inquiries on scalars, but since there's no portability concern here, continuing to support them would be an unjustifiable extension. Differential Revision: https://reviews.llvm.org/D146587 --- flang/lib/Evaluate/intrinsics.cpp | 25 +++++++++++++++++-------- flang/test/Semantics/misc-intrinsics.f90 | 8 ++++++++ flang/test/Semantics/symbol14.f90 | 4 ---- 3 files changed, 25 insertions(+), 12 deletions(-) diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index a27d211..e82b62e 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -56,8 +56,8 @@ class FoldingContext; // 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 @@ ENUM_CLASS(Rank, 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 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {{"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 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"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 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {{"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}, @@ -1689,7 +1690,8 @@ std::optional IntrinsicInterface::Match( 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; @@ -1871,7 +1873,8 @@ std::optional IntrinsicInterface::Match( 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); @@ -1949,6 +1952,11 @@ std::optional IntrinsicInterface::Match( 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 || @@ -2245,6 +2253,7 @@ std::optional IntrinsicInterface::Match( 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); diff --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90 index b454d47..2433ffa 100644 --- a/flang/test/Semantics/misc-intrinsics.f90 +++ b/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 @@ program test_size 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 @@ program test_size print *, lbound(array) print *, size(arg(:,1)) print *, ubound(arg(:,1)) + print *, shape(scalar) print *, shape(arg(:,1)) end subroutine end diff --git a/flang/test/Semantics/symbol14.f90 b/flang/test/Semantics/symbol14.f90 index 2b75411..4a7ee87 100644 --- a/flang/test/Semantics/symbol14.f90 +++ b/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 -- 2.7.4