[flang] Enforce prohibition against empty interoperable arrays

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
llvm · Mar 2, 2023 · bd87f2d · bd87f2d
1 parent 7020180
commit bd87f2d
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 21 deletions.
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
@@ -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() &&

diff --git 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,33 +33,33 @@ 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
 
   ! 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
@@ -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