[clang] 996ef89 - [flang] Add -fno-automatic, refine IsSaved()
Peter Klausler via cfe-commits
cfe-commits at lists.llvm.org
Mon Nov 22 10:06:49 PST 2021
Author: Peter Klausler
Date: 2021-11-22T10:06:38-08:00
New Revision: 996ef895cd3d1313665a42fc8e20d1d4e1cf2a28
URL: https://github.com/llvm/llvm-project/commit/996ef895cd3d1313665a42fc8e20d1d4e1cf2a28
DIFF: https://github.com/llvm/llvm-project/commit/996ef895cd3d1313665a42fc8e20d1d4e1cf2a28.diff
LOG: [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
Added:
flang/test/Semantics/save02.f90
Modified:
clang/include/clang/Driver/Options.td
clang/lib/Driver/ToolChains/Flang.cpp
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Frontend/CompilerInvocation.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/tools.cpp
flang/test/Driver/driver-help-hidden.f90
flang/test/Driver/driver-help.f90
flang/test/Semantics/entry01.f90
flang/test/Semantics/save01.f90
Removed:
################################################################################
diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td
index 9bde64cf49fd7..7730b7d1915e4 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<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">,
diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp
index b82c5d7600df2..c169e3d457938 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 ddce794056320..f5fe2b5de475e 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<LanguageFeature, LanguageFeature_enumSize>;
@@ -44,6 +44,7 @@ class LanguageFeatureControl {
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 a3d70b6c46308..df56a3b0cb040 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 e5ed412cde9dc..6ab3e5e245884 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<ObjectEntityDetails>()};
return details && details->IsAssumedSize();
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 4b0bedd9c7a80..86600ca962796 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<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;
}
}
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index c16c9690f0599..acdfcb804390a 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 61cfba0460229..ea023178f34c8 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 aa375a0ab74de..5a5790235be4c 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 46b4c912695f7..f3df880fffca1 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<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 &&
diff --git a/flang/test/Driver/driver-help-hidden.f90 b/flang/test/Driver/driver-help-hidden.f90
index c91fdaa42f0f1..92e6af5786ed5 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 b895dc4b1efdf..627fef3769418 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 8255e708a7d96..c9c48193c72f5 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 2d435af027b1c..0e29113252b85 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 0000000000000..29bec4fb77b0c
--- /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
More information about the cfe-commits
mailing list