[flang-commits] [flang] 3fa62ef - [flang] Add semantic check for C1520

[Peixin Qiao via flang-commits]

Author: Peixin Qiao
Date: 2022-06-23T00:04:24+08:00
New Revision: 3fa62efdbb6c2b639cc47823c4a5f39fc1240792

URL: https://github.com/llvm/llvm-project/commit/3fa62efdbb6c2b639cc47823c4a5f39fc1240792
DIFF: https://github.com/llvm/llvm-project/commit/3fa62efdbb6c2b639cc47823c4a5f39fc1240792.diff

LOG: [flang] Add semantic check for C1520

As Fortran 2018 C1520, if proc-language-binding-spec with NAME= is
specified, then proc-decl-list shall contain exactly one proc-decl,
which shall neither have the POINTER attribute nor be a dummy procedure.
Add this check.

Reviewed By: klausler

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

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

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 9f5eeadd07b32..809d68a7efe28 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1871,7 +1871,8 @@ static const std::string *DefinesBindCName(const Symbol &symbol) {
   const auto *subp{symbol.detailsIf<SubprogramDetails>()};
   if ((subp && !subp->isInterface() &&
           ClassifyProcedure(symbol) != ProcedureDefinitionClass::Internal) ||
-      symbol.has<ObjectEntityDetails>() || symbol.has<CommonBlockDetails>()) {
+      symbol.has<ObjectEntityDetails>() || symbol.has<CommonBlockDetails>() ||
+      symbol.has<ProcEntityDetails>()) {
     // Symbol defines data or entry point
     return symbol.GetBindName();
   } else {

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d5e883feedfd9..875d86d9870b1 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1047,6 +1047,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   // Set when walking DATA & array constructor implied DO loop bounds
   // to warn about use of the implied DO intex therein.
   std::optional<SourceName> checkIndexUseInOwnBounds_;
+  bool hasBindCName_{false};
 
   bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
   Symbol &HandleAttributeStmt(Attr, const parser::Name &);
@@ -4679,12 +4680,22 @@ void DeclarationVisitor::Post(const parser::FillDecl &x) {
   }
   ClearArraySpec();
 }
-bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) {
+bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
   CHECK(!interfaceName_);
+  const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};
+  for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
+    if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
+      if (bindC->v.has_value()) {
+        hasBindCName_ = true;
+        break;
+      }
+    }
+  }
   return BeginDecl();
 }
 void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
   interfaceName_ = nullptr;
+  hasBindCName_ = false;
   EndDecl();
 }
 bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
@@ -4752,6 +4763,10 @@ void DeclarationVisitor::Post(const parser::ProcDecl &x) {
   if (dtDetails) {
     dtDetails->add_component(symbol);
   }
+  if (hasBindCName_ && (IsPointer(symbol) || IsDummy(symbol))) {
+    Say(symbol.name(),
+        "BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure"_err_en_US);
+  }
 }
 
 bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) {

diff  --git a/flang/test/Semantics/bind-c04.f90 b/flang/test/Semantics/bind-c04.f90
new file mode 100644
index 0000000000000..2be6b54f0ee0f
--- /dev/null
+++ b/flang/test/Semantics/bind-c04.f90
@@ -0,0 +1,36 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for C1520
+! If proc-language-binding-spec (bind(c)) with NAME= is specified, then
+! proc-decl-list shall contain exactly one proc-decl, which shall neither have
+! the POINTER attribute nor be a dummy procedure.
+
+subroutine sub(x, y)
+
+  interface
+    subroutine proc() bind(c)
+    end
+  end interface
+
+  !ERROR: Two symbols have the same BIND(C) name 'aaa'
+  procedure(proc), bind(c, name="aaa") :: pc1, pc2
+
+  !ERROR: BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure
+  procedure(proc), bind(c, name="bbb"), pointer :: pc3
+
+  !ERROR: BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure
+  procedure(proc), bind(c, name="ccc") :: x
+
+  procedure(proc), bind(c) :: pc4, pc5
+
+  !ERROR: BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure
+  procedure(proc), bind(c, name="pc6"), pointer :: pc6
+
+  procedure(proc), bind(c), pointer :: pc7
+
+  procedure(proc), bind(c) :: y
+
+  !WARNING: Attribute 'BIND(C)' cannot be used more than once
+  !ERROR: BIND(C) procedure with NAME= specified can neither have POINTER attribute nor be a dummy procedure
+  procedure(proc), bind(c, name="pc8"), bind(c), pointer :: pc8
+
+end

diff  --git a/flang/test/Semantics/modfile16.f90 b/flang/test/Semantics/modfile16.f90
index 2c596fc500814..88a7663519afd 100644
--- a/flang/test/Semantics/modfile16.f90
+++ b/flang/test/Semantics/modfile16.f90
@@ -2,7 +2,7 @@
 module m
   character(2), parameter :: prefix = 'c_'
   integer, bind(c, name='c_a') :: a
-  procedure(sub), bind(c, name=prefix//'b'), pointer :: b
+  procedure(sub), bind(c, name=prefix//'b') :: b
   type, bind(c) :: t
     real :: c
   end type
@@ -15,7 +15,7 @@ subroutine sub() bind(c, name='sub')
 !module m
 !  character(2_4,1),parameter::prefix="c_"
 !  integer(4),bind(c, name="c_a")::a
-!  procedure(sub),bind(c, name="c_b"),pointer::b
+!  procedure(sub),bind(c, name="c_b")::b
 !  type,bind(c)::t
 !    real(4)::c
 !  end type