From 996ef895cd3d1313665a42fc8e20d1d4e1cf2a28 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Thu, 18 Nov 2021 11:48:42 -0800 Subject: [PATCH] [flang] Add -fno-automatic, refine IsSaved() This legacy option (available in other Fortran compilers with various spellings) implies the SAVE attribute for local variables on subprograms that are not explicitly RECURSIVE. The SAVE attribute essentially implies static rather than stack storage. This was the default setting in Fortran until surprisingly recently, so explicit SAVE statements & attributes could be and often were omitted from older codes. Note that initialized objects already have an implied SAVE attribute, and objects in COMMON effectively do too, as data overlays are extinct; and since objects that are expected to survive from one invocation of a procedure to the next in static storage should probably be explicit initialized in the first place, so the use cases for this option are somewhat rare, and all of them could be handled with explicit SAVE statements or attributes. This implicit SAVE attribute must not apply to automatic (in the Fortran sense) local objects, whose sizes cannot be known at compilation time. To get the semantics of IsSaved() right, the IsAutomatic() predicate was moved into Evaluate/tools.cpp to allow for dynamic linking of the compiler. The redundant predicate IsAutomatic() was noticed, removed, and its uses replaced. GNU Fortran's spelling of the option (-fno-automatic) was added to the clang-based driver and used for basic sanity testing. Differential Revision: https://reviews.llvm.org/D114209 --- clang/include/clang/Driver/Options.td | 5 +- clang/lib/Driver/ToolChains/Flang.cpp | 3 +- flang/include/flang/Common/Fortran-features.h | 3 +- flang/include/flang/Evaluate/tools.h | 1 + flang/include/flang/Semantics/tools.h | 2 - flang/lib/Evaluate/tools.cpp | 80 +++++++++++++++++-- flang/lib/Frontend/CompilerInvocation.cpp | 5 ++ flang/lib/Semantics/resolve-names-utils.cpp | 2 +- flang/lib/Semantics/runtime-type-info.cpp | 2 +- flang/lib/Semantics/tools.cpp | 72 ----------------- flang/test/Driver/driver-help-hidden.f90 | 1 + flang/test/Driver/driver-help.f90 | 2 + flang/test/Semantics/entry01.f90 | 1 - flang/test/Semantics/save01.f90 | 8 ++ flang/test/Semantics/save02.f90 | 9 +++ 15 files changed, 109 insertions(+), 87 deletions(-) create mode 100644 flang/test/Semantics/save02.f90 diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td index 9bde64cf49fd..7730b7d1915e 100644 --- a/clang/include/clang/Driver/Options.td +++ b/clang/include/clang/Driver/Options.td @@ -4519,7 +4519,7 @@ def frecord_marker_EQ : Joined<["-"], "frecord-marker=">, Group; defm aggressive_function_elimination : BooleanFFlag<"aggressive-function-elimination">, Group; defm align_commons : BooleanFFlag<"align-commons">, Group; defm all_intrinsics : BooleanFFlag<"all-intrinsics">, Group; -defm automatic : BooleanFFlag<"automatic">, Group; +def fautomatic : Flag<["-"], "fautomatic">; // -fno-automatic is significant defm backtrace : BooleanFFlag<"backtrace">, Group; defm bounds_check : BooleanFFlag<"bounds-check">, Group; defm check_array_temporaries : BooleanFFlag<"check-array-temporaries">, Group; @@ -4616,6 +4616,9 @@ defm backslash : OptInFC1FFlag<"backslash", "Specify that backslash in string in defm xor_operator : OptInFC1FFlag<"xor-operator", "Enable .XOR. as a synonym of .NEQV.">; defm logical_abbreviations : OptInFC1FFlag<"logical-abbreviations", "Enable logical abbreviations">; defm implicit_none : OptInFC1FFlag<"implicit-none", "No implicit typing allowed unless overridden by IMPLICIT statements">; + +def fno_automatic : Flag<["-"], "fno-automatic">, Group, + HelpText<"Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE">; } def J : JoinedOrSeparate<["-"], "J">, diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp index b82c5d7600df..c169e3d45793 100644 --- a/clang/lib/Driver/ToolChains/Flang.cpp +++ b/clang/lib/Driver/ToolChains/Flang.cpp @@ -32,7 +32,8 @@ void Flang::AddFortranDialectOptions(const ArgList &Args, options::OPT_fxor_operator, options::OPT_fno_xor_operator, options::OPT_falternative_parameter_statement, options::OPT_fdefault_real_8, options::OPT_fdefault_integer_8, - options::OPT_fdefault_double_8, options::OPT_flarge_sizes}); + options::OPT_fdefault_double_8, options::OPT_flarge_sizes, + options::OPT_fno_automatic}); } void Flang::AddPreprocessingOptions(const ArgList &Args, diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index ddce79405632..f5fe2b5de475 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -31,7 +31,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile, ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways, ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger, - DistinguishableSpecifics) + DistinguishableSpecifics, DefaultSave) using LanguageFeatures = EnumSet; @@ -44,6 +44,7 @@ public: disable_.set(LanguageFeature::OpenMP); disable_.set(LanguageFeature::ImplicitNoneTypeNever); disable_.set(LanguageFeature::ImplicitNoneTypeAlways); + disable_.set(LanguageFeature::DefaultSave); // These features, if enabled, conflict with valid standard usage, // so there are disabled here by default. disable_.set(LanguageFeature::BackslashEscapes); diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index a3d70b6c4630..df56a3b0cb04 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1050,6 +1050,7 @@ bool IsFunction(const Scope &); bool IsProcedure(const Symbol &); bool IsProcedure(const Scope &); bool IsProcedurePointer(const Symbol &); +bool IsAutomatic(const Symbol &); bool IsSaved(const Symbol &); // saved implicitly or explicitly bool IsDummy(const Symbol &); bool IsFunctionResult(const Symbol &); diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index e5ed412cde9d..6ab3e5e24588 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -111,7 +111,6 @@ bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false); bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr); bool HasIntrinsicTypeName(const Symbol &); bool IsSeparateModuleProcedureInterface(const Symbol *); -bool IsAutomatic(const Symbol &); bool HasAlternateReturns(const Symbol &); bool InCommonBlock(const Symbol &); @@ -167,7 +166,6 @@ bool IsFinalizable( bool HasImpureFinal(const DerivedTypeSpec &); bool IsCoarray(const Symbol &); bool IsInBlankCommon(const Symbol &); -bool IsAutomaticObject(const Symbol &); inline bool IsAssumedSizeArray(const Symbol &symbol) { const auto *details{symbol.detailsIf()}; return details && details->IsAssumedSize(); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 4b0bedd9c7a8..86600ca96279 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1149,21 +1149,87 @@ bool IsProcedurePointer(const Symbol &original) { return symbol.has() && IsPointer(symbol); } +// 3.11 automatic data object +bool IsAutomatic(const Symbol &original) { + const Symbol &symbol{original.GetUltimate()}; + if (const auto *object{symbol.detailsIf()}) { + if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) { + if (const DeclTypeSpec * type{symbol.GetType()}) { + // If a type parameter value is not a constant expression, the + // object is automatic. + if (type->category() == DeclTypeSpec::Character) { + if (const auto &length{ + type->characterTypeSpec().length().GetExplicit()}) { + if (!evaluate::IsConstantExpr(*length)) { + return true; + } + } + } else if (const DerivedTypeSpec * derived{type->AsDerived()}) { + for (const auto &pair : derived->parameters()) { + if (const auto &value{pair.second.GetExplicit()}) { + if (!evaluate::IsConstantExpr(*value)) { + return true; + } + } + } + } + } + // If an array bound is not a constant expression, the object is + // automatic. + for (const ShapeSpec &dim : object->shape()) { + if (const auto &lb{dim.lbound().GetExplicit()}) { + if (!evaluate::IsConstantExpr(*lb)) { + return true; + } + } + if (const auto &ub{dim.ubound().GetExplicit()}) { + if (!evaluate::IsConstantExpr(*ub)) { + return true; + } + } + } + } + } + return false; +} + bool IsSaved(const Symbol &original) { const Symbol &symbol{GetAssociationRoot(original)}; const Scope &scope{symbol.owner()}; auto scopeKind{scope.kind()}; if (symbol.has()) { return false; // ASSOCIATE(non-variable) - } else if (scopeKind == Scope::Kind::Module) { - return true; // BLOCK DATA entities must all be in COMMON, handled below } else if (scopeKind == Scope::Kind::DerivedType) { return false; // this is a component } else if (symbol.attrs().test(Attr::SAVE)) { - return true; + return true; // explicit SAVE attribute } else if (symbol.test(Symbol::Flag::InDataStmt)) { return true; + } else if (IsDummy(symbol) || IsFunctionResult(symbol) || + IsAutomatic(symbol)) { + return false; + } else if (scopeKind == Scope::Kind::Module || + (scopeKind == Scope::Kind::MainProgram && + (symbol.attrs().test(Attr::TARGET) || IsCoarray(symbol)))) { + // 8.5.16p4 + // In main programs, implied SAVE matters only for pointer + // initialization targets and coarrays. + // BLOCK DATA entities must all be in COMMON, + // which was checked above. + return true; + } else if (scope.kind() == Scope::Kind::Subprogram && + scope.context().languageFeatures().IsEnabled( + common::LanguageFeature::DefaultSave) && + !(scope.symbol() && scope.symbol()->attrs().test(Attr::RECURSIVE))) { + // -fno-automatic/-save/-Msave option applies to objects in + // executable subprograms unless they are explicitly RECURSIVE. + return true; } else if (IsNamedConstant(symbol)) { + // TODO: lowering needs named constants in modules to be static, + // so this test for a named constant has lower precedence for the + // time being; when lowering is corrected, this case should be + // moved up above module logic, since named constants don't really + // have implied SAVE attributes. return false; } else if (const auto *object{symbol.detailsIf()}; object && object->init()) { @@ -1171,13 +1237,13 @@ bool IsSaved(const Symbol &original) { } else if (IsProcedurePointer(symbol) && symbol.get().init()) { return true; + } else if (scope.hasSAVE()) { + return true; // bare SAVE statement } else if (const Symbol * block{FindCommonBlockContaining(symbol)}; block && block->attrs().test(Attr::SAVE)) { - return true; - } else if (IsDummy(symbol) || IsFunctionResult(symbol)) { - return false; + return true; // in COMMON with SAVE } else { - return scope.hasSAVE(); + return false; } } diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp index c16c9690f059..acdfcb804390 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -310,6 +310,11 @@ static bool ParseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args, args.hasFlag(clang::driver::options::OPT_fxor_operator, clang::driver::options::OPT_fno_xor_operator, false)); + // -fno-automatic + if (args.hasArg(clang::driver::options::OPT_fno_automatic)) { + opts.features.Enable(Fortran::common::LanguageFeature::DefaultSave); + } + if (args.hasArg( clang::driver::options::OPT_falternative_parameter_statement)) { opts.features.Enable(Fortran::common::LanguageFeature::OldStyleParameter); diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp index 61cfba046022..ea023178f34c 100644 --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -605,7 +605,7 @@ bool EquivalenceSets::CheckObject(const parser::Name &name) { msg = "Nonsequence derived type object '%s'" " is not allowed in an equivalence set"_err_en_US; } - } else if (IsAutomaticObject(symbol)) { + } else if (IsAutomatic(symbol)) { msg = "Automatic object '%s'" " is not allowed in an equivalence set"_err_en_US; } diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp index aa375a0ab74d..5a5790235be4 100644 --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -767,7 +767,7 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent( AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer")); hasDataInit = InitializeDataPointer( values, symbol, object, scope, dtScope, distinctName); - } else if (IsAutomaticObject(symbol)) { + } else if (IsAutomatic(symbol)) { AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic")); } else { AddValue(values, componentSchema_, "genre"s, GetEnumValue("data")); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 46b4c912695f..f3df880fffca 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -626,49 +626,6 @@ bool IsSeparateModuleProcedureInterface(const Symbol *symbol) { return false; } -// 3.11 automatic data object -bool IsAutomatic(const Symbol &symbol) { - if (const auto *object{symbol.detailsIf()}) { - if (!object->isDummy() && !IsAllocatable(symbol) && !IsPointer(symbol)) { - if (const DeclTypeSpec * type{symbol.GetType()}) { - // If a type parameter value is not a constant expression, the - // object is automatic. - if (type->category() == DeclTypeSpec::Character) { - if (const auto &length{ - type->characterTypeSpec().length().GetExplicit()}) { - if (!evaluate::IsConstantExpr(*length)) { - return true; - } - } - } else if (const DerivedTypeSpec * derived{type->AsDerived()}) { - for (const auto &pair : derived->parameters()) { - if (const auto &value{pair.second.GetExplicit()}) { - if (!evaluate::IsConstantExpr(*value)) { - return true; - } - } - } - } - } - // If an array bound is not a constant expression, the object is - // automatic. - for (const ShapeSpec &dim : object->shape()) { - if (const auto &lb{dim.lbound().GetExplicit()}) { - if (!evaluate::IsConstantExpr(*lb)) { - return true; - } - } - if (const auto &ub{dim.ubound().GetExplicit()}) { - if (!evaluate::IsConstantExpr(*ub)) { - return true; - } - } - } - } - } - return false; -} - bool IsFinalizable( const Symbol &symbol, std::set *inProgress) { if (IsPointer(symbol)) { @@ -721,35 +678,6 @@ bool HasImpureFinal(const DerivedTypeSpec &derived) { bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; } -bool IsAutomaticObject(const Symbol &symbol) { - if (IsDummy(symbol) || IsPointer(symbol) || IsAllocatable(symbol)) { - return false; - } - if (const DeclTypeSpec * type{symbol.GetType()}) { - if (type->category() == DeclTypeSpec::Character) { - ParamValue length{type->characterTypeSpec().length()}; - if (length.isExplicit()) { - if (MaybeIntExpr lengthExpr{length.GetExplicit()}) { - if (!ToInt64(lengthExpr)) { - return true; - } - } - } - } - } - if (symbol.IsObjectArray()) { - for (const ShapeSpec &spec : symbol.get().shape()) { - auto &lbound{spec.lbound().GetExplicit()}; - auto &ubound{spec.ubound().GetExplicit()}; - if ((lbound && !evaluate::ToInt64(*lbound)) || - (ubound && !evaluate::ToInt64(*ubound))) { - return true; - } - } - } - return false; -} - bool IsAssumedLengthCharacter(const Symbol &symbol) { if (const DeclTypeSpec * type{symbol.GetType()}) { return type->category() == DeclTypeSpec::Character && diff --git a/flang/test/Driver/driver-help-hidden.f90 b/flang/test/Driver/driver-help-hidden.f90 index c91fdaa42f0f..92e6af5786ed 100644 --- a/flang/test/Driver/driver-help-hidden.f90 +++ b/flang/test/Driver/driver-help-hidden.f90 @@ -39,6 +39,7 @@ ! CHECK-NEXT: Specify where to find the compiled intrinsic modules ! CHECK-NEXT: -flarge-sizes Use INTEGER(KIND=8) for the result type in size-related intrinsics ! CHECK-NEXT: -flogical-abbreviations Enable logical abbreviations +! CHECK-NEXT: -fno-automatic Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE ! CHECK-NEXT: -fno-color-diagnostics Disable colors in diagnostics ! CHECK-NEXT: -fopenacc Enable OpenACC ! CHECK-NEXT: -fopenmp Parse OpenMP pragmas and generate parallel code. diff --git a/flang/test/Driver/driver-help.f90 b/flang/test/Driver/driver-help.f90 index b895dc4b1efd..627fef376941 100644 --- a/flang/test/Driver/driver-help.f90 +++ b/flang/test/Driver/driver-help.f90 @@ -39,6 +39,7 @@ ! HELP-NEXT: Specify where to find the compiled intrinsic modules ! HELP-NEXT: -flarge-sizes Use INTEGER(KIND=8) for the result type in size-related intrinsics ! HELP-NEXT: -flogical-abbreviations Enable logical abbreviations +! HELP-NEXT: -fno-automatic Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE ! HELP-NEXT: -fno-color-diagnostics Disable colors in diagnostics ! HELP-NEXT: -fopenacc Enable OpenACC ! HELP-NEXT: -fopenmp Parse OpenMP pragmas and generate parallel code. @@ -103,6 +104,7 @@ ! HELP-FC1-NEXT: -flogical-abbreviations Enable logical abbreviations ! HELP-FC1-NEXT: -fno-analyzed-objects-for-unparse ! HELP-FC1-NEXT: Do not use the analyzed objects when unparsing +! HELP-FC1-NEXT: -fno-automatic Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE ! HELP-FC1-NEXT: -fno-reformat Dump the cooked character stream in -E mode ! HELP-FC1-NEXT: -fopenacc Enable OpenACC ! HELP-FC1-NEXT: -fopenmp Parse OpenMP pragmas and generate parallel code. diff --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90 index 8255e708a7d9..c9c48193c72f 100644 --- a/flang/test/Semantics/entry01.f90 +++ b/flang/test/Semantics/entry01.f90 @@ -55,7 +55,6 @@ subroutine subr(goodarg1) common /badarg3/ x namelist /badarg4/ x !ERROR: A dummy argument must not be initialized - !ERROR: A dummy argument may not have the SAVE attribute integer :: badarg5 = 2 entry okargs(goodarg1, goodarg2) !ERROR: RESULT(br1) may appear only in a function diff --git a/flang/test/Semantics/save01.f90 b/flang/test/Semantics/save01.f90 index 2d435af027b1..0e29113252b8 100644 --- a/flang/test/Semantics/save01.f90 +++ b/flang/test/Semantics/save01.f90 @@ -17,5 +17,13 @@ PURE FUNCTION pf2( ) INTEGER :: mc END FUNCTION +! This same subroutine appears in test save02.f90 where it is not an +! error due to -fno-automatic. +SUBROUTINE foo + INTEGER, TARGET :: t + !ERROR: An initial data target may not be a reference to an object 't' that lacks the SAVE attribute + INTEGER, POINTER :: p => t +end + END MODULE diff --git a/flang/test/Semantics/save02.f90 b/flang/test/Semantics/save02.f90 new file mode 100644 index 000000000000..29bec4fb77b0 --- /dev/null +++ b/flang/test/Semantics/save02.f90 @@ -0,0 +1,9 @@ +! RUN: %flang_fc1 -fsyntax-only -fno-automatic %s 2>&1 | FileCheck %s --allow-empty +! Checks that -fno-automatic implies the SAVE attribute. +! This same subroutine appears in test save01.f90 where it is an +! error case due to the absence of both SAVE and -fno-automatic. +subroutine foo + integer, target :: t + !CHECK-NOT: error: + integer, pointer :: p => t +end