[flang] Add some semantic checks for derived type with BIND attribute

This supports checks in C1801-C1805 for derived type with BIND attribute.
The other compilers such as 'gfortran' and 'ifort' do not report error
for C1802 and C1805, so emit warnings for them.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D130438
This commit is contained in:
Peixin Qiao 2022-08-02 23:07:02 +08:00
parent 1f9212d8d5
commit 48b6f5c708
3 changed files with 76 additions and 2 deletions

View File

@ -1914,6 +1914,35 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
context_.SetError(symbol); context_.SetError(symbol);
} }
} }
if (const auto *derived{symbol.detailsIf<DerivedTypeDetails>()}) {
if (derived->sequence()) { // C1801
messages_.Say(symbol.name(),
"A derived type with the BIND attribute cannot have the SEQUENCE attribute"_err_en_US);
context_.SetError(symbol);
} else if (!derived->paramDecls().empty()) { // C1802
messages_.Say(symbol.name(),
"A derived type with the BIND attribute has type parameter(s)"_err_en_US);
context_.SetError(symbol);
} else if (symbol.scope()->GetDerivedTypeParent()) { // C1803
messages_.Say(symbol.name(),
"A derived type with the BIND attribute cannot extend from another derived type"_err_en_US);
context_.SetError(symbol);
} else {
for (const auto &pair : *symbol.scope()) {
const Symbol *component{&*pair.second};
if (IsProcedure(*component)) { // C1804
messages_.Say(symbol.name(),
"A derived type with the BIND attribute cannot have a type bound procedure"_err_en_US);
context_.SetError(symbol);
break;
}
}
}
if (derived->componentNames().empty()) { // C1805
messages_.Say(symbol.name(),
"A derived type with the BIND attribute is empty"_port_en_US);
}
}
} }
bool CheckHelper::CheckDioDummyIsData( bool CheckHelper::CheckDioDummyIsData(

View File

@ -0,0 +1,45 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! Check for C1801 - C1805
module m
public s
contains
subroutine s
end
end
program main
use m
type, abstract :: v
integer :: i
end type
! ERROR: A derived type with the BIND attribute cannot have the SEQUENCE attribute
type, bind(c) :: t1
sequence
integer :: x
end type
! ERROR: A derived type with the BIND attribute has type parameter(s)
type, bind(c) :: t2(k)
integer, KIND :: k
integer :: x
end type
! ERROR: A derived type with the BIND attribute cannot extend from another derived type
type, bind(c), extends(v) :: t3
integer :: x
end type
! ERROR: A derived type with the BIND attribute cannot have a type bound procedure
type, bind(c) :: t4
integer :: x
contains
procedure, nopass :: b => s
end type
! WARNING: A derived type with the BIND attribute is empty
type, bind(c) :: t5
end type
end

View File

@ -8,7 +8,7 @@ module m
type, extends(t1) :: t2(e) type, extends(t1) :: t2(e)
integer, len :: e integer, len :: e
end type end type
type, extends(t2), bind(c) :: t3 type, extends(t2) :: t3
end type end type
end end
@ -23,6 +23,6 @@ end
! type,extends(t1)::t2(e) ! type,extends(t1)::t2(e)
! integer(4),len::e ! integer(4),len::e
! end type ! end type
! type,bind(c),extends(t2)::t3 ! type,extends(t2)::t3
! end type ! end type
!end !end