Index: clang/include/clang/Driver/Options.td =================================================================== --- clang/include/clang/Driver/Options.td +++ clang/include/clang/Driver/Options.td @@ -4519,7 +4519,7 @@ 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 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">, Index: clang/lib/Driver/ToolChains/Flang.cpp =================================================================== --- clang/lib/Driver/ToolChains/Flang.cpp +++ clang/lib/Driver/ToolChains/Flang.cpp @@ -32,7 +32,8 @@ 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, Index: flang/include/flang/Common/Fortran-features.h =================================================================== --- flang/include/flang/Common/Fortran-features.h +++ flang/include/flang/Common/Fortran-features.h @@ -31,7 +31,7 @@ OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile, ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways, ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger, - DistinguishableSpecifics) + DistinguishableSpecifics, DefaultSave) using LanguageFeatures = EnumSet; @@ -44,6 +44,7 @@ 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); Index: flang/include/flang/Evaluate/tools.h =================================================================== --- flang/include/flang/Evaluate/tools.h +++ flang/include/flang/Evaluate/tools.h @@ -1050,6 +1050,7 @@ 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 &); Index: flang/include/flang/Semantics/tools.h =================================================================== --- flang/include/flang/Semantics/tools.h +++ flang/include/flang/Semantics/tools.h @@ -111,7 +111,6 @@ 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 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(); Index: flang/lib/Evaluate/tools.cpp =================================================================== --- flang/lib/Evaluate/tools.cpp +++ flang/lib/Evaluate/tools.cpp @@ -1149,14 +1149,61 @@ 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::Module || + scopeKind == Scope::Kind::MainProgram) { + // 8.5.16p4; BLOCK DATA entities must all be in COMMON, + // which is handled below. + return true; } else if (scopeKind == Scope::Kind::DerivedType) { return false; // this is a component } else if (symbol.attrs().test(Attr::SAVE)) { @@ -1174,10 +1221,19 @@ } else if (const Symbol * block{FindCommonBlockContaining(symbol)}; block && block->attrs().test(Attr::SAVE)) { return true; - } else if (IsDummy(symbol) || IsFunctionResult(symbol)) { + } else if (IsDummy(symbol) || IsFunctionResult(symbol) || + IsAutomatic(symbol)) { return false; + } else if (scope.hasSAVE()) { + return true; } else { - return scope.hasSAVE(); + // -fno-automatic/-save/-Msave option applies to objects in + // executable subprograms unless they are explicitly RECURSIVE. + const Symbol *scopeSym{scope.symbol()}; + return scope.context().languageFeatures().IsEnabled( + common::LanguageFeature::DefaultSave) && + scope.kind() == Scope::Kind::Subprogram && + !(scopeSym && scopeSym->attrs().test(Attr::RECURSIVE)); } } Index: flang/lib/Frontend/CompilerInvocation.cpp =================================================================== --- flang/lib/Frontend/CompilerInvocation.cpp +++ flang/lib/Frontend/CompilerInvocation.cpp @@ -310,6 +310,11 @@ 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); Index: flang/lib/Semantics/resolve-names-utils.cpp =================================================================== --- flang/lib/Semantics/resolve-names-utils.cpp +++ flang/lib/Semantics/resolve-names-utils.cpp @@ -605,7 +605,7 @@ 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; } Index: flang/lib/Semantics/runtime-type-info.cpp =================================================================== --- flang/lib/Semantics/runtime-type-info.cpp +++ flang/lib/Semantics/runtime-type-info.cpp @@ -767,7 +767,7 @@ 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")); Index: flang/lib/Semantics/tools.cpp =================================================================== --- flang/lib/Semantics/tools.cpp +++ flang/lib/Semantics/tools.cpp @@ -626,49 +626,6 @@ 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 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 && Index: flang/test/Driver/driver-help-hidden.f90 =================================================================== --- flang/test/Driver/driver-help-hidden.f90 +++ 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. Index: flang/test/Driver/driver-help.f90 =================================================================== --- flang/test/Driver/driver-help.f90 +++ 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. Index: flang/test/Semantics/save01.f90 =================================================================== --- flang/test/Semantics/save01.f90 +++ flang/test/Semantics/save01.f90 @@ -17,5 +17,13 @@ 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 Index: flang/test/Semantics/save02.f90 =================================================================== --- /dev/null +++ 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