[flang-commits] [flang] [flang] Allow multiple identical DATA initializations (PR #177063)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jan 21 08:59:12 PST 2026
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/177063
>From 12bade29208976bcc3d556630764501fa18b6f94 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 20 Jan 2026 10:26:09 -0800
Subject: [PATCH] [flang] Allow multiple identical DATA initializations
ISO Fortran disallows DATA statements from affecting the
same bit of memory more than once; however, all (but one) other
compilers allow this usage. They differ, however, in the
case of multiple distinct initializations -- some compilers
take the "last" value in source order, some don't.
This patch accepts multiple identical DATA initializations,
which is portable usage that appears in code, and emits an
optional warning. It continues to detect and report multiple
distinct DATA initializations, since they are not portable.
---
flang/docs/Extensions.md | 3 +
flang/include/flang/Evaluate/initial-image.h | 33 +++--
.../include/flang/Support/Fortran-features.h | 2 +-
flang/lib/Evaluate/fold.cpp | 2 +-
flang/lib/Evaluate/initial-image.cpp | 36 +++--
flang/lib/Semantics/data-to-inits.cpp | 139 +++++++++++-------
flang/lib/Semantics/data-to-inits.h | 34 +++--
flang/lib/Semantics/semantics.cpp | 6 +-
flang/test/Semantics/bug2098.f90 | 14 ++
flang/test/Semantics/data07.f90 | 2 +-
flang/test/Semantics/data12.f90 | 12 +-
flang/test/Semantics/data23.f90 | 39 +++--
flang/test/Semantics/equivalence02.f90 | 20 ++-
13 files changed, 223 insertions(+), 119 deletions(-)
create mode 100644 flang/test/Semantics/bug2098.f90
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6f02a51c81492..493bb10af6f85 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -478,6 +478,9 @@ end
to be a pointer so long as it is `INTENT(IN)`.
(This extension is not yet supported for procedure pointer component
interfaces.)
+* A data object can be initialized multiple times by `DATA` statements
+ and default component initialization, but only when all initializations
+ are to the same value. Distinct initializations remain errors.
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h
index dc9a9bfbfdf22..02f197bbbc6f1 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -24,11 +24,12 @@ class InitialImage {
public:
enum Result {
Ok,
+ OkNoChange,
NotAConstant,
OutOfRange,
SizeMismatch,
LengthMismatch,
- TooManyElems
+ TooManyElems,
};
explicit InitialImage(std::size_t bytes) : data_(bytes) {}
@@ -52,11 +53,17 @@ class InitialImage {
x.values().size() * static_cast<std::size_t>(*elementBytes)) {
return SizeMismatch;
} else if (bytes == 0) {
- return Ok;
+ return OkNoChange;
} else {
// TODO endianness
- std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
- return Ok;
+ auto *to{&data_.at(offset)};
+ const auto *from{&x.values().at(0)};
+ if (std::memcmp(to, from, bytes) == 0) {
+ return OkNoChange;
+ } else {
+ std::memcpy(&data_.at(offset), &x.values().at(0), bytes);
+ return Ok;
+ }
}
}
}
@@ -76,9 +83,9 @@ class InitialImage {
if (elements * elementBytes != bytes) {
return SizeMismatch;
} else if (bytes == 0) {
- return Ok;
+ return OkNoChange;
} else {
- Result result{Ok};
+ Result result{OkNoChange};
for (auto at{x.lbounds()}; elements-- > 0; x.IncrementSubscripts(at)) {
auto scalar{x.At(at)}; // this is a std string; size() in chars
auto scalarBytes{scalar.size() * KIND};
@@ -90,7 +97,14 @@ class InitialImage {
scalar += ' ';
}
// TODO endianness
- std::memcpy(&data_.at(offset), scalar.data(), elementBytes);
+ auto *to{&data_.at(offset)};
+ const auto *from{&x.values().at(0)};
+ if (std::memcmp(to, from, elementBytes) != 0) {
+ std::memcpy(&data_.at(offset), scalar.data(), elementBytes);
+ if (result == OkNoChange) {
+ result = Ok;
+ }
+ }
offset += elementBytes;
}
return result;
@@ -106,9 +120,10 @@ class InitialImage {
[&](const auto &y) { return Add(offset, bytes, y, c); }, x.u);
}
- void AddPointer(ConstantSubscript, const Expr<SomeType> &);
+ Result AddPointer(ConstantSubscript, const Expr<SomeType> &);
- void Incorporate(ConstantSubscript toOffset, const InitialImage &from,
+ // Returns true if anything changes
+ bool Incorporate(ConstantSubscript toOffset, const InitialImage &from,
ConstantSubscript fromOffset, ConstantSubscript bytes);
// Conversions to constant initializers
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 8586a60c5b21c..c847e6d509878 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -56,7 +56,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy,
InaccessibleDeferredOverride, CudaWarpMatchFunction, DoConcurrentOffload,
- TransferBOZ, Coarray, PointerPassObject)
+ TransferBOZ, Coarray, PointerPassObject, MultipleIdenticalDATA)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 1fbbbba909fbf..3c4f3ecc61996 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -278,7 +278,7 @@ std::optional<Expr<SomeType>> FoldTransfer(
(elements == 0 || totalBytes / elements == *sourceBytes)) {
InitialImage image{*sourceBytes};
auto status{image.Add(0, *sourceBytes, *source, context)};
- if (status == InitialImage::Ok) {
+ if (status == InitialImage::Ok || status == InitialImage::OkNoChange) {
return image.AsConstant(
context, *moldType, moldLength, *extents, true /*pad with 0*/);
} else {
diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp
index 6a712bcfbe1bc..050c55e399b57 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -28,43 +28,57 @@ auto InitialImage::Add(ConstantSubscript offset, std::size_t bytes,
return SizeMismatch;
} else {
auto at{x.lbounds()};
+ Result result{OkNoChange};
for (; elements-- > 0; x.IncrementSubscripts(at)) {
auto scalar{x.At(at)};
// TODO: length type parameter values?
for (const auto &[symbolRef, indExpr] : scalar) {
const Symbol &component{*symbolRef};
+ Result status{OkNoChange};
if (component.offset() + component.size() > elementBytes) {
return SizeMismatch;
} else if (IsPointer(component)) {
- AddPointer(offset + component.offset(), indExpr.value());
+ status = AddPointer(offset + component.offset(), indExpr.value());
} else if (IsAllocatable(component) || IsAutomatic(component)) {
return NotAConstant;
- } else if (auto result{Add(offset + component.offset(),
- component.size(), indExpr.value(), context)};
- result != Ok) {
- return result;
+ } else {
+ status = Add(offset + component.offset(), component.size(),
+ indExpr.value(), context);
+ }
+ if (status == Ok) {
+ result = Ok;
+ } else if (status != OkNoChange) {
+ return status;
}
}
offset += elementBytes;
}
+ return result;
}
- return Ok;
}
}
-void InitialImage::AddPointer(
- ConstantSubscript offset, const Expr<SomeType> &pointer) {
- pointers_.emplace(offset, pointer);
+auto InitialImage::AddPointer(
+ ConstantSubscript offset, const Expr<SomeType> &pointer) -> Result {
+ auto [iter, isNew]{pointers_.emplace(offset, pointer)};
+ return !isNew && iter->second == pointer ? OkNoChange : Ok;
}
-void InitialImage::Incorporate(ConstantSubscript toOffset,
+bool InitialImage::Incorporate(ConstantSubscript toOffset,
const InitialImage &from, ConstantSubscript fromOffset,
ConstantSubscript bytes) {
CHECK(from.pointers_.empty()); // pointers are not allowed in EQUIVALENCE
CHECK(fromOffset >= 0 && bytes >= 0 &&
static_cast<std::size_t>(fromOffset + bytes) <= from.size());
CHECK(static_cast<std::size_t>(toOffset + bytes) <= size());
- std::memcpy(&data_[toOffset], &from.data_[fromOffset], bytes);
+ auto *dest{&data_[toOffset]};
+ const auto *source{&from.data_[fromOffset]};
+ if (std::memcmp(dest, source, bytes) != 0) {
+ std::memcpy(dest, source, bytes);
+ return true;
+ } else {
+ return false; // no change
+ }
}
// Classes used with common::SearchTypes() to (re)construct Constant<> values
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index d9e79340a6d91..cd9ec3059afec 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -335,7 +335,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
return ss.str();
}
}};
- const auto GetImage{[&]() -> evaluate::InitialImage & {
+ const auto GetSymbolInit{[&]() -> SymbolDataInitialization & {
// This could be (and was) written to always call std::map<>::emplace(),
// which should handle duplicate entries gracefully, but it was still
// causing memory allocation & deallocation with gcc.
@@ -343,9 +343,7 @@ bool DataInitializationCompiler<DSV>::InitElement(
if (iter == inits_.end()) {
iter = inits_.emplace(&symbol, symbol.size()).first;
}
- auto &symbolInit{iter->second};
- symbolInit.NoteInitializedRange(offsetSymbol);
- return symbolInit.image;
+ return iter->second;
}};
const auto OutOfRangeError{[&]() {
evaluate::AttachDeclaration(
@@ -394,7 +392,10 @@ bool DataInitializationCompiler<DSV>::InitElement(
scope,
/*isBoundsRemapping=*/false, /*isAssumedRank=*/false)) {
if (lastSymbol->has<ProcEntityDetails>()) {
- GetImage().AddPointer(offsetSymbol.offset(), *expr);
+ auto &symInit{GetSymbolInit()};
+ symInit.NoteInitializedRange(offsetSymbol, /*isDuplicate=*/
+ symInit.image.AddPointer(offsetSymbol.offset(), *expr) ==
+ evaluate::InitialImage::OkNoChange);
return true;
} else {
evaluate::AttachDeclaration(
@@ -415,7 +416,10 @@ bool DataInitializationCompiler<DSV>::InitElement(
expr->AsFortran(), DescribeElement());
} else if (CheckInitialDataPointerTarget(
exprAnalyzer_.context(), designator, *expr, scope)) {
- GetImage().AddPointer(offsetSymbol.offset(), *expr);
+ auto &symInit{GetSymbolInit()};
+ symInit.NoteInitializedRange(offsetSymbol, /*isDuplicate=*/
+ symInit.image.AddPointer(offsetSymbol.offset(), *expr) ==
+ evaluate::InitialImage::OkNoChange);
return true;
}
} else if (evaluate::IsNullPointer(expr)) {
@@ -448,9 +452,14 @@ bool DataInitializationCompiler<DSV>::InitElement(
// Rewritten from a switch() in order to avoid getting complaints
// about a missing "default:" from some compilers and complaints
// about a redundant "default:" from others.
- auto status{GetImage().Add(
+ auto &symInit{GetSymbolInit()};
+ auto status{symInit.image.Add(
offsetSymbol.offset(), offsetSymbol.size(), folded, context)};
if (status == evaluate::InitialImage::Ok) {
+ symInit.NoteInitializedRange(offsetSymbol, /*isDuplicate=*/false);
+ return true;
+ } else if (status == evaluate::InitialImage::OkNoChange) {
+ symInit.NoteInitializedRange(offsetSymbol, /*isDuplicate=*/true);
return true;
} else if (status == evaluate::InitialImage::NotAConstant) {
exprAnalyzer_.Say(
@@ -567,48 +576,36 @@ static void PopulateWithComponentDefaults(SymbolDataInitialization &init,
if (!IsAllocatable(component) && !IsAutomatic(component)) {
bool initialized{false};
if (object->init()) {
- initialized = true;
if (IsPointer(component)) {
- if (auto extant{init.image.AsConstantPointer(componentOffset)}) {
- initialized = !(*extant == *object->init());
- }
- if (initialized) {
- init.image.AddPointer(componentOffset, *object->init());
+ if (init.image.AddPointer(componentOffset, *object->init()) ==
+ evaluate::InitialImage::Ok) {
+ initialized = true;
}
} else { // data, not pointer
- if (auto dyType{evaluate::DynamicType::From(component)}) {
- if (auto extents{evaluate::GetConstantExtents(
- foldingContext, component)}) {
- if (auto extant{init.image.AsConstant(foldingContext, *dyType,
- std::nullopt, *extents, false /*don't pad*/,
- componentOffset)}) {
- initialized = !(*extant == *object->init());
- }
- }
- }
- if (initialized) {
- init.image.Add(componentOffset, component.size(), *object->init(),
- foldingContext);
+ if (init.image.Add(componentOffset, component.size(),
+ *object->init(),
+ foldingContext) == evaluate::InitialImage::Ok) {
+ initialized = true;
}
}
- } else if (const DeclTypeSpec * type{component.GetType()}) {
+ } else if (const DeclTypeSpec *type{component.GetType()}) {
if (const DerivedTypeSpec * componentDerived{type->AsDerived()}) {
PopulateWithComponentDefaults(init, componentOffset,
*componentDerived, foldingContext, component);
}
}
if (initialized) {
- init.NoteInitializedRange(componentOffset, component.size());
+ init.NoteInitializedRange(componentOffset, component.size(),
+ /*isDuplicate=*/false);
}
}
} else if (const auto *proc{component.detailsIf<ProcEntityDetails>()}) {
if (proc->init() && *proc->init()) {
SomeExpr procPtrInit{evaluate::ProcedureDesignator{**proc->init()}};
- auto extant{init.image.AsConstantPointer(componentOffset)};
- if (!extant || !(*extant == procPtrInit)) {
- init.NoteInitializedRange(componentOffset, component.size());
- init.image.AddPointer(componentOffset, std::move(procPtrInit));
- }
+ init.NoteInitializedRange(componentOffset,
+ component.size(), /*isDuplicate=*/
+ init.image.AddPointer(componentOffset, std::move(procPtrInit)) ==
+ evaluate::InitialImage::OkNoChange);
}
}
}
@@ -620,22 +617,26 @@ static bool CheckForOverlappingInitialization(
evaluate::ExpressionAnalyzer &exprAnalyzer, const std::string &what) {
bool result{true};
auto &context{exprAnalyzer.GetFoldingContext()};
- initialization.initializedRanges.sort();
+ initialization.initializationItems.sort();
ConstantSubscript next{0};
- for (const auto &range : initialization.initializedRanges) {
- if (range.start() < next) {
+ SourceOrderedSymbolSet errors;
+ // Emit errors for multiple distinct initializations
+ for (const auto &item : initialization.initializationItems) {
+ const auto &range{item.range};
+ if (range.start() < next && !item.isDuplicate) {
result = false; // error: overlap
bool hit{false};
for (const Symbol &symbol : symbols) {
auto offset{range.start() -
static_cast<ConstantSubscript>(
symbol.offset() - symbols.front()->offset())};
- if (offset >= 0) {
+ if (offset >= 0 && static_cast<std::size_t>(offset) < symbol.size()) {
if (auto badDesignator{evaluate::OffsetToDesignator(
context, symbol, offset, range.size())}) {
hit = true;
+ errors.insert(symbol);
exprAnalyzer.Say(symbol.name(),
- "%s affect '%s' more than once"_err_en_US, what,
+ "%s affect '%s' more than once, distinctly"_err_en_US, what,
badDesignator->AsFortran());
}
}
@@ -645,6 +646,31 @@ static bool CheckForOverlappingInitialization(
next = range.start() + range.size();
CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
}
+ // Emit warnings for multiple identical initializations
+ next = 0;
+ for (const auto &item : initialization.initializationItems) {
+ const auto &range{item.range};
+ if (range.start() < next && item.isDuplicate) {
+ for (const Symbol &symbol : symbols) {
+ if (errors.find(symbol) == errors.end()) {
+ auto offset{range.start() -
+ static_cast<ConstantSubscript>(
+ symbol.offset() - symbols.front()->offset())};
+ if (offset >= 0) {
+ if (auto badDesignator{evaluate::OffsetToDesignator(
+ context, symbol, offset, range.size())}) {
+ exprAnalyzer.Warn(common::LanguageFeature::MultipleIdenticalDATA,
+ symbol.name(),
+ "%s affect '%s' more than once, identically"_port_en_US, what,
+ badDesignator->AsFortran());
+ }
+ }
+ }
+ }
+ }
+ next = range.start() + range.size();
+ CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size()));
+ }
return result;
}
@@ -655,11 +681,13 @@ static void IncorporateExplicitInitialization(
auto iter{inits.find(&symbol)};
const auto offset{symbol.offset() - firstOffset};
if (iter != inits.end()) { // DATA statement initialization
- for (const auto &range : iter->second.initializedRanges) {
- auto at{offset + range.start()};
- combined.NoteInitializedRange(at, range.size());
- combined.image.Incorporate(
- at, iter->second.image, range.start(), range.size());
+ for (const auto &item : iter->second.initializationItems) {
+ auto at{offset + item.range.start()};
+ if (combined.image.Incorporate(
+ at, iter->second.image, item.range.start(), item.range.size())) {
+ combined.NoteInitializedRange(
+ at, item.range.size(), /*isDuplicate=*/false);
+ }
}
if (removeOriginalInits) {
inits.erase(iter);
@@ -669,17 +697,21 @@ static void IncorporateExplicitInitialization(
if (IsPointer(mutableSymbol)) {
if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
if (object->init()) {
- combined.NoteInitializedRange(offset, mutableSymbol.size());
- combined.image.AddPointer(offset, *object->init());
+ combined.NoteInitializedRange(offset,
+ mutableSymbol.size(), /*isDuplicate=*/
+ combined.image.AddPointer(offset, *object->init()) ==
+ evaluate::InitialImage::OkNoChange);
if (removeOriginalInits) {
object->init().reset();
}
}
} else if (auto *proc{mutableSymbol.detailsIf<ProcEntityDetails>()}) {
if (proc->init() && *proc->init()) {
- combined.NoteInitializedRange(offset, mutableSymbol.size());
- combined.image.AddPointer(
- offset, SomeExpr{evaluate::ProcedureDesignator{**proc->init()}});
+ combined.NoteInitializedRange(offset,
+ mutableSymbol.size(), /*isDuplicate=*/
+ combined.image.AddPointer(offset,
+ SomeExpr{evaluate::ProcedureDesignator{**proc->init()}}) ==
+ evaluate::InitialImage::OkNoChange);
if (removeOriginalInits) {
proc->init().reset();
}
@@ -687,9 +719,10 @@ static void IncorporateExplicitInitialization(
}
} else if (auto *object{mutableSymbol.detailsIf<ObjectEntityDetails>()}) {
if (!IsNamedConstant(mutableSymbol) && object->init()) {
- combined.NoteInitializedRange(offset, mutableSymbol.size());
- combined.image.Add(
- offset, mutableSymbol.size(), *object->init(), foldingContext);
+ auto status{combined.image.Add(
+ offset, mutableSymbol.size(), *object->init(), foldingContext)};
+ combined.NoteInitializedRange(offset, mutableSymbol.size(),
+ status == evaluate::InitialImage::OkNoChange);
if (removeOriginalInits) {
object->init().reset();
}
@@ -759,12 +792,12 @@ static bool CombineEquivalencedInitialization(
}
}
if (!CheckForOverlappingInitialization(associated, combined, exprAnalyzer,
- "Distinct default component initializations of equivalenced objects"s)) {
+ "Default component initializations of equivalenced objects"s)) {
return false;
}
// Don't complain about overlap between explicit initializations and
// default initializations.
- combined.initializedRanges.clear();
+ combined.initializationItems.clear();
// Now overlay all explicit initializations from DATA statements and
// from initializers in declarations.
for (const Symbol &symbol : associated) {
diff --git a/flang/lib/Semantics/data-to-inits.h b/flang/lib/Semantics/data-to-inits.h
index 330a6867a0732..9a0836c330b96 100644
--- a/flang/lib/Semantics/data-to-inits.h
+++ b/flang/lib/Semantics/data-to-inits.h
@@ -29,25 +29,39 @@ class Symbol;
struct SymbolDataInitialization {
using Range = common::Interval<common::ConstantSubscript>;
+ struct Item {
+ Item(Range r, bool isD) : range{r}, isDuplicate{isD} {}
+ bool operator<(const Item &that) const { return range < that.range; }
+ Range range;
+ bool isDuplicate;
+ };
explicit SymbolDataInitialization(std::size_t bytes) : image{bytes} {}
SymbolDataInitialization(SymbolDataInitialization &&) = default;
- void NoteInitializedRange(Range range) {
- if (initializedRanges.empty() ||
- !initializedRanges.back().AnnexIfPredecessor(range)) {
- initializedRanges.emplace_back(range);
+ void NoteInitializedRange(Range range, bool isDuplicate = false) {
+ if (!initializationItems.empty()) {
+ auto &last{initializationItems.back()};
+ if (last.isDuplicate == isDuplicate &&
+ last.range.AnnexIfPredecessor(range)) {
+ return;
+ }
+ }
+ if (!range.empty()) {
+ initializationItems.emplace_back(range, isDuplicate);
}
}
- void NoteInitializedRange(
- common::ConstantSubscript offset, std::size_t size) {
- NoteInitializedRange(Range{offset, size});
+ void NoteInitializedRange(common::ConstantSubscript offset, std::size_t size,
+ bool isDuplicate = false) {
+ NoteInitializedRange(Range{offset, size}, isDuplicate);
}
- void NoteInitializedRange(evaluate::OffsetSymbol offsetSymbol) {
- NoteInitializedRange(offsetSymbol.offset(), offsetSymbol.size());
+ void NoteInitializedRange(
+ evaluate::OffsetSymbol offsetSymbol, bool isDuplicate = false) {
+ NoteInitializedRange(
+ offsetSymbol.offset(), offsetSymbol.size(), isDuplicate);
}
evaluate::InitialImage image;
- std::list<Range> initializedRanges;
+ std::list<Item> initializationItems;
};
using DataInitializations = std::map<const Symbol *, SymbolDataInitialization>;
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index d9b14f7d17f0c..1f23a6c29bbe7 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -261,12 +261,8 @@ static bool PerformStatementSemantics(
}
if (!context.messages().AnyFatalError()) {
WarnUndefinedFunctionResult(context, context.globalScope());
- }
- if (!context.messages().AnyFatalError()) {
- WarnUnusedOrUndefinedLocal(context, context.globalScope());
- }
- if (!context.AnyFatalError()) {
pass2.CompileDataInitializationsIntoInitializers();
+ WarnUnusedOrUndefinedLocal(context, context.globalScope());
}
return !context.AnyFatalError();
}
diff --git a/flang/test/Semantics/bug2098.f90 b/flang/test/Semantics/bug2098.f90
new file mode 100644
index 0000000000000..4f8c2bef8fa1f
--- /dev/null
+++ b/flang/test/Semantics/bug2098.f90
@@ -0,0 +1,14 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+!ERROR: DATA statement initializations affect 'a(1_8)' more than once, distinctly
+!PORTABILITY: DATA statement initializations affect 'b(1_8)' more than once, identically [-Wmultiple-identical-data]
+integer a(2), b(2)
+data a(1)/1/
+data a(2)/2/
+data a(1)/3/
+data a(2)/2/
+data b(1)/4/
+data b(2)/5/
+data b(1)/4/
+data b(2)/5/
+print *, a, b
+end
diff --git a/flang/test/Semantics/data07.f90 b/flang/test/Semantics/data07.f90
index ddb1f8b282353..1d5f6e0098304 100644
--- a/flang/test/Semantics/data07.f90
+++ b/flang/test/Semantics/data07.f90
@@ -2,7 +2,7 @@
module m
contains
subroutine s1
- !ERROR: DATA statement initializations affect 'jb(5_8)' more than once
+ !ERROR: DATA statement initializations affect 'jb(5_8)' more than once, distinctly
integer :: ja(10), jb(10)
data (ja(k),k=1,9,2) / 5*1 / ! ok
data (ja(k),k=10,2,-2) / 5*2 / ! ok
diff --git a/flang/test/Semantics/data12.f90 b/flang/test/Semantics/data12.f90
index fa6120c1b4282..b88b670f83e2a 100644
--- a/flang/test/Semantics/data12.f90
+++ b/flang/test/Semantics/data12.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
type :: t1
sequence
integer :: m = 123
@@ -14,14 +14,14 @@
integer :: k = 234
integer :: pad
end type
-!ERROR: Distinct default component initializations of equivalenced objects affect 'x1a%m' more than once
+!ERROR: Default component initializations of equivalenced objects affect 'x1a%m' more than once, distinctly
type(t1) :: x1a
-!ERROR: Distinct default component initializations of equivalenced objects affect 'x2a%n' more than once
+!ERROR: Default component initializations of equivalenced objects affect 'x2a%n' more than once, distinctly
type(t2) :: x2a
-!ERROR: Distinct default component initializations of equivalenced objects affect 'x3%k' more than once
+!ERROR: Default component initializations of equivalenced objects affect 'x3%k' more than once, distinctly
type(t3), save :: x3
-!ERROR: Explicit initializations of equivalenced objects affect 'ja(2_8)' more than once
-!ERROR: Explicit initializations of equivalenced objects affect 'ka(1_8)' more than once
+!ERROR: Explicit initializations of equivalenced objects affect 'ja(2_8)' more than once, distinctly
+!ERROR: Explicit initializations of equivalenced objects affect 'ka(1_8)' more than once, distinctly
integer :: ja(2), ka(2)
data ja/345, 456/
data ka/456, 567/
diff --git a/flang/test/Semantics/data23.f90 b/flang/test/Semantics/data23.f90
index 8210e9e62b813..f53fe4603e009 100644
--- a/flang/test/Semantics/data23.f90
+++ b/flang/test/Semantics/data23.f90
@@ -1,18 +1,35 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
program p
interface
- subroutine s
+ subroutine s1
+ end subroutine
+ subroutine s2
end subroutine
end interface
- !ERROR: DATA statement initializations affect 'p' more than once
- procedure(s), pointer :: p
+ !ERROR: DATA statement initializations affect 'p1' more than once, distinctly
+ procedure(s1), pointer :: p1
+ !PORTABILITY: DATA statement initializations affect 'p2' more than once, identically [-Wmultiple-identical-data]
+ procedure(s2), pointer :: p2
type t
- procedure(s), pointer, nopass :: p
+ procedure(s1), pointer, nopass :: p
end type
- !ERROR: DATA statement initializations affect 'x%p' more than once
- type(t) x
- data p /s/
- data p /s/
- data x%p /s/
- data x%p /s/
+ !ERROR: DATA statement initializations affect 'x1%p' more than once, distinctly
+ !PORTABILITY: DATA statement initializations affect 'x2%p' more than once, identically [-Wmultiple-identical-data]
+ type(t) x1, x2
+ !PORTABILITY: Procedure pointer 'p1' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data p1 /s1/
+ !PORTABILITY: Procedure pointer 'p1' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data p1 /s2/
+ !PORTABILITY: Procedure pointer 'p2' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data p2 /s1/
+ !PORTABILITY: Procedure pointer 'p2' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data p2 /s1/
+ !PORTABILITY: Procedure pointer 'p' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data x1%p /s1/
+ !PORTABILITY: Procedure pointer 'p' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data x1%p /s2/
+ !PORTABILITY: Procedure pointer 'p' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data x2%p /s1/
+ !PORTABILITY: Procedure pointer 'p' in a DATA statement is not standard [-Wdata-stmt-extensions]
+ data x2%p /s1/
end
diff --git a/flang/test/Semantics/equivalence02.f90 b/flang/test/Semantics/equivalence02.f90
index 87658c20b1f63..094c88f0b3efb 100644
--- a/flang/test/Semantics/equivalence02.f90
+++ b/flang/test/Semantics/equivalence02.f90
@@ -7,23 +7,21 @@ program main
end type
type t1
sequence
- integer, dimension(2):: i/41, 2/
+ integer, dimension(2):: i/41, 2/
end type
type t2
sequence
integer :: j(2) = [42, 2]
end type
-! ERROR: Distinct default component initializations of equivalenced objects affect 'o1' more than once
type (t0) :: O1
-! ERROR: Distinct default component initializations of equivalenced objects affect 'a%i(1_8)' more than once
+! ERROR: Default component initializations of equivalenced objects affect 'a%i(1_8)' more than once, distinctly
type (t1) :: A
-! ERROR: Distinct default component initializations of equivalenced objects affect 'b%j(1_8)' more than once
+! ERROR: Default component initializations of equivalenced objects affect 'b%j(1_8)' more than once, distinctly
type (t2) :: B
-! ERROR: Distinct default component initializations of equivalenced objects affect 'x' more than once
-! ERROR: Distinct default component initializations of equivalenced objects affect 'o2(1_8)' more than once
+! ERROR: Default component initializations of equivalenced objects affect 'x' more than once, distinctly
integer :: x, O2(0)
data x/42/
-! ERROR: Distinct default component initializations of equivalenced objects affect 'undeclared' more than once
+! ERROR: Default component initializations of equivalenced objects affect 'undeclared' more than once, distinctly
equivalence (A, B, x, O1, O2, Undeclared)
call p(x)
call s()
@@ -38,12 +36,12 @@ subroutine s()
sequence
integer(kind=8)::d = 2_8
end type
- ! ERROR: Distinct default component initializations of equivalenced objects affect 'c%d' more than once
+ ! ERROR: Default component initializations of equivalenced objects affect 'c%d' more than once, distinctly
type (g1) :: C
- ! ERROR: Distinct default component initializations of equivalenced objects affect 'd%d' more than once
+ ! ERROR: Default component initializations of equivalenced objects affect 'd%d' more than once, distinctly
type (g2) :: D
- ! ERROR: Distinct default component initializations of equivalenced objects affect 'x' more than once
- ! ERROR: Distinct default component initializations of equivalenced objects affect 'y' more than once
+ ! ERROR: Default component initializations of equivalenced objects affect 'x' more than once, distinctly
+ ! ERROR: Default component initializations of equivalenced objects affect 'y' more than once, distinctly
integer :: x, y
data x/1/, y/2/
equivalence (C, x)
More information about the flang-commits
mailing list