diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2230,12 +2230,18 @@ context_.SetError(symbol); } } - if (symbol.has() && !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()}) { + if (symbol.detailsIf()) { + 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()}) { if (!proc->procInterface() || !proc->procInterface()->attrs().test(Attr::BIND_C)) { messages_.Say(symbol.name(), @@ -2259,31 +2265,39 @@ 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() && diff --git a/flang/test/Semantics/bind-c06.f90 b/flang/test/Semantics/bind-c06.f90 --- a/flang/test/Semantics/bind-c06.f90 +++ b/flang/test/Semantics/bind-c06.f90 @@ -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 @@ 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 @@ 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 @@ !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