maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Add semantic check for multiple part-ref with nonzero rank for TBP 

As Fortran 2018 C919, there shall not be more than one part-ref with
nonzero rank. Support this semantic check for type-bound procedure to
address the issue https://github.com/llvm/llvm-project/issues/55811.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D127602
This commit is contained in:
Peixin-Qiao 2022-06-14 10:17:44 +08:00
parent 0ba43f4c2b
commit c6d8aa27c5
2 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
flang/lib/Semantics/expression.cpp
View File

@ -1977,13 +1977,16 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
return std::nullopt;
}
}
std::optional<DataRef> 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> 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}},

35
flang/test/Semantics/expr-errors04.f90
View File

@ -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 @@ program m
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