[flang] Enforce prohibition against empty interoperable arrays

[klausler]

Summary

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

[vdonaldson]

flang/lib/Semantics/check-declarations.cpp

2237

It might be helpful to reconsider the wording of this message while in the neighborhood - the first two definite articles seem a little odd.

[klausler]

Improve an error message per review comment.

flang/lib/Semantics/check-declarations.cpp

for (char ch : *bindName) {
       ok &= ch == '_' || parser::IsLetter(ch) || parser::IsDecimalDigit(ch);
     }
     if (!ok) {
       messages_.Say(symbol.name(),
           "Symbol has a BIND(C) name that is not a valid C language identifier"_err_en_US);
       context_.SetError(symbol);
     }
   }
-  if (symbol.has<ObjectEntityDetails>() && !symbol.owner().IsModule()) {
+  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 (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
+    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(),
           "An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement"_err_en_US);
       context_.SetError(symbol);
     }
   } else 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(),
+          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() &&
         !FindModuleFileContaining(symbol.owner())) { // C1805
       messages_.Say(symbol.name(),
           "A derived type with the BIND attribute is empty"_port_en_US);
     }
   }

flang/test/Semantics/bind-c06.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Check for C1801 - C1805
 
 module m
   public s
+  !ERROR: Interoperable array must have at least one element
+  real, bind(c) :: x(0)
 contains
   subroutine s
   end
 end
 
 program main
   use m
   type, abstract :: v
type, bind(c) :: t2(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
+    ! ERROR: A derived type with the BIND attribute cannot have a type bound procedure
     procedure, nopass :: b => s
   end type
 
   ! WARNING: A derived type with the BIND attribute is empty
   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
 
   type, bind(c) :: t10
     !ERROR: Each component of an interoperable derived type must have an interoperable type
     character(len=2) x
   end type
   type, bind(c) :: t11
     !ERROR: Each component of an interoperable derived type must have an interoperable type
     character(kind=2) x
   end type
   type, bind(c) :: t12
     !ERROR: Each component of an interoperable derived type must have an interoperable type
     logical(kind=8) x
   end type
   type, bind(c) :: t13
     !ERROR: Each component of an interoperable derived type must have an interoperable type
     real(kind=2) x
   end type
   type, bind(c) :: t14
     !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