Skip to content

Commit

Permalink
[flang] Fixed shape computation for elementals with optional dummys.
Browse files Browse the repository at this point in the history
It looks like a regression after D151737: shape of the elemental
call became rank-0.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D156386
  • Loading branch information
vzakhari committed Jul 27, 2023
1 parent c78b528 commit fb7366c
Show file tree
Hide file tree
Showing 2 changed files with 33 additions and 3 deletions.
17 changes: 14 additions & 3 deletions flang/lib/Evaluate/shape.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -811,13 +811,24 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (auto chars{characteristics::Procedure::FromActuals(
call.proc(), call.arguments(), *context_)}) {
std::size_t j{0};
std::size_t anyArrayArgRank{0};
for (const auto &arg : call.arguments()) {
if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size() &&
!chars->dummyArguments[j].IsOptional()) {
return (*this)(*arg);
if (arg && arg->Rank() > 0 && j < chars->dummyArguments.size()) {
anyArrayArgRank = arg->Rank();
if (!chars->dummyArguments[j].IsOptional()) {
return (*this)(*arg);
}
}
++j;
}
if (anyArrayArgRank) {
// All dummy array arguments of the procedure are OPTIONAL.
// We cannot take the shape from just any array argument,
// because all of them might be OPTIONAL dummy arguments
// of the caller. Return unknown shape ranked according
// to the last actual array argument.
return Shape(anyArrayArgRank, MaybeExtentExpr{});
}
}
}
return ScalarShape();
Expand Down
19 changes: 19 additions & 0 deletions flang/test/Lower/shape-of-elemental-with-optional-arg.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
! Test that the shape of the elemental call is properly
! computed as being rank 1, even though the only dummy
! argument is optional.

! RUN: bbc -emit-fir %s -o - | FileCheck %s
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s

subroutine test
interface
elemental function callee(arg1)
integer, intent(in), optional :: arg1
integer :: fun
end function callee
end interface
integer :: arr(2)
print *, callee(arr)
end subroutine test
! The PRINT statement must be lowered into a ranked print:
! CHECK: fir.call @_FortranAioOutputDescriptor

0 comments on commit fb7366c

Please sign in to comment.