diff options
author | Peixin-Qiao <qiaopeixin@huawei.com> | 2022-06-29 11:25:19 +0800 |
---|---|---|
committer | Peixin-Qiao <qiaopeixin@huawei.com> | 2022-06-29 11:25:19 +0800 |
commit | 779d2470a45393b981eff706662922f320859681 (patch) | |
tree | 7e4a9b09026324110ab74d61cead7c2d8e5012c5 | |
parent | c967c3d39bc0dc247052a952bd84a8b539f54e45 (diff) | |
download | llvm-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.cpp | 2 | ||||
-rw-r--r-- | flang/lib/Semantics/resolve-names.cpp | 12 | ||||
-rw-r--r-- | flang/test/Semantics/bind-c02.f90 | 47 |
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 |