shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang] Enforce prohibition against empty interoperable arrays

Browse Source 
Fortran doesn't allow a BIND(C) variable or a component of a BIND(C)
type to be an array with no elements.

Differential Revision: https://reviews.llvm.org/D145106
This commit is contained in:
Peter Klausler 2023-02-19 15:55:04 -08:00
parent 7020180226
commit bd87f2df4a
2 changed files with 41 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
flang/lib/Semantics/check-declarations.cpp
View File

@ -2230,12 +2230,18 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
context_.SetError(symbol);
}
}
if (symbol.has<ObjectEntityDetails>() && !symbol.owner().IsModule()) {
messages_.Say(symbol.name(),
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
context_.SetError(symbol);
}
if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (symbol.detailsIf<ObjectEntityDetails>()) {
if (!symbol.owner().IsModule()) {
messages_.Say(symbol.name(),
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
context_.SetError(symbol);
}
if (auto extents{evaluate::GetConstantExtents(foldingContext_, symbol)};
extents && evaluate::GetSize(*extents) == 0) {
SayWithDeclaration(symbol, symbol.name(),
"Interoperable array must have at least one element"_err_en_US);
}
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (!proc->procInterface() ||
!proc->procInterface()->attrs().test(Attr::BIND_C)) {
messages_.Say(symbol.name(),
@ -2259,31 +2265,39 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
for (const auto &pair : *symbol.scope()) {
const Symbol *component{&*pair.second};
if (IsProcedure(*component)) { // C1804
messages_.Say(symbol.name(),
messages_.Say(component->name(),
"A derived type with the BIND attribute cannot have a type bound procedure"_err_en_US);
context_.SetError(symbol);
break;
} else if (IsAllocatableOrPointer(*component)) { // C1806
messages_.Say(symbol.name(),
}
if (IsAllocatableOrPointer(*component)) { // C1806
messages_.Say(component->name(),
"A derived type with the BIND attribute cannot have a pointer or allocatable component"_err_en_US);
context_.SetError(symbol);
break;
} else if (const auto *type{component->GetType()}) {
}
if (const auto *type{component->GetType()}) {
if (const auto *derived{type->AsDerived()}) {
if (!derived->typeSymbol().attrs().test(Attr::BIND_C)) {
messages_.Say(
component->GetType()->AsDerived()->typeSymbol().name(),
"The component of the interoperable derived type must have the BIND attribute"_err_en_US);
if (auto *msg{messages_.Say(component->name(),
"Component '%s' of an interoperable derived type must have the BIND attribute"_err_en_US,
component->name())}) {
msg->Attach(derived->typeSymbol().name(),
"Non-interoperable component type"_en_US);
}
context_.SetError(symbol);
break;
}
} else if (!IsInteroperableIntrinsicType(*type)) {
messages_.Say(component->name(),
"Each component of an interoperable derived type must have an interoperable type"_err_en_US);
context_.SetError(symbol);
break;
}
}
if (auto extents{
evaluate::GetConstantExtents(foldingContext_, component)};
extents && evaluate::GetSize(*extents) == 0) {
messages_.Say(component->name(),
"An array component of an interoperable type must have at least one element"_err_en_US);
context_.SetError(symbol);
}
}
}
if (derived->componentNames().empty() &&

14
flang/test/Semantics/bind-c06.f90
View File

@ -3,6 +3,8 @@
module m
public s
!ERROR: Interoperable array must have at least one element
real, bind(c) :: x(0)
contains
subroutine s
end
@ -31,10 +33,10 @@ program main
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
! ERROR: A derived type with the BIND attribute cannot have a type bound procedure
procedure, nopass :: b => s
end type
@ -42,22 +44,22 @@ program main
type, bind(c) :: t5
end type
! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component
type, bind(c) :: t6
! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component
integer, pointer :: x
end type
! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component
type, bind(c) :: t7
! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component
integer, allocatable :: y
end type
! ERROR: The component of the interoperable derived type must have the BIND attribute
type :: t8
integer :: x
end type
type, bind(c) :: t9
!ERROR: Component 'y' of an interoperable derived type must have the BIND attribute
type(t8) :: y
integer :: z
end type
@ -82,5 +84,9 @@ program main
!ERROR: Each component of an interoperable derived type must have an interoperable type
complex(kind=2) x
end type
type, bind(c) :: t15
!ERROR: An array component of an interoperable type must have at least one element
real :: x(0)
end type
end