[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);
}
}
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(

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)
integer, len :: e
end type
type, extends(t2), bind(c) :: t3
type, extends(t2) :: t3
end type
end
@ -23,6 +23,6 @@ end
! type,extends(t1)::t2(e)
! integer(4),len::e
! end type
! type,bind(c),extends(t2)::t3
! type,extends(t2)::t3
! end type
!end