[flang] Fix erroneous application of SAVE statement

A SAVE statement with no entity list applies the SAVE attribute only to
the entities that it is allowed on. We were applying it to automatic
data objects and reporting an error that they can't have SAVE.

The fix is to change `DeclarationVisitor::CheckSaveAttr` to check for
automatic objects. That controls both checking and setting the
attribute. This allows us to remove the check from `CheckSpecExpr`
(along with `symbolBeingChecked_`). Also, it was only called on constant
objects so the non-const overload can be eliminated.

The check in `CheckSpecExpr` is replaced by an explicit check for
automatic objects in modules. This caught an error in modfile03.f90 so
that part of the test was eliminated.

Differential Revision: https://reviews.llvm.org/D83899
This commit is contained in:
Tim Keith 2020-07-15 13:02:32 -07:00
parent f3731d34fa
commit b297563a75
5 changed files with 22 additions and 27 deletions

View File

@ -45,26 +45,8 @@ public:
private:
template <typename A> void CheckSpecExpr(const A &x) {
if (symbolBeingChecked_ && IsSaved(*symbolBeingChecked_)) {
if (!evaluate::IsConstantExpr(x)) {
messages_.Say(
"Specification expression must be constant in declaration of '%s' with the SAVE attribute"_err_en_US,
symbolBeingChecked_->name());
}
} else {
evaluate::CheckSpecificationExpr(
x, messages_, DEREF(scope_), context_.intrinsics());
}
}
template <typename A> void CheckSpecExpr(const std::optional<A> &x) {
if (x) {
CheckSpecExpr(*x);
}
}
template <typename A> void CheckSpecExpr(A &x) {
x = Fold(foldingContext_, std::move(x));
const A &constx{x};
CheckSpecExpr(constx);
evaluate::CheckSpecificationExpr(
x, messages_, DEREF(scope_), context_.intrinsics());
}
void CheckValue(const Symbol &, const DerivedTypeSpec *);
void CheckVolatile(
@ -120,7 +102,6 @@ private:
// This symbol is the one attached to the innermost enclosing scope
// that has a symbol.
const Symbol *innermostSymbol_{nullptr};
const Symbol *symbolBeingChecked_{nullptr};
};
void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
@ -295,6 +276,12 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
}
if (symbol.owner().IsModule() && IsAutomatic(symbol)) {
messages_.Say(
"Automatic data object '%s' may not appear in the specification part"
" of a module"_err_en_US,
symbol.name());
}
}
void CheckHelper::CheckValue(
@ -388,13 +375,10 @@ void CheckHelper::CheckAssumedTypeEntity( // C709
void CheckHelper::CheckObjectEntity(
const Symbol &symbol, const ObjectEntityDetails &details) {
CHECK(!symbolBeingChecked_);
symbolBeingChecked_ = &symbol; // for specification expr checks
CheckArraySpec(symbol, details.shape());
Check(details.shape());
Check(details.coshape());
CheckAssumedTypeEntity(symbol, details);
symbolBeingChecked_ = nullptr;
if (!details.coshape().empty()) {
bool isDeferredShape{details.coshape().IsDeferredShape()};
if (IsAllocatable(symbol)) {

View File

@ -4451,6 +4451,8 @@ std::optional<MessageFixedText> DeclarationVisitor::CheckSaveAttr(
} else if (symbol.has<ProcEntityDetails>() &&
!symbol.attrs().test(Attr::POINTER)) {
return "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US;
} else if (IsAutomatic(symbol)) {
return "SAVE attribute may not be applied to automatic data object '%s'"_err_en_US;
} else {
return std::nullopt;
}

View File

@ -68,7 +68,6 @@ end
module m5b
use m5a, only: k2 => k1, l2 => l1, f2 => f1
character(l2, k2) :: x
interface
subroutine s(x, y)
import f2, l2
@ -82,7 +81,6 @@ end
! use m5a,only:k2=>k1
! use m5a,only:l2=>l1
! use m5a,only:f2=>f1
! character(l2,4)::x
! interface
! subroutine s(x,y)
! import::f2

View File

@ -68,3 +68,14 @@ subroutine s7
!ERROR: 'x' appears as a COMMON block in a SAVE statement but not in a COMMON statement
save /x/
end
subroutine s8a(n)
integer :: n
real :: x(n) ! OK: save statement doesn't affect x
save
end
subroutine s8b(n)
integer :: n
!ERROR: SAVE attribute may not be applied to automatic data object 'x'
real, save :: x(n)
end

View File

@ -8,7 +8,7 @@ module m
interface ifn3
module procedure if3
end interface
!ERROR: Specification expression must be constant in declaration of 'a' with the SAVE attribute
!ERROR: Automatic data object 'a' may not appear in the specification part of a module
real :: a(if1(1))
!ERROR: No specific procedure of generic 'ifn2' matches the actual arguments
real :: b(ifn2(1))