From 543b15bca424f5a16076800bfcfe12f7ae0517ad Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Thu, 14 Feb 2019 07:59:20 -0800 Subject: [PATCH] [flang] Add support for common blocks A symbol for a common block has `CommonBlockDetails` which contains a list of the symbols that are in the common block. The name of the symbol for the blank common block is the empty string. That preserves the property that every symbol name is a substring of the cooked source. We use the 0-length substring starting at the COMMON statement so that when symbols are sorted by the location of the start of the name it ends up in the right place. Some of the checks on members of common blocks don't happen until the end of the scope. They can't happen earlier because we don't necessarily know the type and attributes. Enhance `test_errors.sh` so that multiple errors can be expected for a single line. Original-commit: flang-compiler/f18@2c4ca6b5d3e5798ef7815a52739a3e642bebd1c9 Reviewed-on: https://github.com/flang-compiler/f18/pull/286 --- flang/lib/semantics/mod-file.cc | 9 ++ flang/lib/semantics/resolve-names.cc | 162 +++++++++++++++++++++++++++++++---- flang/lib/semantics/symbol.cc | 7 ++ flang/lib/semantics/symbol.h | 11 ++- flang/lib/semantics/type.cc | 21 +++++ flang/lib/semantics/type.h | 1 + flang/test/semantics/CMakeLists.txt | 2 + flang/test/semantics/modfile21.f90 | 41 +++++++++ flang/test/semantics/resolve42.f90 | 119 +++++++++++++++++++++++++ flang/test/semantics/test_errors.sh | 8 +- 10 files changed, 363 insertions(+), 18 deletions(-) create mode 100644 flang/test/semantics/modfile21.f90 create mode 100644 flang/test/semantics/resolve42.f90 diff --git a/flang/lib/semantics/mod-file.cc b/flang/lib/semantics/mod-file.cc index f13ce14..1e32f93 100644 --- a/flang/lib/semantics/mod-file.cc +++ b/flang/lib/semantics/mod-file.cc @@ -173,6 +173,15 @@ void ModFileWriter::PutSymbol( } decls_ << '\n'; }, + [&](const CommonBlockDetails &x) { + PutLower(decls_ << "common/", symbol); + char sep = '/'; + for (const auto *object : x.objects()) { + PutLower(decls_ << sep, *object); + sep = ','; + } + decls_ << '\n'; + }, [&](const FinalProcDetails &) { PutLower(typeBindings << "final::", symbol) << '\n'; }, diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 0d336c0..685aac5 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -404,6 +404,8 @@ public: void SayAlreadyDeclared(const parser::Name &, const Symbol &); void SayWithDecl(const parser::Name &, const Symbol &, MessageFixedText &&); void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &); + void Say2(const SourceName &, MessageFixedText &&, const SourceName &, + MessageFixedText &&); void Say2(const parser::Name &, MessageFixedText &&, const Symbol &, MessageFixedText &&); @@ -690,6 +692,10 @@ public: bool Pre(const parser::StructureConstructor &); bool Pre(const parser::NamelistStmt::Group &); bool Pre(const parser::IoControlSpec &); + bool Pre(const parser::CommonStmt::Block &); + void Post(const parser::CommonStmt::Block &); + bool Pre(const parser::CommonBlockObject &); + void Post(const parser::CommonBlockObject &); protected: bool BeginDecl(); @@ -707,6 +713,7 @@ protected: bool CheckUseError(const parser::Name &); void CheckAccessibility(const parser::Name &, bool, const Symbol &); void CheckScalarIntegerType(const parser::Name &); + void CheckCommonBlocks(); private: // The attribute corresponding to the statement containing an ObjectDecl @@ -724,6 +731,11 @@ private: bool sawContains{false}; // currently processing bindings bool sequence{false}; // is a sequence type } derivedTypeInfo_; + // Info about common blocks in the current scope + struct { + Symbol *curr{nullptr}; // common block currently being processed + std::set names; // names in any common block of scope + } commonBlockInfo_; // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is // the interface name, if any. const parser::Name *interfaceName_{nullptr}; @@ -739,6 +751,7 @@ private: Symbol *MakeTypeSymbol(const parser::Name &, Details &&); bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr); ParamValue GetParamValue(const parser::TypeParamValue &); + void CheckCommonBlockDerivedType(const SourceName &, const Symbol &); // Declare an object or procedure entity. // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails @@ -771,6 +784,14 @@ private: } else { CHECK(!"unexpected kind"); } + } else if (std::is_same_v && + symbol.has()) { + SayWithDecl( + name, symbol, "'%s' is already declared as a procedure"_err_en_US); + } else if (std::is_same_v && + symbol.has()) { + SayWithDecl( + name, symbol, "'%s' is already declared as an object"_err_en_US); } else { SayAlreadyDeclared(name, symbol); } @@ -901,8 +922,6 @@ public: template bool Pre(const T &) { return true; } template void Post(const T &) {} - bool Pre(const parser::CommonBlockObject &); - void Post(const parser::CommonBlockObject &); bool Pre(const parser::PrefixSpec &); void Post(const parser::SpecificationPart &); bool Pre(const parser::MainProgram &); @@ -1439,10 +1458,14 @@ void ScopeHandler::SayDerivedType( .Attach(typeSymbol->name(), "Declaration of derived type '%s'"_en_US, typeSymbol->name().ToString().c_str()); } +void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1, + const SourceName &name2, MessageFixedText &&msg2) { + Say(name1, std::move(msg1)) + .Attach(name2, std::move(msg2), name2.ToString().c_str()); +} void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1, const Symbol &symbol, MessageFixedText &&msg2) { - Say(name.source, std::move(msg1)) - .Attach(symbol.name(), msg2, symbol.name().ToString().c_str()); + Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2)); } Scope &ScopeHandler::InclusiveScope() { @@ -1473,8 +1496,8 @@ void ScopeHandler::PushScope(Scope &scope) { } if (kind != Scope::Kind::DerivedType) { if (auto *symbol{scope.symbol()}) { - // Create a dummy symbol so we can't create another one with the same name - // It might already be there if we previously pushed the scope. + // Create a dummy symbol so we can't create another one with the same + // name. It might already be there if we previously pushed the scope. if (!FindInScope(scope, symbol->name())) { auto &newSymbol{CopySymbol(*symbol)}; if (kind == Scope::Kind::Subprogram) { @@ -3083,6 +3106,123 @@ bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { return true; } +bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) { + 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; + return true; +} + +void DeclarationVisitor::Post(const parser::CommonStmt::Block &) { + commonBlockInfo_.curr = nullptr; +} + +bool DeclarationVisitor::Pre(const parser::CommonBlockObject &x) { + BeginArraySpec(); + return true; +} + +void DeclarationVisitor::Post(const parser::CommonBlockObject &x) { + CHECK(commonBlockInfo_.curr); + const auto &name{std::get(x.t)}; + auto &symbol{DeclareObjectEntity(name, Attrs{})}; + ClearArraySpec(); + if (!symbol.has()) { + return; // error was reported + } + commonBlockInfo_.curr->get().add_object(symbol); + if (!IsExplicit(symbol.get().shape())) { + Say(name, + "The shape of common block object '%s' must be explicit"_err_en_US); + return; + } + auto pair{commonBlockInfo_.names.insert(name.source)}; + if (!pair.second) { + const SourceName &prev{*pair.first}; + Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev, + "Previous occurrence of '%s' in a COMMON block"_en_US); + return; + } +} + +// Check types of common block objects, now that they are known. +void DeclarationVisitor::CheckCommonBlocks() { + for (const auto &name : commonBlockInfo_.names) { + const auto *symbol{currScope().FindSymbol(name)}; + CHECK(symbol); + const auto &attrs{symbol->attrs()}; + if (attrs.test(Attr::ALLOCATABLE)) { + Say(name, + "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US); + } else if (attrs.test(Attr::BIND_C)) { + Say(name, + "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US); + } else if (const auto &details{symbol->get()}; + details.isDummy()) { + Say(name, + "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); + } else if (const DeclTypeSpec * type{details.type()}) { + if (type->category() == DeclTypeSpec::ClassStar) { + Say(name, + "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US); + } else if (const auto *derived{type->AsDerived()}) { + auto &typeSymbol{derived->typeSymbol()}; + if (!typeSymbol.attrs().test(Attr::BIND_C) && + !typeSymbol.get().sequence()) { + Say(name, + "Derived type '%s' in COMMON block must have the BIND or" + " SEQUENCE attribute"_err_en_US); + } + CheckCommonBlockDerivedType(name, typeSymbol); + } + } + } + commonBlockInfo_ = {}; +} + +// Check if this derived type can be in a COMMON block. +void DeclarationVisitor::CheckCommonBlockDerivedType( + const SourceName &name, const Symbol &typeSymbol) { + if (const auto *scope{typeSymbol.scope()}) { + for (const auto &pair : *scope) { + const Symbol &component{*pair.second}; + if (component.attrs().test(Attr::ALLOCATABLE)) { + Say2(name, + "Derived type variable '%s' may not appear in a COMMON block" + " due to ALLOCATABLE component"_err_en_US, + component.name(), "Component with ALLOCATABLE attribute"_en_US); + return; + } + if (const auto *details{component.detailsIf()}) { + if (details->init()) { + Say2(name, + "Derived type variable '%s' may not appear in a COMMON block" + " due to component with default initialization"_err_en_US, + component.name(), "Component with default initialization"_en_US); + return; + } + if (const auto *type{details->type()}) { + if (const auto *derived{type->AsDerived()}) { + CheckCommonBlockDerivedType(name, derived->typeSymbol()); + } + } + } + } + } +} + Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) { auto *prev{FindSymbol(name)}; bool implicit{false}; @@ -3627,15 +3767,6 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( // ResolveNamesVisitor implementation -bool ResolveNamesVisitor::Pre(const parser::CommonBlockObject &x) { - BeginArraySpec(); - return true; -} -void ResolveNamesVisitor::Post(const parser::CommonBlockObject &x) { - ClearArraySpec(); - // TODO: CommonBlockObject -} - bool ResolveNamesVisitor::Pre(const parser::PrefixSpec &x) { return true; // TODO } @@ -4005,6 +4136,7 @@ void ResolveNamesVisitor::Post(const parser::SpecificationPart &) { symbol.set(Symbol::Flag::Subroutine); } } + CheckCommonBlocks(); } void ResolveNamesVisitor::CheckImports() { diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc index 75df629..5f7ded7a 100644 --- a/flang/lib/semantics/symbol.cc +++ b/flang/lib/semantics/symbol.cc @@ -153,6 +153,7 @@ std::string DetailsToString(const Details &details) { [](const ProcBindingDetails &) { return "ProcBinding"; }, [](const GenericBindingDetails &) { return "GenericBinding"; }, [](const NamelistDetails &) { return "Namelist"; }, + [](const CommonBlockDetails &) { return "CommonBlockDetails"; }, [](const FinalProcDetails &) { return "FinalProc"; }, [](const TypeParamDetails &) { return "TypeParam"; }, [](const MiscDetails &) { return "Misc"; }, @@ -388,6 +389,12 @@ std::ostream &operator<<(std::ostream &os, const Details &details) { os << ' ' << object->name(); } }, + [&](const CommonBlockDetails &x) { + os << ": "; + for (const auto *object : x.objects()) { + os << ' ' << object->name(); + } + }, [&](const FinalProcDetails &) {}, [&](const TypeParamDetails &x) { if (x.type()) { diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h index df763d9..c94a83d 100644 --- a/flang/lib/semantics/symbol.h +++ b/flang/lib/semantics/symbol.h @@ -258,6 +258,15 @@ private: SymbolList objects_; }; +class CommonBlockDetails { +public: + SymbolList objects() const { return objects_; } + void add_object(Symbol &object) { objects_.push_back(&object); } + +private: + SymbolList objects_; +}; + class FinalProcDetails {}; class MiscDetails { @@ -366,7 +375,7 @@ using Details = std::variant; + CommonBlockDetails, FinalProcDetails, TypeParamDetails, MiscDetails>; std::ostream &operator<<(std::ostream &, const Details &); std::string DetailsToString(const Details &); diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index e48028f..4ddf6ee 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -194,6 +194,27 @@ std::ostream &operator<<(std::ostream &o, const ShapeSpec &x) { return o; } +std::ostream &operator<<(std::ostream &os, const ArraySpec &arraySpec) { + char sep{'('}; + for (auto &shape : arraySpec) { + os << sep << shape; + sep = ','; + } + if (sep == ',') { + os << ')'; + } + return os; +} + +bool IsExplicit(const ArraySpec &arraySpec) { + for (const auto &shapeSpec : arraySpec) { + if (!shapeSpec.isExplicit()) { + return false; + } + } + return true; +} + ParamValue::ParamValue(MaybeIntExpr &&expr) : expr_{std::move(expr)} {} ParamValue::ParamValue(SomeIntExpr &&expr) : expr_{std::move(expr)} {} ParamValue::ParamValue(std::int64_t value) diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index 1c9fab5..8b4962c 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -212,6 +212,7 @@ private: }; using ArraySpec = std::list; +bool IsExplicit(const ArraySpec &); class DerivedTypeSpec { public: diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 2ec0d84..1ef04fa 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -67,6 +67,7 @@ set(ERROR_TESTS resolve39.f90 resolve40.f90 resolve41.f90 + resolve42.f90 ) # These test files have expected symbols in the source @@ -108,6 +109,7 @@ set(MODFILE_TESTS modfile18.f90 modfile19.f90 modfile20.f90 + modfile21.f90 ) set(LABEL_TESTS diff --git a/flang/test/semantics/modfile21.f90 b/flang/test/semantics/modfile21.f90 new file mode 100644 index 0000000..13be400 --- /dev/null +++ b/flang/test/semantics/modfile21.f90 @@ -0,0 +1,41 @@ +! Copyright (c) 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. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +module m + logical b + common //t + common /cb/ x(2:10) /cb2/a,b,c + common /cb/ y,z + common w + common u,v + complex w + dimension b(4,4) +end + +!Expect: m.mod +!module m +! logical(4)::b(1_8:4_8,1_8:4_8) +! common//t,w,u,v +! real(4)::t +! common/cb/x,y,z +! real(4)::x(2_8:10_8) +! common/cb2/a,b,c +! real(4)::a +! real(4)::c +! real(4)::y +! real(4)::z +! complex(4)::w +! real(4)::u +! real(4)::v +!end diff --git a/flang/test/semantics/resolve42.f90 b/flang/test/semantics/resolve42.f90 new file mode 100644 index 0000000..854f093 --- /dev/null +++ b/flang/test/semantics/resolve42.f90 @@ -0,0 +1,119 @@ +! Copyright (c) 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. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +subroutine s1 + !ERROR: The shape of common block object 'z' must be explicit + common x, y(4), z(:) +end + +subroutine s2 + common /c1/ x, y, z + !ERROR: 'y' is already in a COMMON block + common y +end + +subroutine s3 + procedure(real) :: x + !ERROR: 'x' is already declared as a procedure + common x + common y + !ERROR: 'y' is already declared as an object + 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 + common x(4), y(4) + !ERROR: The dimensions of 'y' have already been declared + real y(2) +end + +subroutine s6(x) + !ERROR: Dummy argument 'x' may not appear in a COMMON block + !ERROR: ALLOCATABLE object 'y' may not appear in a COMMON block + common x,y,z + allocatable y +end + +module m7 + !ERROR: Variable 'z' with BIND attribute may not appear in a COMMON block + common z + integer, bind(c) :: z +end + +module m8 + type t + end type + class(*), pointer :: x + !ERROR: Unlimited polymorphic pointer 'x' may not appear in a COMMON block + !ERROR: Unlimited polymorphic pointer 'y' may not appear in a COMMON block + common x, y + class(*), pointer :: y +end + +module m9 + integer x +end +subroutine s9 + use m9 + !ERROR: 'x' is use-associated from module 'm9' and cannot be re-declared + common x +end + +module m10 + type t + end type + type(t) :: x + !ERROR: Derived type 'x' in COMMON block must have the BIND or SEQUENCE attribute + common x +end + +module m11 + type t1 + sequence + integer, allocatable :: a + end type + type t2 + sequence + type(t1) :: b + integer:: c + end type + type(t2) :: x2 + !ERROR: Derived type variable 'x2' may not appear in a COMMON block due to ALLOCATABLE component + common x2 +end + +module m12 + type t1 + sequence + integer :: a = 123 + end type + type t2 + sequence + type(t1) :: b + integer:: c + end type + type(t2) :: x2 + !ERROR: Derived type variable 'x2' may not appear in a COMMON block due to component with default initialization + common x2 +end diff --git a/flang/test/semantics/test_errors.sh b/flang/test/semantics/test_errors.sh index b36030b..74f03ea 100755 --- a/flang/test/semantics/test_errors.sh +++ b/flang/test/semantics/test_errors.sh @@ -1,5 +1,5 @@ #!/usr/bin/env bash -# 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. @@ -47,7 +47,11 @@ fi # $actual has errors from the compiler; $expect has them from !ERROR comments in source # Format both as ": " so they can be diffed. sed -n 's=^[^:]*:\([^:]*\):[^:]*: error: =\1: =p' $log > $actual -{ echo; cat $src; } | cat -n | sed -n 's=^ *\([0-9]*\). *\!ERROR: *=\1: =p' > $expect +awk ' + BEGIN { FS = "!ERROR: "; } + /^ *!ERROR: / { errors[nerrors++] = $2; next; } + { for (i = 0; i < nerrors; ++i) printf "%d: %s\n", NR, errors[i]; nerrors = 0; } +' $src > $expect if diff -U0 $actual $expect > $diffs; then echo PASS -- 2.7.4