[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
GitOrigin-RevId: 996ef895cd3d1313665a42fc8e20d1d4e1cf2a28
diff --git a/include/flang/Common/Fortran-features.h b/include/flang/Common/Fortran-features.h
index ddce794..f5fe2b5 100644
--- a/include/flang/Common/Fortran-features.h
+++ b/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<LanguageFeature, LanguageFeature_enumSize>;
@@ -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/include/flang/Evaluate/tools.h b/include/flang/Evaluate/tools.h
index a3d70b6..df56a3b 100644
--- a/include/flang/Evaluate/tools.h
+++ b/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/include/flang/Semantics/tools.h b/include/flang/Semantics/tools.h
index e5ed412..6ab3e5e 100644
--- a/include/flang/Semantics/tools.h
+++ b/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<ObjectEntityDetails>()};
return details && details->IsAssumedSize();
diff --git a/lib/Evaluate/tools.cpp b/lib/Evaluate/tools.cpp
index 4b0bedd..86600ca 100644
--- a/lib/Evaluate/tools.cpp
+++ b/lib/Evaluate/tools.cpp
@@ -1149,21 +1149,87 @@
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 @@
} 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;
}
}
diff --git a/lib/Frontend/CompilerInvocation.cpp b/lib/Frontend/CompilerInvocation.cpp
index c16c969..acdfcb8 100644
--- a/lib/Frontend/CompilerInvocation.cpp
+++ b/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/lib/Semantics/resolve-names-utils.cpp b/lib/Semantics/resolve-names-utils.cpp
index 61cfba0..ea02317 100644
--- a/lib/Semantics/resolve-names-utils.cpp
+++ b/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/lib/Semantics/runtime-type-info.cpp b/lib/Semantics/runtime-type-info.cpp
index aa375a0..5a57902 100644
--- a/lib/Semantics/runtime-type-info.cpp
+++ b/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/lib/Semantics/tools.cpp b/lib/Semantics/tools.cpp
index 46b4c91..f3df880 100644
--- a/lib/Semantics/tools.cpp
+++ b/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<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 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 &&
diff --git a/test/Driver/driver-help-hidden.f90 b/test/Driver/driver-help-hidden.f90
index c91fdaa..92e6af5 100644
--- a/test/Driver/driver-help-hidden.f90
+++ b/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/test/Driver/driver-help.f90 b/test/Driver/driver-help.f90
index b895dc4..627fef3 100644
--- a/test/Driver/driver-help.f90
+++ b/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/test/Semantics/entry01.f90 b/test/Semantics/entry01.f90
index 8255e70..c9c4819 100644
--- a/test/Semantics/entry01.f90
+++ b/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/test/Semantics/save01.f90 b/test/Semantics/save01.f90
index 2d435af..0e29113 100644
--- a/test/Semantics/save01.f90
+++ b/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/test/Semantics/save02.f90 b/test/Semantics/save02.f90
new file mode 100644
index 0000000..29bec4f
--- /dev/null
+++ b/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
