From 48b6f5c708ccf99ee18b68ca547c034606ed3493 Mon Sep 17 00:00:00 2001
From: Peixin Qiao <qiaopeixin@huawei.com>
Date: Tue, 2 Aug 2022 23:07:02 +0800
Subject: [PATCH] [flang] Add some semantic checks for derived type with BIND
 attribute

This supports checks in C1801-C1805 for derived type with BIND attribute.
The other compilers such as 'gfortran' and 'ifort' do not report error
for C1802 and C1805, so emit warnings for them.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D130438
---
 flang/lib/Semantics/check-declarations.cpp | 29 +++++++++++++++++++
 flang/test/Semantics/bind-c06.f90          | 45 ++++++++++++++++++++++++++++++
 flang/test/Semantics/modfile11.f90         |  4 +--
 3 files changed, 76 insertions(+), 2 deletions(-)
 create mode 100644 flang/test/Semantics/bind-c06.f90

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 1e2e846..8c63a74b 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1914,6 +1914,35 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
       context_.SetError(symbol);
     }
   }
+  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(),
+              "A derived type with the BIND attribute cannot have a type bound procedure"_err_en_US);
+          context_.SetError(symbol);
+          break;
+        }
+      }
+    }
+    if (derived->componentNames().empty()) { // C1805
+      messages_.Say(symbol.name(),
+          "A derived type with the BIND attribute is empty"_port_en_US);
+    }
+  }
 }
 
 bool CheckHelper::CheckDioDummyIsData(
diff --git a/flang/test/Semantics/bind-c06.f90 b/flang/test/Semantics/bind-c06.f90
new file mode 100644
index 0000000..b247619
--- /dev/null
+++ b/flang/test/Semantics/bind-c06.f90
@@ -0,0 +1,45 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for C1801 - C1805
+
+module m
+  public s
+contains
+  subroutine s
+  end
+end
+
+program main
+  use m
+  type, abstract :: v
+    integer :: i
+  end type
+
+  ! ERROR: A derived type with the BIND attribute cannot have the SEQUENCE attribute
+  type, bind(c) :: t1
+    sequence
+    integer :: x
+  end type
+
+  ! ERROR: A derived type with the BIND attribute has type parameter(s)
+  type, bind(c) :: t2(k)
+    integer, KIND :: 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
+    procedure, nopass :: b => s
+  end type
+
+  ! WARNING: A derived type with the BIND attribute is empty
+  type, bind(c) :: t5
+  end type
+
+end
diff --git a/flang/test/Semantics/modfile11.f90 b/flang/test/Semantics/modfile11.f90
index d5e10d8..a8479f5 100644
--- a/flang/test/Semantics/modfile11.f90
+++ b/flang/test/Semantics/modfile11.f90
@@ -8,7 +8,7 @@ module m
   type, extends(t1) :: t2(e)
     integer, len :: e
   end type
-  type, extends(t2), bind(c) :: t3
+  type, extends(t2) :: t3
   end type
 end
 
@@ -23,6 +23,6 @@ end
 !  type,extends(t1)::t2(e)
 !    integer(4),len::e
 !  end type
-!  type,bind(c),extends(t2)::t3
+!  type,extends(t2)::t3
 !  end type
 !end
-- 
2.7.4