aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeixin-Qiao <qiaopeixin@huawei.com>2022-06-29 11:25:19 +0800
committerPeixin-Qiao <qiaopeixin@huawei.com>2022-06-29 11:25:19 +0800
commit779d2470a45393b981eff706662922f320859681 (patch)
tree7e4a9b09026324110ab74d61cead7c2d8e5012c5
parentc967c3d39bc0dc247052a952bd84a8b539f54e45 (diff)
downloadllvm-779d2470a45393b981eff706662922f320859681.zip
llvm-779d2470a45393b981eff706662922f320859681.tar.gz
llvm-779d2470a45393b981eff706662922f320859681.tar.bz2
[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
-rw-r--r--flang/lib/Semantics/check-declarations.cpp2
-rw-r--r--flang/lib/Semantics/resolve-names.cpp12
-rw-r--r--flang/test/Semantics/bind-c02.f9047
3 files changed, 60 insertions, 1 deletions
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 96f6a4d..582892f 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 4da79c3..ad3ede7 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 0000000..c207e2a
--- /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