[flang-commits] [flang] 3265b93 - [flang] Extension: reduced scope for some implied DO loop indices
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Aug 24 09:34:27 PDT 2021
Author: peter klausler
Date: 2021-08-24T09:34:18-07:00
New Revision: 3265b93363d8540ee96357bfd708cc36b8c89280
URL: https://github.com/llvm/llvm-project/commit/3265b93363d8540ee96357bfd708cc36b8c89280
DIFF: https://github.com/llvm/llvm-project/commit/3265b93363d8540ee96357bfd708cc36b8c89280.diff
LOG: [flang] Extension: reduced scope for some implied DO loop indices
The index of an implied DO loop in a DATA statement or array
constructor is defined by Fortran 2018 to have scope over its
implied DO loop. This definition is unfortunate, because it
requires the implied DO loop's bounds expressions to be in the
scope of the index variable. Consequently, in code like
integer, parameter :: j = 5
real, save :: a(5) = [(j, j=1, j)]
the upper bound of the loop is a reference to the index variable,
not the parameter in the enclosing scope.
This patch limits the scope of the index variable to the "body"
of the implied DO loop as one would naturally expect, with a warning.
I would have preferred to make this a hard error, but most Fortran
compilers treat this case as f18 now does. If the standard
were to be fixed, the warning could be made optional.
Differential Revision: https://reviews.llvm.org/D108595
Added:
flang/test/Semantics/data11.f90
flang/test/Semantics/resolve106.f90
Modified:
flang/docs/Extensions.md
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/array-constr-values.f90
flang/test/Semantics/modfile25.f90
flang/test/Semantics/modfile26.f90
flang/test/Semantics/resolve30.f90
flang/test/Semantics/symbol05.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 34767f05a30ff..49855b25e8556 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -58,6 +58,11 @@ write(buffer,*,delim="QUOTE") quotes
print "('>',a10,'<')", buffer
end
```
+* The name of the control variable in an implied DO loop in an array
+ constructor or DATA statement has a scope over the value-list only,
+ not the bounds of the implied DO loop. It is not advisable to use
+ an object of the same name as the index variable in a bounds
+ expression, but it will work, instead of being needlessly undefined.
## Extensions, deletions, and legacy features supported by default
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e4ce88b1284ca..b3ec6b4ec4223 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1409,15 +1409,6 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
if (const auto dynamicType{DynamicType::From(symbol)}) {
kind = dynamicType->kind();
}
- if (!exprAnalyzer_.AddImpliedDo(name, kind)) {
- if (!(messageDisplayedSet_ & 0x20)) {
- exprAnalyzer_.SayAt(name,
- "Implied DO index is active in surrounding implied DO loop "
- "and may not have the same name"_err_en_US); // C7115
- messageDisplayedSet_ |= 0x20;
- }
- return;
- }
std::optional<Expr<ImpliedDoIntType>> lower{
GetSpecificIntExpr<ImpliedDoIntType::kind>(bounds.lower)};
std::optional<Expr<ImpliedDoIntType>> upper{
@@ -1428,49 +1419,57 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
if (!stride) {
stride = Expr<ImpliedDoIntType>{1};
}
- // Check for constant bounds; the loop may require complete unrolling
- // of the parse tree if all bounds are constant in order to allow the
- // implied DO loop index to qualify as a constant expression.
- auto cLower{ToInt64(lower)};
- auto cUpper{ToInt64(upper)};
- auto cStride{ToInt64(stride)};
- if (!(messageDisplayedSet_ & 0x10) && cStride && *cStride == 0) {
- exprAnalyzer_.SayAt(bounds.step.value().thing.thing.value().source,
- "The stride of an implied DO loop must not be zero"_err_en_US);
- messageDisplayedSet_ |= 0x10;
- }
- bool isConstant{cLower && cUpper && cStride && *cStride != 0};
- bool isNonemptyConstant{isConstant &&
- ((*cStride > 0 && *cLower <= *cUpper) ||
- (*cStride < 0 && *cLower >= *cUpper))};
- bool unrollConstantLoop{false};
- parser::Messages buffer;
- auto saveMessagesDisplayed{messageDisplayedSet_};
- {
- auto messageRestorer{
- exprAnalyzer_.GetContextualMessages().SetMessages(buffer)};
- auto v{std::move(values_)};
- for (const auto &value :
- std::get<std::list<parser::AcValue>>(impliedDo.t)) {
- Add(value);
- }
- std::swap(v, values_);
- if (isNonemptyConstant && buffer.AnyFatalError()) {
- unrollConstantLoop = true;
- } else {
- values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
- std::move(*upper), std::move(*stride), std::move(v)});
+ if (exprAnalyzer_.AddImpliedDo(name, kind)) {
+ // Check for constant bounds; the loop may require complete unrolling
+ // of the parse tree if all bounds are constant in order to allow the
+ // implied DO loop index to qualify as a constant expression.
+ auto cLower{ToInt64(lower)};
+ auto cUpper{ToInt64(upper)};
+ auto cStride{ToInt64(stride)};
+ if (!(messageDisplayedSet_ & 0x10) && cStride && *cStride == 0) {
+ exprAnalyzer_.SayAt(bounds.step.value().thing.thing.value().source,
+ "The stride of an implied DO loop must not be zero"_err_en_US);
+ messageDisplayedSet_ |= 0x10;
+ }
+ bool isConstant{cLower && cUpper && cStride && *cStride != 0};
+ bool isNonemptyConstant{isConstant &&
+ ((*cStride > 0 && *cLower <= *cUpper) ||
+ (*cStride < 0 && *cLower >= *cUpper))};
+ bool unrollConstantLoop{false};
+ parser::Messages buffer;
+ auto saveMessagesDisplayed{messageDisplayedSet_};
+ {
+ auto messageRestorer{
+ exprAnalyzer_.GetContextualMessages().SetMessages(buffer)};
+ auto v{std::move(values_)};
+ for (const auto &value :
+ std::get<std::list<parser::AcValue>>(impliedDo.t)) {
+ Add(value);
+ }
+ std::swap(v, values_);
+ if (isNonemptyConstant && buffer.AnyFatalError()) {
+ unrollConstantLoop = true;
+ } else {
+ values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
+ std::move(*upper), std::move(*stride), std::move(v)});
+ }
}
- }
- if (unrollConstantLoop) {
- messageDisplayedSet_ = saveMessagesDisplayed;
- UnrollConstantImpliedDo(impliedDo, name, *cLower, *cUpper, *cStride);
- } else if (auto *messages{
- exprAnalyzer_.GetContextualMessages().messages()}) {
- messages->Annex(std::move(buffer));
+ if (unrollConstantLoop) {
+ messageDisplayedSet_ = saveMessagesDisplayed;
+ UnrollConstantImpliedDo(impliedDo, name, *cLower, *cUpper, *cStride);
+ } else if (auto *messages{
+ exprAnalyzer_.GetContextualMessages().messages()}) {
+ messages->Annex(std::move(buffer));
+ }
+ exprAnalyzer_.RemoveImpliedDo(name);
+ } else if (!(messageDisplayedSet_ & 0x20)) {
+ exprAnalyzer_.SayAt(name,
+ "Implied DO index '%s' is active in a surrounding implied DO loop "
+ "and may not have the same name"_err_en_US,
+ name); // C7115
+ messageDisplayedSet_ |= 0x20;
}
}
- exprAnalyzer_.RemoveImpliedDo(name);
}
// Fortran considers an implied DO index of an array constructor to be
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 40ca1c014f592..35c29818ae34e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -901,11 +901,12 @@ class DeclarationVisitor : public ArraySpecVisitor,
// it comes from the entity in the containing scope, or implicit rules.
// Return pointer to the new symbol, or nullptr on error.
Symbol *DeclareLocalEntity(const parser::Name &);
- // Declare a statement entity (e.g., an implied DO loop index).
- // If there isn't a type specified, implicit rules apply.
- // Return pointer to the new symbol, or nullptr on error.
- Symbol *DeclareStatementEntity(
- const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
+ // Declare a statement entity (i.e., an implied DO loop index for
+ // a DATA statement or an array constructor). If there isn't an explict
+ // type specified, implicit rules apply. Return pointer to the new symbol,
+ // or nullptr on error.
+ Symbol *DeclareStatementEntity(const parser::DoVariable &,
+ const std::optional<parser::IntegerTypeSpec> &);
Symbol &MakeCommonBlockSymbol(const parser::Name &);
Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
bool CheckUseError(const parser::Name &);
@@ -926,6 +927,16 @@ class DeclarationVisitor : public ArraySpecVisitor,
Symbol *NoteInterfaceName(const parser::Name &);
bool IsUplevelReference(const Symbol &);
+ std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds(
+ const parser::DoVariable &name) {
+ std::optional<SourceName> result{checkIndexUseInOwnBounds_};
+ checkIndexUseInOwnBounds_ = name.thing.thing.source;
+ return result;
+ }
+ void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) {
+ checkIndexUseInOwnBounds_ = restore;
+ }
+
private:
// The attribute corresponding to the statement containing an ObjectDecl
std::optional<Attr> objectDeclAttr_;
@@ -956,6 +967,9 @@ class DeclarationVisitor : public ArraySpecVisitor,
} enumerationState_;
// Set for OldParameterStmt processing
bool inOldStyleParameterStmt_{false};
+ // Set when walking DATA & array constructor implied DO loop bounds
+ // to warn about use of the implied DO intex therein.
+ std::optional<SourceName> checkIndexUseInOwnBounds_;
bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
Symbol &HandleAttributeStmt(Attr, const parser::Name &);
@@ -5010,8 +5024,10 @@ Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
return &MakeHostAssocSymbol(name, prev);
}
-Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
+Symbol *DeclarationVisitor::DeclareStatementEntity(
+ const parser::DoVariable &doVar,
const std::optional<parser::IntegerTypeSpec> &type) {
+ const parser::Name &name{doVar.thing.thing};
const DeclTypeSpec *declTypeSpec{nullptr};
if (auto *prev{FindSymbol(name)}) {
if (prev->owner() == currScope()) {
@@ -5037,7 +5053,9 @@ Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
} else {
ApplyImplicitRules(symbol);
}
- return Resolve(name, &symbol);
+ Symbol *result{Resolve(name, &symbol)};
+ AnalyzeExpr(context(), doVar); // enforce INTEGER type
+ return result;
}
// Set the type of an entity or report an error.
@@ -5321,9 +5339,7 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
bool ConstructVisitor::Pre(const parser::AcSpec &x) {
ProcessTypeSpec(x.type);
- PushScope(Scope::Kind::ImpliedDos, nullptr);
Walk(x.values);
- PopScope();
return false;
}
@@ -5334,9 +5350,18 @@ bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
+ // F'2018 has the scope of the implied DO variable covering the entire
+ // implied DO production (19.4(5)), which seems wrong in cases where the name
+ // of the implied DO variable appears in one of the bound expressions. Thus
+ // this extension, which shrinks the scope of the variable to exclude the
+ // expressions in the bounds.
+ auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
+ Walk(bounds.lower);
+ Walk(bounds.upper);
+ Walk(bounds.step);
+ EndCheckOnIndexUseInOwnBounds(restore);
PushScope(Scope::Kind::ImpliedDos, nullptr);
- DeclareStatementEntity(bounds.name.thing.thing, type);
- Walk(bounds);
+ DeclareStatementEntity(bounds.name, type);
Walk(values);
PopScope();
return false;
@@ -5346,9 +5371,21 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
auto &bounds{std::get<parser::DataImpliedDo::Bounds>(x.t)};
- DeclareStatementEntity(bounds.name.thing.thing, type);
- Walk(bounds);
+ // See comment in Pre(AcImpliedDo) above.
+ auto restore{BeginCheckOnIndexUseInOwnBounds(bounds.name)};
+ Walk(bounds.lower);
+ Walk(bounds.upper);
+ Walk(bounds.step);
+ EndCheckOnIndexUseInOwnBounds(restore);
+ bool pushScope{currScope().kind() != Scope::Kind::ImpliedDos};
+ if (pushScope) {
+ PushScope(Scope::Kind::ImpliedDos, nullptr);
+ }
+ DeclareStatementEntity(bounds.name, type);
Walk(objects);
+ if (pushScope) {
+ PopScope();
+ }
return false;
}
@@ -5887,6 +5924,12 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
ConvertToObjectEntity(*symbol);
ApplyImplicitRules(*symbol);
}
+ if (checkIndexUseInOwnBounds_ &&
+ *checkIndexUseInOwnBounds_ == name.source) {
+ Say(name,
+ "Implied DO index '%s' uses an object of the same name in its bounds expressions"_en_US,
+ name.source);
+ }
return &name;
}
if (isImplicitNoneType()) {
@@ -5894,6 +5937,11 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
return nullptr;
}
// Create the symbol then ensure it is accessible
+ if (checkIndexUseInOwnBounds_ && *checkIndexUseInOwnBounds_ == name.source) {
+ Say(name,
+ "Implied DO index '%s' uses itself in its own bounds expressions"_err_en_US,
+ name.source);
+ }
MakeSymbol(InclusiveScope(), name.source, Attrs{});
auto *symbol{FindSymbol(name)};
if (!symbol) {
diff --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90
index bc1ee0a973da0..09f8bc3dfe4b7 100644
--- a/flang/test/Semantics/array-constr-values.f90
+++ b/flang/test/Semantics/array-constr-values.f90
@@ -58,7 +58,7 @@ subroutine checkC7115()
real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
real, dimension(-1:0), parameter :: good3 = [77.7, 66.6]
- !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
+ !ERROR: Implied DO index 'i' is active in a surrounding implied DO loop and may not have the same name
real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
!ERROR: Value of named constant 'bad2' ([INTEGER(4)::(int(j,kind=4),INTEGER(8)::j=1_8,1_8,0_8)]) cannot be computed as a constant value
diff --git a/flang/test/Semantics/data11.f90 b/flang/test/Semantics/data11.f90
new file mode 100644
index 0000000000000..213b92bc628a7
--- /dev/null
+++ b/flang/test/Semantics/data11.f90
@@ -0,0 +1,9 @@
+! RUN: %flang_fc1 -fsyntax-only -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+! CHECK: Implied DO index 'j' uses an object of the same name in its bounds expressions
+! CHECK: ObjectEntity type: REAL(4) shape: 1_8:5_8 init:[REAL(4)::1._4,2._4,3._4,4._4,5._4]
+! Verify that the scope of a DATA statement implied DO loop index does
+! not include the bounds expressions (language extension, with warning)
+integer, parameter :: j = 5
+real, save :: a(j)
+data (a(j),j=1,j)/1,2,3,4,5/
+end
diff --git a/flang/test/Semantics/modfile25.f90 b/flang/test/Semantics/modfile25.f90
index f17fd22d78d2d..4a50ff5976551 100644
--- a/flang/test/Semantics/modfile25.f90
+++ b/flang/test/Semantics/modfile25.f90
@@ -39,7 +39,9 @@ end module m1
! integer(8),parameter::a1ss(1_8:*)=[INTEGER(8)::3_8]
! integer(8),parameter::a1sss(1_8:*)=[INTEGER(8)::1_8]
! integer(8),parameter::a1rs(1_8:*)=[INTEGER(8)::3_8,1_8,1_8,1_8]
+! intrinsic::rank
! integer(8),parameter::a1n(1_8:*)=[INTEGER(8)::125_8,5_8,5_8]
+! intrinsic::size
! integer(8),parameter::a1sn(1_8:*)=[INTEGER(8)::3_8,1_8,1_8]
! integer(8),parameter::ac1s(1_8:*)=[INTEGER(8)::1_8]
! integer(8),parameter::ac2s(1_8:*)=[INTEGER(8)::3_8]
diff --git a/flang/test/Semantics/modfile26.f90 b/flang/test/Semantics/modfile26.f90
index 28eeeb8d49cd6..e57c5378d161d 100644
--- a/flang/test/Semantics/modfile26.f90
+++ b/flang/test/Semantics/modfile26.f90
@@ -66,12 +66,15 @@ end module m1
!Expect: m1.mod
!module m1
!integer(4),parameter::iranges(1_8:*)=[INTEGER(4)::2_4,4_4,9_4,18_4,38_4]
+!intrinsic::range
!logical(4),parameter::ircheck=.true._4
!intrinsic::all
!integer(4),parameter::intpvals(1_8:*)=[INTEGER(4)::0_4,2_4,3_4,4_4,5_4,9_4,10_4,18_4,19_4,38_4,39_4]
!integer(4),parameter::intpkinds(1_8:*)=[INTEGER(4)::1_4,1_4,2_4,2_4,4_4,4_4,8_4,8_4,16_4,16_4,-1_4]
+!intrinsic::size
!logical(4),parameter::ipcheck=.true._4
!integer(4),parameter::realprecs(1_8:*)=[INTEGER(4)::3_4,2_4,6_4,15_4,18_4,33_4]
+!intrinsic::precision
!logical(4),parameter::rpreccheck=.true._4
!integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::0_4,3_4,4_4,6_4,7_4,15_4,16_4,18_4,19_4,33_4,34_4]
!integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::2_4,2_4,4_4,4_4,8_4,8_4,10_4,10_4,16_4,16_4,-1_4]
@@ -82,7 +85,9 @@ end module m1
!integer(4),parameter::realrkinds(1_8:*)=[INTEGER(4)::2_4,2_4,3_4,3_4,8_4,8_4,10_4,10_4,-2_4]
!logical(4),parameter::realrcheck=.true._4
!logical(4),parameter::radixcheck=.true._4
+!intrinsic::radix
!integer(4),parameter::intdigits(1_8:*)=[INTEGER(4)::7_4,15_4,31_4,63_4,127_4]
+!intrinsic::digits
!logical(4),parameter::intdigitscheck=.true._4
!integer(4),parameter::realdigits(1_8:*)=[INTEGER(4)::11_4,8_4,24_4,53_4,64_4,113_4]
!logical(4),parameter::realdigitscheck=.true._4
diff --git a/flang/test/Semantics/resolve106.f90 b/flang/test/Semantics/resolve106.f90
new file mode 100644
index 0000000000000..b8215f7232259
--- /dev/null
+++ b/flang/test/Semantics/resolve106.f90
@@ -0,0 +1,5 @@
+!RUN: %flang -fsyntax-only %s 2>&1 | FileCheck %s
+integer, parameter :: j = 10
+! CHECK: Implied DO index 'j' uses an object of the same name in its bounds expressions
+real :: a(10) = [(j, j=1,j)]
+end
diff --git a/flang/test/Semantics/resolve30.f90 b/flang/test/Semantics/resolve30.f90
index ecf488a7d1fb3..f34ad5f3bbeea 100644
--- a/flang/test/Semantics/resolve30.f90
+++ b/flang/test/Semantics/resolve30.f90
@@ -31,9 +31,9 @@ subroutine s3
end
subroutine s4
- real :: i, j
+ real :: j
!ERROR: Must have INTEGER type, but is REAL(4)
- real :: a(16) = [(i, i=1, 16)]
+ real :: a(16) = [(x, x=1, 16)]
real :: b(16)
!ERROR: Must have INTEGER type, but is REAL(4)
data(b(j), j=1, 16) / 16 * 0.0 /
diff --git a/flang/test/Semantics/symbol05.f90 b/flang/test/Semantics/symbol05.f90
index 442bd19d1f200..306127fce3968 100644
--- a/flang/test/Semantics/symbol05.f90
+++ b/flang/test/Semantics/symbol05.f90
@@ -48,10 +48,10 @@ subroutine s3
!DEF: /s3/Block1/t DerivedType
type :: t
!DEF: /s3/Block1/t/x ObjectEntity REAL(4)
- !DEF: /s3/Block1/t/ImpliedDos1/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
+ !DEF: /s3/Block1/t/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
real :: x(10) = [(i, i=1,10)]
!DEF: /s3/Block1/t/y ObjectEntity REAL(4)
- !DEF: /s3/Block1/t/ImpliedDos2/ImpliedDos1/j ObjectEntity INTEGER(8)
+ !DEF: /s3/Block1/t/ImpliedDos2/j ObjectEntity INTEGER(8)
real :: y(10) = [(j, j=1,10)]
end type
end block
More information about the flang-commits
mailing list