From a6874f8ee81d0620faf4857c7edf0a6c86163ead Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Mon, 18 Feb 2019 11:39:46 -0800 Subject: [PATCH] [flang] More work on COMMON blocks Common block names can't clash with other names, so add `commonBlocks_` to `Scope` to record the common blocks of a scoping unit. This requires changes to how scopes are dumped and written to `.mod` files. Support common blocks in BIND statements. Add optional bind-name to `CommonBlockDetails`. Add `CheckNotInBlock()` for checking statements that are not allowed in block constructs. In `rewrite-parse-tree.cc`, no longer skip check for resolved names in common statements. But do skip the checks in compiler directives. Original-commit: flang-compiler/f18@805a1ffd9b7f33ce95d334ef5fe3e864b9f3d69e Reviewed-on: https://github.com/flang-compiler/f18/pull/298 Tree-same-pre-rewrite: false --- flang/lib/semantics/mod-file.cc | 10 ++++ flang/lib/semantics/resolve-names.cc | 93 +++++++++++++++++++------------ flang/lib/semantics/rewrite-parse-tree.cc | 2 +- flang/lib/semantics/scope.cc | 19 +++++++ flang/lib/semantics/scope.h | 6 ++ flang/lib/semantics/semantics.cc | 5 ++ flang/lib/semantics/symbol.cc | 4 +- flang/lib/semantics/symbol.h | 3 + flang/test/semantics/implicit08.f90 | 4 +- flang/test/semantics/modfile21.f90 | 9 ++- flang/test/semantics/resolve42.f90 | 24 +++++--- 11 files changed, 128 insertions(+), 51 deletions(-) diff --git a/flang/lib/semantics/mod-file.cc b/flang/lib/semantics/mod-file.cc index cfd49d3..d70b3ea 100644 --- a/flang/lib/semantics/mod-file.cc +++ b/flang/lib/semantics/mod-file.cc @@ -181,6 +181,10 @@ void ModFileWriter::PutSymbol( sep = ','; } decls_ << '\n'; + if (symbol.attrs().test(Attr::BIND_C)) { + PutAttrs(decls_, symbol.attrs(), x.bindName(), ""s); + PutLower(decls_ << "::/", symbol) << "/\n"; + } }, [&](const FinalProcDetails &) { PutLower(typeBindings << "final::", symbol) << '\n'; @@ -310,6 +314,12 @@ std::vector CollectSymbols(const Scope &scope) { } } } + for (const auto &pair : scope.commonBlocks()) { + auto *symbol{pair.second}; + if (symbols.insert(symbol).second) { + sorted.push_back(symbol); + } + } std::sort(sorted.begin(), sorted.end(), [](const Symbol *x, const Symbol *y) { bool xIsNml{x->has()}; bool yIsNml{y->has()}; diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 9b49838..3adadbb 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -98,10 +98,9 @@ public: const SourceName *currStmtSource() { return currStmtSource_; } void set_currStmtSource(const SourceName *); - // Emit a message - Message &Say(Message &&); // Emit a message associated with the current statement source. Message &Say(MessageFixedText &&); + Message &Say(MessageFormattedText &&); // Emit a message about a SourceName Message &Say(const SourceName &, MessageFixedText &&); // Emit a formatted message associated with a source location. @@ -620,10 +619,10 @@ public: using ArraySpecVisitor::Post; using ArraySpecVisitor::Pre; + bool Pre(const parser::ImplicitStmt &); void Post(const parser::EntityDecl &); void Post(const parser::ObjectDecl &); void Post(const parser::PointerDecl &); - bool Pre(const parser::BindStmt &) { return BeginAttrs(); } void Post(const parser::BindStmt &) { EndAttrs(); } bool Pre(const parser::BindEntity &); @@ -744,6 +743,7 @@ private: // the interface name, if any. const parser::Name *interfaceName_{nullptr}; + bool CheckNotInBlock(const char *); bool HandleAttributeStmt(Attr, const std::list &); Symbol &HandleAttributeStmt(Attr, const parser::Name &); Symbol &DeclareUnknownEntity(const parser::Name &, Attrs); @@ -755,6 +755,7 @@ private: Symbol *MakeTypeSymbol(const parser::Name &, Details &&); bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr); ParamValue GetParamValue(const parser::TypeParamValue &); + Symbol &MakeCommonBlockSymbol(const parser::Name &); void CheckCommonBlockDerivedType(const SourceName &, const Symbol &); // Declare an object or procedure entity. @@ -931,7 +932,6 @@ public: bool Pre(const parser::MainProgram &); void Post(const parser::EndProgramStmt &); void Post(const parser::Program &); - bool Pre(const parser::ImplicitStmt &); void Post(const parser::PointerObject &); void Post(const parser::AllocateObject &); void Post(const parser::PointerAssignmentStmt &); @@ -1115,6 +1115,7 @@ bool AttrsVisitor::SetBindNameOn(Symbol &symbol) { [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); }, [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); }, + [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); }, [](auto &) { common::die("unexpected bind name"); }, }, symbol.details()); @@ -1250,6 +1251,10 @@ Message &MessageHandler::Say(MessageFixedText &&msg) { CHECK(currStmtSource_); return messages_->Say(*currStmtSource_, std::move(msg)); } +Message &MessageHandler::Say(MessageFormattedText &&msg) { + CHECK(currStmtSource_); + return messages_->Say(*currStmtSource_, std::move(msg)); +} Message &MessageHandler::Say(const SourceName &name, MessageFixedText &&msg) { return Say(name, std::move(msg), name); } @@ -2443,6 +2448,10 @@ void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) { DeclareObjectEntity(name, Attrs{}); } +bool DeclarationVisitor::Pre(const parser::ImplicitStmt &x) { + return CheckNotInBlock("IMPLICIT") && ImplicitRulesVisitor::Pre(x); +} + void DeclarationVisitor::Post(const parser::EntityDecl &x) { // TODO: may be under StructureStmt const auto &name{std::get(x.t)}; @@ -2466,13 +2475,16 @@ void DeclarationVisitor::Post(const parser::PointerDecl &x) { } bool DeclarationVisitor::Pre(const parser::BindEntity &x) { + auto kind{std::get(x.t)}; auto &name{std::get(x.t)}; - if (std::get(x.t) == - parser::BindEntity::Kind::Object) { - HandleAttributeStmt(Attr::BIND_C, name); + Symbol *symbol; + if (kind == parser::BindEntity::Kind::Object) { + symbol = &HandleAttributeStmt(Attr::BIND_C, name); } else { - // TODO: name is common block + symbol = &MakeCommonBlockSymbol(name); + symbol->attrs().set(Attr::BIND_C); } + SetBindNameOn(*symbol); return false; } bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { @@ -2518,19 +2530,21 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) { bool DeclarationVisitor::Pre(const parser::IntentStmt &x) { auto &intentSpec{std::get(x.t)}; auto &names{std::get>(x.t)}; - return HandleAttributeStmt(IntentSpecToAttr(intentSpec), names); + return CheckNotInBlock("INTENT") && + HandleAttributeStmt(IntentSpecToAttr(intentSpec), names); } bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) { return HandleAttributeStmt(Attr::INTRINSIC, x.v); } bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) { - return HandleAttributeStmt(Attr::OPTIONAL, x.v); + return CheckNotInBlock("OPTIONAL") && + HandleAttributeStmt(Attr::OPTIONAL, x.v); } bool DeclarationVisitor::Pre(const parser::ProtectedStmt &x) { return HandleAttributeStmt(Attr::PROTECTED, x.v); } bool DeclarationVisitor::Pre(const parser::ValueStmt &x) { - return HandleAttributeStmt(Attr::VALUE, x.v); + return CheckNotInBlock("VALUE") && HandleAttributeStmt(Attr::VALUE, x.v); } bool DeclarationVisitor::Pre(const parser::VolatileStmt &x) { return HandleAttributeStmt(Attr::VOLATILE, x.v); @@ -2559,12 +2573,19 @@ Symbol &DeclarationVisitor::HandleAttributeStmt( symbol = &MakeSymbol(name, EntityDetails{}); } symbol->attrs().set(attr); - if (SetBindNameOn(*symbol)) { - CHECK(attr == Attr::BIND_C); - } return *symbol; } +bool DeclarationVisitor::CheckNotInBlock(const char *stmt) { + if (currScope().kind() == Scope::Kind::Block) { + Say(MessageFormattedText{ + "%s statement is not allowed in a BLOCK construct"_err_en_US, stmt}); + return false; + } else { + return true; + } +} + void DeclarationVisitor::Post(const parser::ObjectDecl &x) { CHECK(objectDeclAttr_.has_value()); const auto &name{std::get(x.t)}; @@ -3174,8 +3195,7 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { } bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) { - if (currScope().kind() == Scope::Kind::Block) { - Say("NAMELIST statement is not allowed in a BLOCK construct"_err_en_US); + if (!CheckNotInBlock("NAMELIST")) { return false; } @@ -3217,21 +3237,13 @@ bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { } bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { + CheckNotInBlock("COMMON"); const auto &optName{std::get>(x.t)}; parser::Name blankCommon; blankCommon.source = SourceName{currStmtSource()->begin(), std::size_t{0}}; - const parser::Name &name{optName ? *optName : blankCommon}; - auto *symbol{FindInScope(currScope(), name)}; - if (symbol && !symbol->has()) { - SayAlreadyDeclared(name, *symbol); - EraseSymbol(name); - symbol = nullptr; - } - if (!symbol) { - symbol = &MakeSymbol(name, CommonBlockDetails{}); - } CHECK(!commonBlockInfo_.curr); - commonBlockInfo_.curr = symbol; + commonBlockInfo_.curr = + &MakeCommonBlockSymbol(optName ? *optName : blankCommon); return true; } @@ -3269,9 +3281,22 @@ void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { // Check types of common block objects, now that they are known. void DeclarationVisitor::CheckCommonBlocks() { + // check for empty common blocks + for (const auto pair : currScope().commonBlocks()) { + const auto &symbol{*pair.second}; + if (symbol.get().objects().empty() && + symbol.attrs().test(Attr::BIND_C)) { + Say(symbol.name(), + "'%s' appears as a COMMON block in a BIND statement but not in" + " a COMMON statement"_err_en_US); + } + } + // check objects in common blocks for (const auto &name : commonBlockInfo_.names) { const auto *symbol{currScope().FindSymbol(name)}; - CHECK(symbol); + if (symbol == nullptr) { + continue; + } const auto &attrs{symbol->attrs()}; if (attrs.test(Attr::ALLOCATABLE)) { Say(name, @@ -3302,6 +3327,10 @@ void DeclarationVisitor::CheckCommonBlocks() { commonBlockInfo_ = {}; } +Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { + return Resolve(name, currScope().MakeCommonBlock(name.source)); +} + // Check if this derived type can be in a COMMON block. void DeclarationVisitor::CheckCommonBlockDerivedType( const SourceName &name, const Symbol &typeSymbol) { @@ -4271,14 +4300,6 @@ bool ResolveNamesVisitor::Pre(const parser::MainProgram &x) { void ResolveNamesVisitor::Post(const parser::EndProgramStmt &) { PopScope(); } -bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { - if (currScope().kind() == Scope::Kind::Block) { - Say("IMPLICIT statement is not allowed in BLOCK construct"_err_en_US); - return false; - } - return ImplicitRulesVisitor::Pre(x); -} - void ResolveNamesVisitor::Post(const parser::PointerObject &x) { std::visit( common::visitors{ diff --git a/flang/lib/semantics/rewrite-parse-tree.cc b/flang/lib/semantics/rewrite-parse-tree.cc index 5890e21..841ca5e 100644 --- a/flang/lib/semantics/rewrite-parse-tree.cc +++ b/flang/lib/semantics/rewrite-parse-tree.cc @@ -41,10 +41,10 @@ public: void Post(parser::Expr &x) { ConvertFunctionRef(x); } // Name resolution yet implemented: - bool Pre(parser::CommonStmt &) { return false; } bool Pre(parser::EquivalenceStmt &) { return false; } bool Pre(parser::Keyword &) { return false; } bool Pre(parser::EntryStmt &) { return false; } + bool Pre(parser::CompilerDirective &) { return false; } // Don't bother resolving names in end statements. bool Pre(parser::EndBlockDataStmt &) { return false; } diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc index 4f39bef..fa80c4b 100644 --- a/flang/lib/semantics/scope.cc +++ b/flang/lib/semantics/scope.cc @@ -58,6 +58,21 @@ Symbol *Scope::FindSymbol(const SourceName &name) const { return nullptr; } } +Symbol &Scope::MakeCommonBlock(const SourceName &name) { + const auto it{commonBlocks_.find(name)}; + if (it != commonBlocks_.end()) { + return *it->second; + } else { + Symbol &symbol{MakeSymbol(name, Attrs{}, CommonBlockDetails{})}; + commonBlocks_.emplace(name, &symbol); + return symbol; + } +} +Symbol *Scope::FindCommonBlock(const SourceName &name) { + const auto it{commonBlocks_.find(name)}; + return it != commonBlocks_.end() ? it->second : nullptr; +} + Scope *Scope::FindSubmodule(const SourceName &name) const { auto it{submodules_.find(name)}; if (it == submodules_.end()) { @@ -204,6 +219,10 @@ std::ostream &operator<<(std::ostream &os, const Scope &scope) { const auto *symbol{pair.second}; os << " " << *symbol << '\n'; } + for (const auto &pair : scope.commonBlocks_) { + const auto *symbol{pair.second}; + os << " " << *symbol << '\n'; + } return os; } diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h index ded89c3..c1fd911 100644 --- a/flang/lib/semantics/scope.h +++ b/flang/lib/semantics/scope.h @@ -119,6 +119,11 @@ public: return symbols_.emplace(name, &symbol); } + mapType &commonBlocks() { return commonBlocks_; } + const mapType &commonBlocks() const { return commonBlocks_; } + Symbol &MakeCommonBlock(const SourceName &); + Symbol *FindCommonBlock(const SourceName &); + /// Make a Symbol but don't add it to the scope. template Symbol &MakeSymbol(const SourceName &name, Attrs attrs, D &&details) { @@ -193,6 +198,7 @@ private: Symbol *const symbol_; // if not null, symbol_->scope() == this std::list children_; mapType symbols_; + mapType commonBlocks_; std::map submodules_; std::list declTypeSpecs_; std::string chars_; diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index cd293c9..516b37017 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -117,6 +117,11 @@ void DoDumpSymbols(std::ostream &os, const Scope &scope, int indent) { } } } + for (const auto &pair : scope.commonBlocks()) { + const auto &symbol{*pair.second}; + PutIndent(os, indent); + os << symbol << '\n'; + } for (const auto &child : scope.children()) { DoDumpSymbols(os, child, indent); } diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc index 9e8b084..6e978cf 100644 --- a/flang/lib/semantics/symbol.cc +++ b/flang/lib/semantics/symbol.cc @@ -387,13 +387,13 @@ std::ostream &operator<<(std::ostream &os, const Details &details) { } }, [&](const NamelistDetails &x) { - os << ": "; + os << ':'; for (const auto *object : x.objects()) { os << ' ' << object->name(); } }, [&](const CommonBlockDetails &x) { - os << ": "; + os << ':'; for (const auto *object : x.objects()) { os << ' ' << object->name(); } diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h index 9dc89fd..18c0479 100644 --- a/flang/lib/semantics/symbol.h +++ b/flang/lib/semantics/symbol.h @@ -278,9 +278,12 @@ class CommonBlockDetails { public: SymbolList objects() const { return objects_; } void add_object(Symbol &object) { objects_.push_back(&object); } + MaybeExpr bindName() const { return bindName_; } + void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); } private: SymbolList objects_; + MaybeExpr bindName_; }; class FinalProcDetails {}; diff --git a/flang/test/semantics/implicit08.f90 b/flang/test/semantics/implicit08.f90 index ea8de3e..0d98c4f 100644 --- a/flang/test/semantics/implicit08.f90 +++ b/flang/test/semantics/implicit08.f90 @@ -1,4 +1,4 @@ -! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +! Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. @@ -14,7 +14,7 @@ subroutine s1 block - !ERROR: IMPLICIT statement is not allowed in BLOCK construct + !ERROR: IMPLICIT statement is not allowed in a BLOCK construct implicit logical(a) end block end subroutine diff --git a/flang/test/semantics/modfile21.f90 b/flang/test/semantics/modfile21.f90 index 13be400..04a5ce95 100644 --- a/flang/test/semantics/modfile21.f90 +++ b/flang/test/semantics/modfile21.f90 @@ -14,6 +14,7 @@ module m logical b + bind(C) :: /cb2/ common //t common /cb/ x(2:10) /cb2/a,b,c common /cb/ y,z @@ -21,16 +22,20 @@ module m common u,v complex w dimension b(4,4) + bind(C, name="CB") /cb/ + common /b/ cb end !Expect: m.mod !module m ! logical(4)::b(1_8:4_8,1_8:4_8) +! common/cb2/a,b,c +! bind(c)::/cb2/ ! common//t,w,u,v ! real(4)::t ! common/cb/x,y,z +! bind(c, name=1_"CB")::/cb/ ! real(4)::x(2_8:10_8) -! common/cb2/a,b,c ! real(4)::a ! real(4)::c ! real(4)::y @@ -38,4 +43,6 @@ end ! complex(4)::w ! real(4)::u ! real(4)::v +! common/b/cb +! real(4)::cb !end diff --git a/flang/test/semantics/resolve42.f90 b/flang/test/semantics/resolve42.f90 index 854f093..22461c9 100644 --- a/flang/test/semantics/resolve42.f90 +++ b/flang/test/semantics/resolve42.f90 @@ -32,14 +32,6 @@ subroutine s3 procedure(real) :: y end -subroutine s4 - integer x - !ERROR: 'x' is already declared in this scoping unit - common /x/ y - !ERROR: 's4' is already declared in this scoping unit - common /s4/ z -end - subroutine s5 integer x(2) !ERROR: The dimensions of 'x' have already been declared @@ -56,9 +48,11 @@ subroutine s6(x) end module m7 + !ERROR: Variable 'w' with BIND attribute may not appear in a COMMON block !ERROR: Variable 'z' with BIND attribute may not appear in a COMMON block - common z + common w,z integer, bind(c) :: z + integer, bind(c,name="w") :: w end module m8 @@ -117,3 +111,15 @@ module m12 !ERROR: Derived type variable 'x2' may not appear in a COMMON block due to component with default initialization common x2 end + +subroutine s13 + block + !ERROR: COMMON statement is not allowed in a BLOCK construct + common x + end block +end + +subroutine s14 + !ERROR: 'c' appears as a COMMON block in a BIND statement but not in a COMMON statement + bind(c) :: /c/ +end -- 2.7.4