diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td --- a/clang/include/clang/Driver/Options.td +++ b/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">, diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp --- a/clang/lib/Driver/ToolChains/Flang.cpp +++ b/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, diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/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); diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/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 &); diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/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(); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1149,21 +1149,87 @@ 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 @@ } 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 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/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); diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/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; } diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/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")); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/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 && diff --git a/flang/test/Driver/driver-help-hidden.f90 b/flang/test/Driver/driver-help-hidden.f90 --- 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 --- 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 --- a/flang/test/Semantics/entry01.f90 +++ b/flang/test/Semantics/entry01.f90 @@ -55,7 +55,6 @@ 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 --- a/flang/test/Semantics/save01.f90 +++ b/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 diff --git a/flang/test/Semantics/save02.f90 b/flang/test/Semantics/save02.f90 new file mode 100644 --- /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