[flang-commits] [flang] 779d247 - [flang] Support check for BIND statement entity

[via flang-commits]

Author: Peixin-Qiao
Date: 2022-06-29T11:25:19+08:00
New Revision: 779d2470a45393b981eff706662922f320859681

URL: https://github.com/llvm/llvm-project/commit/779d2470a45393b981eff706662922f320859681
DIFF: https://github.com/llvm/llvm-project/commit/779d2470a45393b981eff706662922f320859681.diff

LOG: [flang] Support check for BIND statement entity

As Fortran 2018 8.6.4(1), the BIND statement specifies the BIND attribute
for a list of variables and common blocks.

Reviewed By: klausler

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

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

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 96f6a4d8ce36e..582892f8497b0 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1886,6 +1886,7 @@ void CheckHelper::CheckBindC(const Symbol &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 std::string * name{DefinesBindCName(symbol)}) {
     auto pair{bindC_.emplace(*name, symbol)};
@@ -1911,6 +1912,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
         !proc->interface().symbol()->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);
     }
   }
 }

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4da79c3c71713..ad3ede7a7d716 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3910,7 +3910,17 @@ bool DeclarationVisitor::Pre(const parser::BindEntity &x) {
     symbol = &MakeCommonBlockSymbol(name);
     symbol->attrs().set(Attr::BIND_C);
   }
-  SetBindNameOn(*symbol);
+  // 8.6.4(1)
+  // Some entities such as named constant or module name need to checked
+  // elsewhere. This is to skip the ICE caused by setting Bind name for non-name
+  // things such as data type and also checks for procedures.
+  if (symbol->has<CommonBlockDetails>() || symbol->has<ObjectEntityDetails>() ||
+      symbol->has<EntityDetails>()) {
+    SetBindNameOn(*symbol);
+  } else {
+    Say(name,
+        "Only variable and named common block can be in BIND statement"_err_en_US);
+  }
   return false;
 }
 bool DeclarationVisitor::Pre(const parser::OldParameterStmt &x) {

diff  --git a/flang/test/Semantics/bind-c02.f90 b/flang/test/Semantics/bind-c02.f90
new file mode 100644
index 0000000000000..c207e2a136df2
--- /dev/null
+++ b/flang/test/Semantics/bind-c02.f90
@@ -0,0 +1,47 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for 8.6.4(1)
+! The BIND statement specifies the BIND attribute for a list of variables and
+! common blocks.
+
+module m
+
+  interface
+    subroutine proc() bind(c)
+    end
+  end interface
+  procedure(proc), bind(c) :: pc1
+  !ERROR: Only variable and named common block can be in BIND statement
+  bind(c) :: proc
+  !ERROR: Only variable and named common block can be in BIND statement
+  bind(c) :: pc1
+
+  !ERROR: Only variable and named common block can be in BIND statement
+  bind(c) :: sub
+
+  bind(c) :: m ! no error for implicit type variable
+
+  type my_type
+    integer :: i
+  end type
+  !ERROR: Only variable and named common block can be in BIND statement
+  bind(c) :: my_type
+
+  enum, bind(c) ! no error
+    enumerator :: SUNDAY, MONDAY
+  end enum
+
+  integer :: x, y, z = 1
+  common /blk/ y
+  bind(c) :: x, /blk/, z ! no error for variable and common block
+
+  bind(c) :: implicit_i ! no error for implicit type variable
+
+  !ERROR: 'implicit_blk' appears as a COMMON block in a BIND statement but not in a COMMON statement
+  bind(c) :: /implicit_blk/
+
+contains
+
+  subroutine sub() bind(c)
+  end
+
+end