diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 709f2e6c85bb2..389d8e6c57763 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2340,7 +2340,7 @@ std::optional IntrinsicInterface::Match( if (!knownArg) { knownArg = arg; } - if (!dimArg && rank > 0 && + if (rank > 0 && (std::strcmp(name, "shape") == 0 || std::strcmp(name, "size") == 0 || std::strcmp(name, "ubound") == 0)) { @@ -2351,16 +2351,18 @@ std::optional IntrinsicInterface::Match( // over this one, as this error is caught by the second entry // for UBOUND.) if (auto named{ExtractNamedEntity(*arg)}) { - if (semantics::IsAssumedSizeArray(named->GetLastSymbol())) { + if (semantics::IsAssumedSizeArray(ResolveAssociations( + named->GetLastSymbol().GetUltimate()))) { if (strcmp(name, "shape") == 0) { messages.Say(arg->sourceLocation(), "The 'source=' argument to the intrinsic function 'shape' may not be assumed-size"_err_en_US); - } else { + return std::nullopt; + } else if (!dimArg) { messages.Say(arg->sourceLocation(), "A dim= argument is required for '%s' when the array is assumed-size"_err_en_US, name); + return std::nullopt; } - return std::nullopt; } } } diff --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90 index 14dcdb05ac6c6..a7895f7b7f16f 100644 --- a/flang/test/Semantics/misc-intrinsics.f90 +++ b/flang/test/Semantics/misc-intrinsics.f90 @@ -3,17 +3,37 @@ program test_size real :: scalar real, dimension(5, 5) :: array - call test(array, array) + call test(array, array, array) contains - subroutine test(arg, assumedRank) + subroutine test(arg, assumedRank, poly) real, dimension(5, *) :: arg real, dimension(..) :: assumedRank + class(*) :: poly(5, *) !ERROR: A dim= argument is required for 'size' when the array is assumed-size print *, size(arg) + print *, size(arg, dim=1) ! ok + select type (poly) + type is (real) + !ERROR: A dim= argument is required for 'size' when the array is assumed-size + print *, size(poly) + print *, size(poly, dim=1) ! ok + end select !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size print *, ubound(arg) + print *, ubound(arg, dim=1) ! ok + select type (poly) + type is (real) + !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size + print *, ubound(poly) + print *, ubound(poly, dim=1) ! ok + end select !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size print *, shape(arg) + select type (poly) + type is (real) + !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size + print *, shape(poly) + end select !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size call random_number(arg) !ERROR: 'array=' argument has unacceptable rank 0 @@ -85,5 +105,16 @@ subroutine test(arg, assumedRank) print *, lbound(assumedRank, dim=2) print *, ubound(assumedRank, dim=2) end select + contains + subroutine inner + !ERROR: A dim= argument is required for 'size' when the array is assumed-size + print *, size(arg) + print *, size(arg, dim=1) ! ok + !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size + print *, ubound(arg) + print *, ubound(arg, dim=1) ! ok + !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size + print *, shape(arg) + end end subroutine end