[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
This commit is contained in:
Peter Klausler 2021-11-18 11:48:42 -08:00
parent ed8b5b37ab
commit 996ef895cd
15 changed files with 109 additions and 87 deletions

View File

@ -4519,7 +4519,7 @@ def frecord_marker_EQ : Joined<["-"], "frecord-marker=">, Group<gfortran_Group>;
defm aggressive_function_elimination : BooleanFFlag<"aggressive-function-elimination">, Group<gfortran_Group>;
defm align_commons : BooleanFFlag<"align-commons">, Group<gfortran_Group>;
defm all_intrinsics : BooleanFFlag<"all-intrinsics">, Group<gfortran_Group>;
defm automatic : BooleanFFlag<"automatic">, Group<gfortran_Group>;
def fautomatic : Flag<["-"], "fautomatic">; // -fno-automatic is significant
defm backtrace : BooleanFFlag<"backtrace">, Group<gfortran_Group>;
defm bounds_check : BooleanFFlag<"bounds-check">, Group<gfortran_Group>;
defm check_array_temporaries : BooleanFFlag<"check-array-temporaries">, Group<gfortran_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<f_Group>,
HelpText<"Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE">;
}
def J : JoinedOrSeparate<["-"], "J">,

View File

@ -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,

View File

@ -31,7 +31,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
DistinguishableSpecifics)
DistinguishableSpecifics, DefaultSave)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
@ -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);

View File

@ -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 &);

View File

@ -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<ObjectEntityDetails>()};
return details && details->IsAssumedSize();

View File

@ -1149,21 +1149,87 @@ bool IsProcedurePointer(const Symbol &original) {
return symbol.has<ProcEntityDetails>() && IsPointer(symbol);
}
// 3.11 automatic data object
bool IsAutomatic(const Symbol &original) {
const Symbol &symbol{original.GetUltimate()};
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
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<AssocEntityDetails>()) {
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<ObjectEntityDetails>()};
object && object->init()) {
@ -1171,13 +1237,13 @@ bool IsSaved(const Symbol &original) {
} else if (IsProcedurePointer(symbol) &&
symbol.get<ProcEntityDetails>().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;
}
}

View File

@ -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);

View File

@ -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;
}

View File

@ -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"));

View File

@ -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<ObjectEntityDetails>()}) {
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<const DerivedTypeSpec *> *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<ObjectEntityDetails>().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 &&

View File

@ -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.

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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