[flang-commits] [flang] 6d1a685 - [flang] Add semantic checks for interoperability of derived type (C1806)

[Peixin Qiao via flang-commits]

Author: Peixin Qiao
Date: 2022-08-20T23:34:47+08:00
New Revision: 6d1a685172f2acbf8ceae891a9c9c3ff371238a7

URL: https://github.com/llvm/llvm-project/commit/6d1a685172f2acbf8ceae891a9c9c3ff371238a7
DIFF: https://github.com/llvm/llvm-project/commit/6d1a685172f2acbf8ceae891a9c9c3ff371238a7.diff

LOG: [flang] Add semantic checks for interoperability of derived type (C1806)

As Fortran 2018 C1806, each component of a derived type with the BIND
attribute shall be a nonpointer, nonallocatable data component with
interoperable type.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D131585

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/module/__fortran_builtins.f90
    flang/test/Semantics/bind-c06.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index abfd3d4963f83..c0c0eea3e6c57 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1920,8 +1920,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
           "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);
     }
-  }
-  if (const auto *derived{symbol.detailsIf<DerivedTypeDetails>()}) {
+  } 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);
@@ -1942,6 +1941,18 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
               "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(),
+              "A derived type with the BIND attribute cannot have a pointer or allocatable component"_err_en_US);
+          context_.SetError(symbol);
+          break;
+        } else if (component->GetType() && component->GetType()->AsDerived() &&
+            !component->GetType()->AsDerived()->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);
+          context_.SetError(symbol);
+          break;
         }
       }
     }

diff  --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 4ce4901c4505d..19184c824488e 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -23,7 +23,7 @@
     integer(kind=int64) :: __address
   end type
 
-  type :: __builtin_c_funptr
+  type, bind(c) :: __builtin_c_funptr
     integer(kind=int64) :: __address
   end type
 

diff  --git a/flang/test/Semantics/bind-c06.f90 b/flang/test/Semantics/bind-c06.f90
index b247619d28a07..e24c192076c9c 100644
--- a/flang/test/Semantics/bind-c06.f90
+++ b/flang/test/Semantics/bind-c06.f90
@@ -42,4 +42,24 @@ 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
+    integer, pointer :: x
+  end type
+
+  ! ERROR: A derived type with the BIND attribute cannot have a pointer or allocatable component
+  type, bind(c) :: t7
+    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
+    type(t8) :: y
+    integer :: z
+  end type
+
 end