Index: flang/lib/Semantics/check-declarations.cpp =================================================================== --- flang/lib/Semantics/check-declarations.cpp +++ flang/lib/Semantics/check-declarations.cpp @@ -1871,7 +1871,8 @@ const auto *subp{symbol.detailsIf()}; if ((subp && !subp->isInterface() && ClassifyProcedure(symbol) != ProcedureDefinitionClass::Internal) || - symbol.has() || symbol.has()) { + symbol.has() || symbol.has() || + symbol.has()) { // Symbol defines data or entry point return symbol.GetBindName(); } else { Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -1047,6 +1047,7 @@ // Set when walking DATA & array constructor implied DO loop bounds // to warn about use of the implied DO intex therein. std::optional checkIndexUseInOwnBounds_; + bool hasBindCName_{false}; bool HandleAttributeStmt(Attr, const std::list &); Symbol &HandleAttributeStmt(Attr, const parser::Name &); @@ -4679,12 +4680,22 @@ } ClearArraySpec(); } -bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &) { +bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) { CHECK(!interfaceName_); + const auto &procAttrSpec{std::get>(x.t)}; + for (const parser::ProcAttrSpec &procAttr : procAttrSpec) { + if (auto *bindC{std::get_if(&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 @@ 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 &) { Index: flang/test/Semantics/bind-c04.f90 =================================================================== --- /dev/null +++ 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 Index: flang/test/Semantics/modfile16.f90 =================================================================== --- flang/test/Semantics/modfile16.f90 +++ 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 @@ !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