[flang-commits] [flang] 48b6f5c - [flang] Add some semantic checks for derived type with BIND attribute

[Peixin Qiao via flang-commits]

Author: Peixin Qiao
Date: 2022-08-02T23:07:02+08:00
New Revision: 48b6f5c708ccf99ee18b68ca547c034606ed3493

URL: https://github.com/llvm/llvm-project/commit/48b6f5c708ccf99ee18b68ca547c034606ed3493
DIFF: https://github.com/llvm/llvm-project/commit/48b6f5c708ccf99ee18b68ca547c034606ed3493.diff

LOG: [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

Added: 
    flang/test/Semantics/bind-c06.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/modfile11.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 1e2e846a14b7..8c63a74b8211 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 000000000000..b247619d28a0
--- /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 d5e10d8127e7..a8479f51ad4a 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 @@ module m
 !  type,extends(t1)::t2(e)
 !    integer(4),len::e
 !  end type
-!  type,bind(c),extends(t2)::t3
+!  type,extends(t2)::t3
 !  end type
 !end