diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1977,13 +1977,16 @@ return std::nullopt; } } + std::optional dataRef{ExtractDataRef(std::move(*dtExpr))}; + if (dataRef.has_value() && !CheckRanks(std::move(*dataRef))) { + return std::nullopt; + } if (const Symbol * resolution{GetBindingResolution(dtExpr->GetType(), *sym)}) { AddPassArg(arguments, std::move(*dtExpr), *sym, false); return CalleeAndArguments{ ProcedureDesignator{*resolution}, std::move(arguments)}; - } else if (std::optional dataRef{ - ExtractDataRef(std::move(*dtExpr))}) { + } else if (dataRef.has_value()) { if (sym->attrs().test(semantics::Attr::NOPASS)) { return CalleeAndArguments{ ProcedureDesignator{Component{std::move(*dataRef), *sym}}, diff --git a/flang/test/Semantics/expr-errors04.f90 b/flang/test/Semantics/expr-errors04.f90 --- a/flang/test/Semantics/expr-errors04.f90 +++ b/flang/test/Semantics/expr-errors04.f90 @@ -2,10 +2,23 @@ ! Regression test for more than one part-ref with nonzero rank program m + interface + function real_info1(i) + end + subroutine real_info2() + end + subroutine real_generic() + end + end interface type mt complex :: c, c2(2) integer :: x, x2(2) character(10) :: s, s2(2) + contains + procedure, nopass :: info1 => real_info1 + procedure, nopass :: info2 => real_info2 + procedure, nopass :: real_generic + generic :: g1 => real_generic end type type mt2 type(mt) :: t1(2,2) @@ -73,4 +86,26 @@ print *, t(1)%t3%t2(1)%t1%c2(1)%RE !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed print *, t%t3%t2%t1%c2(1)%IM + + !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed + call sub0(t%t3%t2%t1%info1(i)) + !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed + call t%t3%t2%t1%info2 + !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed + call t%t3%t2%t1%g1 + + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call sub0(t%t3%t2%t1(1)%info1(i)) + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call t%t3%t2%t1(1)%info2 + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call t%t3%t2%t1(1)%g1 + + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call sub0(t%t3%t2%t1(1:)%info1(i)) + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call t%t3%t2%t1(1:)%info2 + !ERROR: Reference to rank-2 object 't1' has 1 subscripts + call t%t3%t2%t1(1:)%g1 + end