[flang-commits] [flang] [flang] Warn about inexact real literal implicit widening pitfall (PR #152799)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Aug 8 14:22:48 PDT 2025
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/152799
When a REAL or COMPLEX literal appears without an explicit kind suffix or a kind-determining exponent letter, and the conversion of that literal from decimal to binary is inexact, emit a warning if that constant is later implicitly widened to a more precise kind, since it will have a different value than was probably intended.
Values that convert exactly from decimal to default real, e.g. 1.0 and 0.125, do not elicit this warning.
There are many contexts in which Fortran implicitly converts constants. This patch covers name constant values, variable and component initialization, constants in expressions, structure constructor components, and array constructors.
For example, "real(8) :: tenth = 0.1" is a common Fortran bug that's hard to find, and is one that often trips up even experienced Fortran programmers. Unlike C and C++, the literal constant 0.1 is *not* double precision by default, and it does not have the same value as 0.1d0 or 0.1_8 do when it is converted from decimal to real(4) and then to real(8).
>From 8b70d6ecdf56535391c0e837bfdb5cbf45375a85 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 7 Aug 2025 15:10:52 -0700
Subject: [PATCH] [flang] Warn about inexact real literal implicit widening
pitfall
When a REAL or COMPLEX literal appears without an explicit kind suffix
or a kind-determining exponent letter, and the conversion of that
literal from decimal to binary is inexact, emit a warning if that
constant is later implicitly widened to a more precise kind, since
it will have a different value than was probably intended.
Values that convert exactly from decimal to default real, e.g. 1.0 and
0.125, do not elicit this warning.
There are many contexts in which Fortran implicitly converts constants.
This patch covers name constant values, variable and component initialization,
constants in expressions, structure constructor components, and array
constructors.
For example, "real(8) :: tenth = 0.1" is a common Fortran bug that's
hard to find, and is one that often trips up even experienced Fortran
programmers. Unlike C and C++, the literal constant 0.1 is *not* double
precision by default, and it does not have the same value as 0.1d0 or
0.1_8 do when it is converted from decimal to real(4) and then to real(8).
---
flang/include/flang/Common/enum-set.h | 4 +-
.../include/flang/Evaluate/check-expression.h | 7 +
flang/include/flang/Evaluate/constant.h | 7 +-
flang/include/flang/Evaluate/real.h | 1 +
flang/include/flang/Evaluate/type.h | 22 ++-
.../include/flang/Support/Fortran-features.h | 3 +-
flang/lib/Evaluate/check-expression.cpp | 84 ++++++++++
flang/lib/Evaluate/fold-complex.cpp | 17 +-
flang/lib/Evaluate/fold-implementation.h | 10 +-
flang/lib/Evaluate/formatting.cpp | 16 ++
flang/lib/Evaluate/real.cpp | 8 +
flang/lib/Semantics/data-to-inits.cpp | 9 +-
flang/lib/Semantics/expression.cpp | 54 ++++---
flang/lib/Support/Fortran-features.cpp | 1 +
flang/test/Semantics/OpenACC/acc-branch.f90 | 32 ++--
.../Semantics/OpenACC/acc-init-validity.f90 | 12 +-
.../Semantics/OpenACC/acc-kernels-loop.f90 | 102 ++++++------
flang/test/Semantics/OpenACC/acc-kernels.f90 | 4 +-
flang/test/Semantics/OpenACC/acc-loop.f90 | 62 ++++----
.../OpenACC/acc-parallel-loop-validity.f90 | 22 +--
flang/test/Semantics/OpenACC/acc-parallel.f90 | 4 +-
.../Semantics/OpenACC/acc-serial-loop.f90 | 10 +-
flang/test/Semantics/OpenACC/acc-serial.f90 | 6 +-
.../Semantics/OpenACC/acc-set-validity.f90 | 12 +-
.../OpenACC/acc-shutdown-validity.f90 | 12 +-
.../Semantics/OpenMP/combined-constructs.f90 | 150 +++++++++---------
.../Semantics/OpenMP/device-constructs.f90 | 60 +++----
.../Semantics/OpenMP/nested-distribute.f90 | 12 +-
flang/test/Semantics/widening.f90 | 48 ++++++
29 files changed, 503 insertions(+), 288 deletions(-)
create mode 100644 flang/test/Semantics/widening.f90
diff --git a/flang/include/flang/Common/enum-set.h b/flang/include/flang/Common/enum-set.h
index 5290b76debee8..e048c66a393d0 100644
--- a/flang/include/flang/Common/enum-set.h
+++ b/flang/include/flang/Common/enum-set.h
@@ -175,10 +175,8 @@ template <typename ENUM, std::size_t BITS> class EnumSet {
constexpr bool empty() const { return none(); }
void clear() { reset(); }
void insert(enumerationType x) { set(x); }
- void insert(enumerationType &&x) { set(x); }
- void emplace(enumerationType &&x) { set(x); }
+ void emplace(enumerationType x) { set(x); }
void erase(enumerationType x) { reset(x); }
- void erase(enumerationType &&x) { reset(x); }
constexpr std::optional<enumerationType> LeastElement() const {
if (empty()) {
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 0cf12f340ec5c..eb152652f88c3 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -64,6 +64,13 @@ bool IsInitialProcedureTarget(const Symbol &);
bool IsInitialProcedureTarget(const ProcedureDesignator &);
bool IsInitialProcedureTarget(const Expr<SomeType> &);
+// Emit warnings about default REAL literal constants in contexts that
+// will be converted to a higher precision REAL kind than the default.
+void CheckRealWidening(
+ const Expr<SomeType> &, const DynamicType &toType, FoldingContext &);
+void CheckRealWidening(const Expr<SomeType> &,
+ const std::optional<DynamicType> &, FoldingContext &);
+
// Validate the value of a named constant, the static initial
// value of a non-pointer non-allocatable non-dummy variable, or the
// default initializer of a component of a derived type (or instantiation
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index d4c6601c37bca..14d6eb0f4b802 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -128,17 +128,19 @@ class ConstantBase : public ConstantBounds {
bool empty() const { return values_.empty(); }
std::size_t size() const { return values_.size(); }
const std::vector<Element> &values() const { return values_; }
- constexpr Result result() const { return result_; }
+ Result &result() { return result_; }
+ const Result &result() const { return result_; }
constexpr DynamicType GetType() const { return result_.GetType(); }
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+ std::string AsFortran() const;
protected:
std::vector<Element> Reshape(const ConstantSubscripts &) const;
std::size_t CopyFrom(const ConstantBase &source, std::size_t count,
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
- Result result_;
+ Result result_; // usually empty except for Real
std::vector<Element> values_;
};
@@ -209,6 +211,7 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
Constant Reshape(ConstantSubscripts &&) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+ std::string AsFortran() const;
DynamicType GetType() const { return {KIND, length_}; }
std::size_t CopyFrom(const Constant &source, std::size_t count,
ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index 76d25d9fe2670..dcd74073a4737 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -442,6 +442,7 @@ template <typename WORD, int PREC> class Real {
// or parenthesized constant expression that produces this value.
llvm::raw_ostream &AsFortran(
llvm::raw_ostream &, int kind, bool minimal = false) const;
+ std::string AsFortran(int kind, bool minimal = false) const;
private:
using Significand = Integer<significandBits>; // no implicit bit
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index f3bba7790e1a2..222018bb452a0 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -274,9 +274,26 @@ class Type<TypeCategory::Unsigned, KIND>
using Scalar = value::Integer<8 * KIND>;
};
+// Records when a default REAL literal constant is inexactly converted to binary
+// (e.g., 0.1 but not 0.125) to enable a usage warning if the expression in
+// which it appears undergoes an implicit widening conversion.
+class TrackInexactLiteralConversion {
+public:
+ constexpr bool isFromInexactLiteralConversion() const {
+ return isFromInexactLiteralConversion_;
+ }
+ void set_isFromInexactLiteralConversion(bool yes = true) {
+ isFromInexactLiteralConversion_ = yes;
+ }
+
+private:
+ bool isFromInexactLiteralConversion_{false};
+};
+
template <int KIND>
class Type<TypeCategory::Real, KIND>
- : public TypeBase<TypeCategory::Real, KIND> {
+ : public TypeBase<TypeCategory::Real, KIND>,
+ public TrackInexactLiteralConversion {
public:
static constexpr int precision{common::PrecisionOfRealKind(KIND)};
static constexpr int bits{common::BitsForBinaryPrecision(precision)};
@@ -289,7 +306,8 @@ class Type<TypeCategory::Real, KIND>
// The KIND type parameter on COMPLEX is the kind of each of its components.
template <int KIND>
class Type<TypeCategory::Complex, KIND>
- : public TypeBase<TypeCategory::Complex, KIND> {
+ : public TypeBase<TypeCategory::Complex, KIND>,
+ public TrackInexactLiteralConversion {
public:
using Part = Type<TypeCategory::Real, KIND>;
using Scalar = value::Complex<typename Part::Scalar>;
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 743abf606ab5f..bd3ff4a70ef01 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -78,7 +78,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation,
CompatibleDeclarationsFromDistinctModules,
NullActualForDefaultIntentAllocatable, UseAssociationIntoSameNameSubprogram,
- HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile)
+ HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile,
+ RealConstantWidening)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 3d7f01d56c465..522ab1980f4ee 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -405,6 +405,88 @@ bool IsInitialProcedureTarget(const Expr<SomeType> &expr) {
}
}
+class SuspiciousRealLiteralFinder
+ : public AnyTraverse<SuspiciousRealLiteralFinder> {
+public:
+ using Base = AnyTraverse<SuspiciousRealLiteralFinder>;
+ SuspiciousRealLiteralFinder(int kind, FoldingContext &c)
+ : Base{*this}, kind_{kind}, context_{c} {}
+ using Base::operator();
+ template <int KIND>
+ bool operator()(const Constant<Type<TypeCategory::Real, KIND>> &x) const {
+ if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
+ context_.messages().Say(common::UsageWarning::RealConstantWidening,
+ "Default real literal in REAL(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
+ kind_, x.AsFortran());
+ return true;
+ } else {
+ return false;
+ }
+ }
+ template <int KIND>
+ bool operator()(const Constant<Type<TypeCategory::Complex, KIND>> &x) const {
+ if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
+ context_.messages().Say(common::UsageWarning::RealConstantWidening,
+ "Default real literal in COMPLEX(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
+ kind_, x.AsFortran());
+ return true;
+ } else {
+ return false;
+ }
+ }
+ template <TypeCategory TOCAT, int TOKIND, TypeCategory FROMCAT>
+ bool operator()(const Convert<Type<TOCAT, TOKIND>, FROMCAT> &x) const {
+ if constexpr ((TOCAT == TypeCategory::Real ||
+ TOCAT == TypeCategory::Complex) &&
+ (FROMCAT == TypeCategory::Real || FROMCAT == TypeCategory::Complex)) {
+ auto fromType{x.left().GetType()};
+ if (!fromType || fromType->kind() < TOKIND) {
+ return false;
+ }
+ }
+ return (*this)(x.left());
+ }
+
+private:
+ int kind_;
+ FoldingContext &context_;
+};
+
+void CheckRealWidening(const Expr<SomeType> &expr, const DynamicType &toType,
+ FoldingContext &context) {
+ if (toType.category() == TypeCategory::Real ||
+ toType.category() == TypeCategory::Complex) {
+ if (auto fromType{expr.GetType()}) {
+ if ((fromType->category() == TypeCategory::Real ||
+ fromType->category() == TypeCategory::Complex) &&
+ toType.kind() > fromType->kind()) {
+ SuspiciousRealLiteralFinder{toType.kind(), context}(expr);
+ }
+ }
+ }
+}
+
+void CheckRealWidening(const Expr<SomeType> &expr,
+ const std::optional<DynamicType> &toType, FoldingContext &context) {
+ if (toType) {
+ CheckRealWidening(expr, *toType, context);
+ }
+}
+
+class InexactLiteralConversionFlagClearer
+ : public AnyTraverse<InexactLiteralConversionFlagClearer> {
+public:
+ using Base = AnyTraverse<InexactLiteralConversionFlagClearer>;
+ InexactLiteralConversionFlagClearer() : Base(*this) {}
+ using Base::operator();
+ template <int KIND>
+ bool operator()(const Constant<Type<TypeCategory::Real, KIND>> &x) const {
+ auto &mut{const_cast<Type<TypeCategory::Real, KIND> &>(x.result())};
+ mut.set_isFromInexactLiteralConversion(false);
+ return false;
+ }
+};
+
// Converts, folds, and then checks type, rank, and shape of an
// initialization expression for a named constant, a non-pointer
// variable static initialization, a component default initializer,
@@ -416,6 +498,7 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
if (auto symTS{
characteristics::TypeAndShape::Characterize(symbol, context)}) {
auto xType{x.GetType()};
+ CheckRealWidening(x, symTS->type(), context);
auto converted{ConvertToType(symTS->type(), Expr<SomeType>{x})};
if (!converted &&
symbol.owner().context().IsEnabled(
@@ -433,6 +516,7 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
if (converted) {
auto folded{Fold(context, std::move(*converted))};
if (IsActuallyConstant(folded)) {
+ InexactLiteralConversionFlagClearer{}(folded);
int symRank{symTS->Rank()};
if (IsImpliedShape(symbol)) {
if (folded.Rank() == symRank) {
diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp
index 3eb8e1f3f1fc2..bcaede5536260 100644
--- a/flang/lib/Evaluate/fold-complex.cpp
+++ b/flang/lib/Evaluate/fold-complex.cpp
@@ -83,12 +83,21 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldOperation(
if (auto array{ApplyElementwise(context, x)}) {
return *array;
}
- using Result = Type<TypeCategory::Complex, KIND>;
+ using ComplexType = Type<TypeCategory::Complex, KIND>;
if (auto folded{OperandsAreConstants(x)}) {
- return Expr<Result>{
- Constant<Result>{Scalar<Result>{folded->first, folded->second}}};
+ using RealType = typename ComplexType::Part;
+ Constant<ComplexType> result{
+ Scalar<ComplexType>{folded->first, folded->second}};
+ if (const auto *re{UnwrapConstantValue<RealType>(x.left())};
+ re && re->result().isFromInexactLiteralConversion()) {
+ result.result().set_isFromInexactLiteralConversion();
+ } else if (const auto *im{UnwrapConstantValue<RealType>(x.right())};
+ im && im->result().isFromInexactLiteralConversion()) {
+ result.result().set_isFromInexactLiteralConversion();
+ }
+ return Expr<ComplexType>{std::move(result)};
}
- return Expr<Result>{std::move(x)};
+ return Expr<ComplexType>{std::move(x)};
}
#ifdef _MSC_VER // disable bogus warning about missing definitions
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 52e954d1cffbf..7c80d76784463 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1321,8 +1321,8 @@ template <typename T> class ArrayConstructorFolder {
*charLength_, std::move(elements_), ConstantSubscripts{n}}};
}
} else {
- return Expr<T>{
- Constant<T>{std::move(elements_), ConstantSubscripts{n}}};
+ return Expr<T>{Constant<T>{
+ std::move(elements_), ConstantSubscripts{n}, resultInfo_}};
}
}
return Expr<T>{std::move(array)};
@@ -1343,6 +1343,11 @@ template <typename T> class ArrayConstructorFolder {
if (!knownCharLength_) {
charLength_ = std::max(c->LEN(), charLength_.value_or(-1));
}
+ } else if constexpr (T::category == TypeCategory::Real ||
+ T::category == TypeCategory::Complex) {
+ if (c->result().isFromInexactLiteralConversion()) {
+ resultInfo_.set_isFromInexactLiteralConversion();
+ }
}
return true;
} else {
@@ -1395,6 +1400,7 @@ template <typename T> class ArrayConstructorFolder {
std::vector<Scalar<T>> elements_;
std::optional<ConstantSubscript> charLength_;
bool knownCharLength_{false};
+ typename Constant<T>::Result resultInfo_;
};
template <typename T>
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 121afc6f0f8bf..ec5dc0baaa5cb 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -98,6 +98,14 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
return o;
}
+template <typename RESULT, typename VALUE>
+std::string ConstantBase<RESULT, VALUE>::AsFortran() const {
+ std::string result;
+ llvm::raw_string_ostream sstream(result);
+ AsFortran(sstream);
+ return result;
+}
+
template <int KIND>
llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
llvm::raw_ostream &o) const {
@@ -126,6 +134,14 @@ llvm::raw_ostream &Constant<Type<TypeCategory::Character, KIND>>::AsFortran(
return o;
}
+template <int KIND>
+std::string Constant<Type<TypeCategory::Character, KIND>>::AsFortran() const {
+ std::string result;
+ llvm::raw_string_ostream sstream(result);
+ AsFortran(sstream);
+ return result;
+}
+
llvm::raw_ostream &EmitVar(llvm::raw_ostream &o, const Symbol &symbol,
std::optional<parser::CharBlock> name = std::nullopt) {
const auto &renamings{symbol.owner().context().moduleFileOutputRenamings()};
diff --git a/flang/lib/Evaluate/real.cpp b/flang/lib/Evaluate/real.cpp
index 2c0f2833f07dc..6e6b9f3ac77c2 100644
--- a/flang/lib/Evaluate/real.cpp
+++ b/flang/lib/Evaluate/real.cpp
@@ -750,6 +750,14 @@ llvm::raw_ostream &Real<W, P>::AsFortran(
return o;
}
+template <typename W, int P>
+std::string Real<W, P>::AsFortran(int kind, bool minimal) const {
+ std::string result;
+ llvm::raw_string_ostream sstream(result);
+ AsFortran(sstream, kind, minimal);
+ return result;
+}
+
// 16.9.180
template <typename W, int P> Real<W, P> Real<W, P>::RRSPACING() const {
if (IsNotANumber()) {
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index b4c83bab67088..1c454385e6989 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -285,21 +285,22 @@ template <typename DSV>
std::optional<std::pair<SomeExpr, bool>>
DataInitializationCompiler<DSV>::ConvertElement(
const SomeExpr &expr, const evaluate::DynamicType &type) {
+ evaluate::FoldingContext &foldingContext{exprAnalyzer_.GetFoldingContext()};
+ evaluate::CheckRealWidening(expr, type, foldingContext);
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
}
// Allow DATA initialization with Hollerith and kind=1 CHARACTER like
// (most) other Fortran compilers do.
- if (auto converted{evaluate::HollerithToBOZ(
- exprAnalyzer_.GetFoldingContext(), expr, type)}) {
+ if (auto converted{evaluate::HollerithToBOZ(foldingContext, expr, type)}) {
return {std::make_pair(std::move(*converted), true)};
}
SemanticsContext &context{exprAnalyzer_.context()};
if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
if (MaybeExpr converted{evaluate::DataConstantConversionExtension(
- exprAnalyzer_.GetFoldingContext(), type, expr)}) {
+ foldingContext, type, expr)}) {
context.Warn(common::LanguageFeature::LogicalIntegerAssignment,
- exprAnalyzer_.GetFoldingContext().messages().at(),
+ foldingContext.messages().at(),
"nonstandard usage: initialization of %s with %s"_port_en_US,
type.AsFortran(), expr.GetType().value().AsFortran());
return {std::make_pair(std::move(*converted), false)};
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 92dbe0e5da11c..d022378ce1455 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -828,7 +828,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
template <typename TYPE>
Constant<TYPE> ReadRealLiteral(
- parser::CharBlock source, FoldingContext &context) {
+ parser::CharBlock source, FoldingContext &context, bool isDefaultKind) {
const char *p{source.begin()};
auto valWithFlags{
Scalar<TYPE>::Read(p, context.targetCharacteristics().roundingMode())};
@@ -838,19 +838,24 @@ Constant<TYPE> ReadRealLiteral(
if (context.targetCharacteristics().areSubnormalsFlushedToZero()) {
value = value.FlushSubnormalToZero();
}
- return {value};
+ typename Constant<TYPE>::Result resultInfo;
+ resultInfo.set_isFromInexactLiteralConversion(
+ isDefaultKind && valWithFlags.flags.test(RealFlag::Inexact));
+ return {value, resultInfo};
}
struct RealTypeVisitor {
using Result = std::optional<Expr<SomeReal>>;
using Types = RealTypes;
- RealTypeVisitor(int k, parser::CharBlock lit, FoldingContext &ctx)
- : kind{k}, literal{lit}, context{ctx} {}
+ RealTypeVisitor(
+ int k, parser::CharBlock lit, FoldingContext &ctx, bool isDeftKind)
+ : kind{k}, literal{lit}, context{ctx}, isDefaultKind{isDeftKind} {}
template <typename T> Result Test() {
if (kind == T::kind) {
- return {AsCategoryExpr(ReadRealLiteral<T>(literal, context))};
+ return {
+ AsCategoryExpr(ReadRealLiteral<T>(literal, context, isDefaultKind))};
}
return std::nullopt;
}
@@ -858,6 +863,7 @@ struct RealTypeVisitor {
int kind;
parser::CharBlock literal;
FoldingContext &context;
+ bool isDefaultKind;
};
// Reads a real literal constant and encodes it with the right kind.
@@ -909,8 +915,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
"Explicit kind parameter together with non-'E' exponent letter is not standard"_port_en_US);
}
}
- auto result{common::SearchTypes(
- RealTypeVisitor{kind, x.real.source, GetFoldingContext()})};
+ bool isDefaultKind{!x.kind && letterKind.value_or('e') == 'e'};
+ auto result{common::SearchTypes(RealTypeVisitor{
+ kind, x.real.source, GetFoldingContext(), isDefaultKind})};
if (!result) { // C717
Say("Unsupported REAL(KIND=%d)"_err_en_US, kind);
}
@@ -1841,8 +1848,7 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
if (*thisLen != *constantLength_ && !(messageDisplayedSet_ & 1)) {
exprAnalyzer_.Warn(
common::LanguageFeature::DistinctArrayConstructorLengths,
- "Character literal in array constructor without explicit "
- "type has different length than earlier elements"_port_en_US);
+ "Character literal in array constructor without explicit type has different length than earlier elements"_port_en_US);
messageDisplayedSet_ |= 1;
}
if (*thisLen > *constantLength_) {
@@ -1862,17 +1868,17 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
} else {
if (!(messageDisplayedSet_ & 2)) {
exprAnalyzer_.Say(
- "Values in array constructor must have the same declared type "
- "when no explicit type appears"_err_en_US); // C7110
+ "Values in array constructor must have the same declared type when no explicit type appears"_err_en_US); // C7110
messageDisplayedSet_ |= 2;
}
}
} else {
+ CheckRealWidening(*x, *type_, exprAnalyzer_.GetFoldingContext());
if (auto cast{ConvertToType(*type_, std::move(*x))}) {
values_.Push(std::move(*cast));
} else if (!(messageDisplayedSet_ & 4)) {
- exprAnalyzer_.Say("Value in array constructor of type '%s' could not "
- "be converted to the type of the array '%s'"_err_en_US,
+ exprAnalyzer_.Say(
+ "Value in array constructor of type '%s' could not be converted to the type of the array '%s'"_err_en_US,
x->GetType()->AsFortran(), type_->AsFortran()); // C7111, C7112
messageDisplayedSet_ |= 4;
}
@@ -2065,8 +2071,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
// Check if implicit conversion of expr to the symbol type is legal (if needed),
// and make it explicit if requested.
-static MaybeExpr ImplicitConvertTo(const semantics::Symbol &sym,
- Expr<SomeType> &&expr, bool keepConvertImplicit) {
+static MaybeExpr ImplicitConvertTo(const Symbol &sym, Expr<SomeType> &&expr,
+ bool keepConvertImplicit, FoldingContext &foldingContext) {
+ CheckRealWidening(expr, DynamicType::From(sym), foldingContext);
if (!keepConvertImplicit) {
return ConvertToType(sym, std::move(expr));
} else {
@@ -2293,10 +2300,12 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
// convert would cause a segfault. Lowering will deal with
// conditionally converting and preserving the lower bounds in this
// case.
- if (MaybeExpr converted{ImplicitConvertTo(
- *symbol, std::move(value), IsAllocatable(*symbol))}) {
- if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
- if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
+ FoldingContext &foldingContext{GetFoldingContext()};
+ if (MaybeExpr converted{ImplicitConvertTo(*symbol, std::move(value),
+ /*keepConvertImplicit=*/IsAllocatable(*symbol),
+ foldingContext)}) {
+ if (auto componentShape{GetShape(foldingContext, *symbol)}) {
+ if (auto valueShape{GetShape(foldingContext, *converted)}) {
if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
AttachDeclaration(
Say(exprSource,
@@ -2310,7 +2319,7 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
if (checked && *checked && GetRank(*componentShape) > 0 &&
GetRank(*valueShape) == 0 &&
(IsDeferredShape(*symbol) ||
- !IsExpandableScalar(*converted, GetFoldingContext(),
+ !IsExpandableScalar(*converted, foldingContext,
*componentShape, true /*admit PURE call*/))) {
AttachDeclaration(
Say(exprSource,
@@ -4827,6 +4836,11 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
// conversion in this case.
if (lhsType) {
if (rhsType) {
+ FoldingContext &foldingContext{context_.GetFoldingContext()};
+ auto restorer{foldingContext.messages().SetLocation(
+ actuals_.at(1).value().sourceLocation().value_or(
+ foldingContext.messages().at()))};
+ CheckRealWidening(rhs, lhsType, foldingContext);
if (!IsAllocatableDesignator(lhs) || context_.inWhereBody()) {
AddAssignmentConversion(*lhsType, *rhsType);
}
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index df51b3c577125..6a61149e97001 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -147,6 +147,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnUsage_.set(UsageWarning::UseAssociationIntoSameNameSubprogram);
warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr);
warnUsage_.set(UsageWarning::NonVolatilePointerToVolatile);
+ warnUsage_.set(UsageWarning::RealConstantWidening);
// New warnings, on by default
warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
diff --git a/flang/test/Semantics/OpenACC/acc-branch.f90 b/flang/test/Semantics/OpenACC/acc-branch.f90
index a2d7b583f6794..0a1bdc3afd65a 100644
--- a/flang/test/Semantics/OpenACC/acc-branch.f90
+++ b/flang/test/Semantics/OpenACC/acc-branch.f90
@@ -13,7 +13,7 @@ subroutine openacc_clause_validity
!$acc parallel
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a PARALLEL construct
return
end do
@@ -21,21 +21,21 @@ subroutine openacc_clause_validity
!$acc parallel loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a PARALLEL LOOP construct
return
end do
!$acc serial loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a SERIAL LOOP construct
return
end do
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a KERNELS LOOP construct
return
end do
@@ -43,7 +43,7 @@ subroutine openacc_clause_validity
!$acc parallel
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
exit
end if
@@ -81,7 +81,7 @@ subroutine openacc_clause_validity
exit fortname
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
!ERROR: EXIT to construct 'name1' outside of PARALLEL construct is not allowed
exit name1
@@ -89,7 +89,7 @@ subroutine openacc_clause_validity
end do
loop2: do i = 1, N
- a(i) = 3.33
+ a(i) = 3.33d0
!ERROR: EXIT to construct 'thisblk' outside of PARALLEL construct is not allowed
exit thisblk
end do loop2
@@ -102,7 +102,7 @@ subroutine openacc_clause_validity
!$acc parallel
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
ifname: if (i == 2) then
! This is allowed.
exit ifname
@@ -113,7 +113,7 @@ subroutine openacc_clause_validity
!$acc parallel
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
stop 999 ! no error
end if
@@ -122,7 +122,7 @@ subroutine openacc_clause_validity
!$acc kernels
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a KERNELS construct
return
end do
@@ -130,7 +130,7 @@ subroutine openacc_clause_validity
!$acc kernels
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
exit
end if
@@ -139,7 +139,7 @@ subroutine openacc_clause_validity
!$acc kernels
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
stop 999 ! no error
end if
@@ -148,7 +148,7 @@ subroutine openacc_clause_validity
!$acc serial
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
!ERROR: RETURN statement is not allowed in a SERIAL construct
return
end do
@@ -156,7 +156,7 @@ subroutine openacc_clause_validity
!$acc serial
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
exit
end if
@@ -168,7 +168,7 @@ subroutine openacc_clause_validity
do i = 1, N
ifname: if (.true.) then
print *, "LGTM"
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
!ERROR: EXIT to construct 'name2' outside of SERIAL construct is not allowed
exit name2
@@ -181,7 +181,7 @@ subroutine openacc_clause_validity
!$acc serial
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
if(i == N-1) THEN
stop 999 ! no error
end if
diff --git a/flang/test/Semantics/OpenACC/acc-init-validity.f90 b/flang/test/Semantics/OpenACC/acc-init-validity.f90
index 083a2415a5d77..bede04dc9f38e 100644
--- a/flang/test/Semantics/OpenACC/acc-init-validity.f90
+++ b/flang/test/Semantics/OpenACC/acc-init-validity.f90
@@ -44,7 +44,7 @@ program openacc_init_validity
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -53,7 +53,7 @@ program openacc_init_validity
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
@@ -62,7 +62,7 @@ program openacc_init_validity
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels
@@ -70,21 +70,21 @@ program openacc_init_validity
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc serial loop
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop
do i = 1, N
!ERROR: Directive INIT may not be called within a compute region
!$acc init
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: At most one IF clause can appear on the INIT directive
diff --git a/flang/test/Semantics/OpenACC/acc-kernels-loop.f90 b/flang/test/Semantics/OpenACC/acc-kernels-loop.f90
index cfe27e4f8fca1..65c6293485aeb 100644
--- a/flang/test/Semantics/OpenACC/acc-kernels-loop.f90
+++ b/flang/test/Semantics/OpenACC/acc-kernels-loop.f90
@@ -31,75 +31,75 @@ program openacc_kernels_loop_validity
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels loop
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels loop
!$acc kernels loop num_gangs(8)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_gangs(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_gangs(8)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_workers(worker_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_workers(8)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop vector_length(vector_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop vector_length(128)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_gangs(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop if(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: Unmatched END SERIAL LOOP directive
!$acc end serial loop
@@ -107,194 +107,194 @@ program openacc_kernels_loop_validity
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the KERNELS LOOP directive
!$acc kernels loop device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels loop
!$acc kernels loop async
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop async(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop async(async1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(wait1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(wait1, wait2)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(wait1) wait(wait2)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(1, 2) async(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(queues: 1, 2) async(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(devnum: 1: 1, 2) async(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop wait(devnum: 1: queues: 1, 2) async(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_gangs(8)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop num_workers(8)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop vector_length(128)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop if(.true.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop if(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: At most one IF clause can appear on the KERNELS LOOP directive
!$acc kernels loop if(.true.) if(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop self
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop self(.true.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop self(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop copy(aa) copyin(bb) copyout(cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop copy(aa, bb) copyout(zero: cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop present(aa, bb) create(cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop copyin(readonly: aa, bb) create(zero: cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop deviceptr(aa, bb) no_create(cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: Argument `aa` on the ATTACH clause must be a variable or array with the POINTER or ALLOCATABLE attribute
!$acc kernels loop attach(aa, dd, p)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop private(aa, bb, cc)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop default(none) private(N, a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop default(none)
!ERROR: The DEFAULT(NONE) clause requires that 'n' must be listed in a data-mapping clause
do i = 1, N
!ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop default(present)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: At most one DEFAULT clause can appear on the KERNELS LOOP directive
!$acc kernels loop default(none) default(present)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop device_type(*)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop device_type(multicore)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop device_type(host, multicore)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop device_type(*) async wait num_gangs(8) num_workers(8) vector_length(128)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop device_type(*) async
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the KERNELS LOOP directive
!$acc kernels loop device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop
diff --git a/flang/test/Semantics/OpenACC/acc-kernels.f90 b/flang/test/Semantics/OpenACC/acc-kernels.f90
index 44e532a9012bf..9c3adfb233ff7 100644
--- a/flang/test/Semantics/OpenACC/acc-kernels.f90
+++ b/flang/test/Semantics/OpenACC/acc-kernels.f90
@@ -177,14 +177,14 @@ program openacc_kernels_validity
!$acc kernels device_type(*) async
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the KERNELS directive
!$acc kernels device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels
diff --git a/flang/test/Semantics/OpenACC/acc-loop.f90 b/flang/test/Semantics/OpenACC/acc-loop.f90
index 859cf3feec0d6..1bd663a046822 100644
--- a/flang/test/Semantics/OpenACC/acc-loop.f90
+++ b/flang/test/Semantics/OpenACC/acc-loop.f90
@@ -31,35 +31,35 @@ program openacc_loop_validity
!$acc parallel
!$acc loop tile(2)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel device_type(*) num_gangs(2)
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop seq
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop independent
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop auto
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -67,35 +67,35 @@ program openacc_loop_validity
!ERROR: At most one VECTOR clause can appear on the LOOP directive or in group separated by the DEVICE_TYPE clause
!$acc loop vector vector(128)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop vector
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop vector(10)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop vector(vector_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop vector(length: vector_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -103,35 +103,35 @@ program openacc_loop_validity
!ERROR: At most one WORKER clause can appear on the LOOP directive or in group separated by the DEVICE_TYPE clause
!$acc loop worker worker(10)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop worker
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop worker(10)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop worker(worker_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop worker(num: worker_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -139,58 +139,58 @@ program openacc_loop_validity
!ERROR: At most one GANG clause can appear on the LOOP directive or in group separated by the DEVICE_TYPE clause
!$acc loop gang gang(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc loop gang device_type(default) gang(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: At most one GANG clause can appear on the PARALLEL LOOP directive or in group separated by the DEVICE_TYPE clause
!$acc parallel loop gang gang(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop gang device_type(default) gang(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel
!$acc loop gang(gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop gang(num: gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop gang(gang_size, static:*)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop gang(num: gang_size, static:*)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel
!$acc loop gang(num: gang_size, static: gang_size)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -222,7 +222,7 @@ program openacc_loop_validity
!$acc loop collapse(-1)
do i = 1, N
do j = 1, N
- a(i) = 3.14 + j
+ a(i) = 3.14d0 + j
end do
end do
!$acc end parallel
@@ -231,7 +231,7 @@ program openacc_loop_validity
!ERROR: Clause PRIVATE is not allowed after clause DEVICE_TYPE on the LOOP directive
!$acc loop device_type(*) private(i)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -239,7 +239,7 @@ program openacc_loop_validity
!ERROR: Clause GANG is not allowed if clause SEQ appears on the LOOP directive
!$acc loop gang seq
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -247,7 +247,7 @@ program openacc_loop_validity
!ERROR: Clause WORKER is not allowed if clause SEQ appears on the LOOP directive
!$acc loop worker seq
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -255,7 +255,7 @@ program openacc_loop_validity
!ERROR: Clause VECTOR is not allowed if clause SEQ appears on the LOOP directive
!$acc loop vector seq
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -263,7 +263,7 @@ program openacc_loop_validity
!$acc parallel device_type(*) if(.TRUE.)
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -271,7 +271,7 @@ program openacc_loop_validity
do i = 1, N
!ERROR: Loop control is not present in the DO LOOP
do
- a(i) = 3.14
+ a(i) = 3.14d0
end do
end do
diff --git a/flang/test/Semantics/OpenACC/acc-parallel-loop-validity.f90 b/flang/test/Semantics/OpenACC/acc-parallel-loop-validity.f90
index 78e1a7ad7c452..96962bb1aa58a 100644
--- a/flang/test/Semantics/OpenACC/acc-parallel-loop-validity.f90
+++ b/flang/test/Semantics/OpenACC/acc-parallel-loop-validity.f90
@@ -19,64 +19,64 @@ program openacc_parallel_loop_validity
!$acc parallel loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel loop
!$acc parallel loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
!$acc parallel loop tile(2)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop self
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: SELF clause on the PARALLEL LOOP directive only accepts optional scalar logical expression
!$acc parallel loop self(bb, cc(:,:))
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop self(.true.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop self(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc parallel loop tile(2, 2)
do i = 1, N
do j = 1, N
- aa(i, j) = 3.14
+ aa(i, j) = 3.14d0
end do
end do
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the PARALLEL LOOP directive
!$acc parallel loop device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel loop
!$acc kernels loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: Unmatched END PARALLEL LOOP directive
!$acc end parallel loop
diff --git a/flang/test/Semantics/OpenACC/acc-parallel.f90 b/flang/test/Semantics/OpenACC/acc-parallel.f90
index b9d989ec6fced..635c547f744c8 100644
--- a/flang/test/Semantics/OpenACC/acc-parallel.f90
+++ b/flang/test/Semantics/OpenACC/acc-parallel.f90
@@ -24,7 +24,7 @@ program openacc_parallel_validity
!$acc parallel device_type(*) num_gangs(2)
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -149,7 +149,7 @@ program openacc_parallel_validity
!$acc parallel device_type(*) if(.TRUE.)
!$acc loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
diff --git a/flang/test/Semantics/OpenACC/acc-serial-loop.f90 b/flang/test/Semantics/OpenACC/acc-serial-loop.f90
index 5d2be7f7c6474..9f23a27a38b44 100644
--- a/flang/test/Semantics/OpenACC/acc-serial-loop.f90
+++ b/flang/test/Semantics/OpenACC/acc-serial-loop.f90
@@ -77,32 +77,32 @@ program openacc_serial_loop_validity
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the SERIAL LOOP directive
!$acc serial loop device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial loop
!$acc serial loop if(ifCondition)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial loop
!$acc serial loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: Unmatched END PARALLEL LOOP directive
!$acc end parallel loop
!$acc serial loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial loop
!$acc serial loop
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
diff --git a/flang/test/Semantics/OpenACC/acc-serial.f90 b/flang/test/Semantics/OpenACC/acc-serial.f90
index f3b81c992e6ea..d50bdf90931aa 100644
--- a/flang/test/Semantics/OpenACC/acc-serial.f90
+++ b/flang/test/Semantics/OpenACC/acc-serial.f90
@@ -39,7 +39,7 @@ program openacc_serial_validity
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
@@ -162,14 +162,14 @@ program openacc_serial_validity
!$acc serial device_type(*) async
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
!ERROR: Clause IF is not allowed after clause DEVICE_TYPE on the SERIAL directive
!$acc serial device_type(*) if(.TRUE.)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
diff --git a/flang/test/Semantics/OpenACC/acc-set-validity.f90 b/flang/test/Semantics/OpenACC/acc-set-validity.f90
index 74522b30d11bc..3d514e1ec4ecc 100644
--- a/flang/test/Semantics/OpenACC/acc-set-validity.f90
+++ b/flang/test/Semantics/OpenACC/acc-set-validity.f90
@@ -31,7 +31,7 @@ program openacc_clause_validity
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -40,7 +40,7 @@ program openacc_clause_validity
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
@@ -49,7 +49,7 @@ program openacc_clause_validity
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels
@@ -57,21 +57,21 @@ program openacc_clause_validity
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc serial loop
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop
do i = 1, N
!ERROR: Directive SET may not be called within a compute region
!$acc set default_async(i)
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!ERROR: At least one of DEFAULT_ASYNC, DEVICE_NUM, DEVICE_TYPE clause must appear on the SET directive
diff --git a/flang/test/Semantics/OpenACC/acc-shutdown-validity.f90 b/flang/test/Semantics/OpenACC/acc-shutdown-validity.f90
index 163130d41bdcc..fff630e8a9f83 100644
--- a/flang/test/Semantics/OpenACC/acc-shutdown-validity.f90
+++ b/flang/test/Semantics/OpenACC/acc-shutdown-validity.f90
@@ -32,7 +32,7 @@ program openacc_shutdown_validity
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end parallel
@@ -41,7 +41,7 @@ program openacc_shutdown_validity
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end serial
@@ -50,7 +50,7 @@ program openacc_shutdown_validity
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc end kernels
@@ -58,21 +58,21 @@ program openacc_shutdown_validity
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc serial loop
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc kernels loop
do i = 1, N
!ERROR: Directive SHUTDOWN may not be called within a compute region
!$acc shutdown
- a(i) = 3.14
+ a(i) = 3.14d0
end do
!$acc shutdown
diff --git a/flang/test/Semantics/OpenMP/combined-constructs.f90 b/flang/test/Semantics/OpenMP/combined-constructs.f90
index 2298d33ef33eb..49da56298d426 100644
--- a/flang/test/Semantics/OpenMP/combined-constructs.f90
+++ b/flang/test/Semantics/OpenMP/combined-constructs.f90
@@ -10,46 +10,46 @@ program main
!ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
!$omp distribute simd
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end distribute simd
!$omp target parallel device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!ERROR: At most one DEVICE clause can appear on the TARGET PARALLEL directive
!$omp target parallel device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!$omp target parallel defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!ERROR: 'variable-category' modifier is required
!$omp target parallel defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET PARALLEL directive
!$omp target parallel defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!$omp target parallel map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
@@ -57,46 +57,46 @@ program main
!ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
!$omp target parallel copyin(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel
!$omp target parallel do device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!ERROR: At most one DEVICE clause can appear on the TARGET PARALLEL DO directive
!$omp target parallel do device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!$omp target parallel do defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!ERROR: 'variable-category' modifier is required
!$omp target parallel do defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET PARALLEL DO directive
!$omp target parallel do defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!$omp target parallel do map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
@@ -104,406 +104,406 @@ program main
!ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause
!$omp target parallel do copyin(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target parallel do
!$omp target teams map(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: At most one DEVICE clause can appear on the TARGET TEAMS directive
!$omp target teams device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: SCHEDULE clause is not allowed on the TARGET TEAMS directive
!$omp target teams schedule(static)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: 'variable-category' modifier is required
!$omp target teams defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS directive
!$omp target teams defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS directive
!$omp target teams num_teams(2) num_teams(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
!$omp target teams num_teams(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS directive
!$omp target teams thread_limit(2) thread_limit(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
!$omp target teams thread_limit(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS directive
!$omp target teams default(shared) default(private)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams num_teams(2) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!ERROR: Only the ALLOC, FROM, TO, TOFROM map types are permitted for MAP clauses on the TARGET TEAMS directive
!$omp target teams map(delete:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams
!$omp target teams distribute map(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: 'variable-category' modifier is required
!$omp target teams distribute defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute num_teams(2) num_teams(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
!$omp target teams distribute num_teams(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute thread_limit(2) thread_limit(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
!$omp target teams distribute thread_limit(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute default(shared) default(private)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute num_teams(2) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!ERROR: Only the ALLOC, FROM, TO, TOFROM map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE directive
!$omp target teams distribute map(delete:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute
!$omp target teams distribute parallel do device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!$omp target teams distribute parallel do defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: 'variable-category' modifier is required
!$omp target teams distribute parallel do defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!$omp target teams distribute parallel do num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do num_teams(2) num_teams(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
!$omp target teams distribute parallel do num_teams(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do thread_limit(2) thread_limit(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
!$omp target teams distribute parallel do thread_limit(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do default(shared) default(private)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!$omp target teams distribute parallel do num_teams(2) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!$omp target teams distribute parallel do map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!ERROR: Only the ALLOC, FROM, TO, TOFROM map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE PARALLEL DO directive
!$omp target teams distribute parallel do map(delete:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do
!$omp target teams distribute parallel do simd map(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!$omp target teams distribute parallel do simd device(0)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: At most one DEVICE clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd device(0) device(1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!$omp target teams distribute parallel do simd defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: 'variable-category' modifier is required
!$omp target teams distribute parallel do simd defaultmap(tofrom)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!$omp target teams distribute parallel do simd num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: At most one NUM_TEAMS clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd num_teams(2) num_teams(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
!$omp target teams distribute parallel do simd num_teams(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: At most one THREAD_LIMIT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd thread_limit(2) thread_limit(3)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
!$omp target teams distribute parallel do simd thread_limit(-1)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: At most one DEFAULT clause can appear on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd default(shared) default(private)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!$omp target teams distribute parallel do simd num_teams(2) defaultmap(tofrom:scalar)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!$omp target teams distribute parallel do simd map(tofrom:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
!ERROR: Only the ALLOC, FROM, TO, TOFROM map types are permitted for MAP clauses on the TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD directive
!$omp target teams distribute parallel do simd map(delete:a)
do i = 1, N
- a(i) = 3.14
+ a(i) = 3.14d0
enddo
!$omp end target teams distribute parallel do simd
diff --git a/flang/test/Semantics/OpenMP/device-constructs.f90 b/flang/test/Semantics/OpenMP/device-constructs.f90
index 431e0f88e3237..a41c461874b90 100644
--- a/flang/test/Semantics/OpenMP/device-constructs.f90
+++ b/flang/test/Semantics/OpenMP/device-constructs.f90
@@ -8,131 +8,131 @@ program main
integer :: N
type(c_ptr) :: cptr
- arrayA = 1.414
- arrayB = 3.14
+ arrayA = 1.414d0
+ arrayB = 3.14d0
N = 256
!$omp target map(arrayA)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp target device(0)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!ERROR: At most one DEVICE clause can appear on the TARGET directive
!$omp target device(0) device(1)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!ERROR: SCHEDULE clause is not allowed on the TARGET directive
!$omp target schedule(static)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp target defaultmap(tofrom:scalar)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp target defaultmap(tofrom)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!ERROR: At most one DEFAULTMAP clause can appear on the TARGET directive
!$omp target defaultmap(tofrom:scalar) defaultmap(tofrom:scalar)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp target thread_limit(4)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!ERROR: At most one THREAD_LIMIT clause can appear on the TARGET directive
!$omp target thread_limit(4) thread_limit(8)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp teams num_teams(3) thread_limit(10) default(shared) private(i) shared(a)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!ERROR: At most one NUM_TEAMS clause can appear on the TEAMS directive
!$omp teams num_teams(2) num_teams(3)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!ERROR: The parameter of the NUM_TEAMS clause must be a positive integer expression
!$omp teams num_teams(-1)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!ERROR: At most one THREAD_LIMIT clause can appear on the TEAMS directive
!$omp teams thread_limit(2) thread_limit(3)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!ERROR: The parameter of the THREAD_LIMIT clause must be a positive integer expression
!$omp teams thread_limit(-1)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!ERROR: At most one DEFAULT clause can appear on the TEAMS directive
!$omp teams default(shared) default(private)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end teams
!$omp target teams num_teams(2) defaultmap(tofrom:scalar)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target teams
!$omp target map(tofrom:a)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!ERROR: Only the ALLOC, FROM, TO, TOFROM map types are permitted for MAP clauses on the TARGET directive
!$omp target map(delete:a)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target
!$omp target data device(0) map(to:a)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target data
@@ -147,7 +147,7 @@ program main
!ERROR: At least one of MAP, USE_DEVICE_ADDR, USE_DEVICE_PTR clause must appear on the TARGET DATA directive
!$omp target data device(0)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end target data
@@ -183,7 +183,7 @@ program main
!ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
!$omp distribute
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end target
@@ -192,7 +192,7 @@ program main
!$omp teams
!$omp distribute
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end teams
@@ -205,7 +205,7 @@ program main
do i = 1, N
do j = 1, N
do k = 1, N
- a = 3.14
+ a = 3.14d0
enddo
enddo
enddo
@@ -219,7 +219,7 @@ program main
do i = 1, N
do j = 1, N
do k = 1, N
- a = 3.14
+ a = 3.14d0
enddo
enddo
enddo
@@ -231,7 +231,7 @@ program main
!ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
!$omp distribute dist_schedule(static, 2)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end target
@@ -240,7 +240,7 @@ program main
!$omp teams
!$omp distribute dist_schedule(static, 2)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end teams
@@ -251,7 +251,7 @@ program main
!ERROR: At most one DIST_SCHEDULE clause can appear on the DISTRIBUTE directive
!$omp distribute dist_schedule(static, 2) dist_schedule(static, 3)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end target
@@ -261,7 +261,7 @@ program main
!ERROR: At most one DIST_SCHEDULE clause can appear on the DISTRIBUTE directive
!$omp distribute dist_schedule(static, 2) dist_schedule(static, 3)
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end teams
diff --git a/flang/test/Semantics/OpenMP/nested-distribute.f90 b/flang/test/Semantics/OpenMP/nested-distribute.f90
index c212763cba1df..cb4aea3bcdffa 100644
--- a/flang/test/Semantics/OpenMP/nested-distribute.f90
+++ b/flang/test/Semantics/OpenMP/nested-distribute.f90
@@ -6,15 +6,15 @@ program main
real(8) :: arrayA(256), arrayB(256)
integer :: N
- arrayA = 1.414
- arrayB = 3.14
+ arrayA = 1.414d0
+ arrayB = 3.14d0
N = 256
!$omp task
!ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
!$omp distribute
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end task
@@ -24,7 +24,7 @@ program main
!ERROR: Only `DISTRIBUTE`, `PARALLEL`, or `LOOP` regions are allowed to be strictly nested inside `TEAMS` region.
!$omp task
do k = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end task
enddo
@@ -34,7 +34,7 @@ program main
do i = 1, N
!$omp parallel
do k = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end parallel
enddo
@@ -44,7 +44,7 @@ program main
!ERROR: `DISTRIBUTE` region has to be strictly nested inside `TEAMS` region.
!$omp distribute
do i = 1, N
- a = 3.14
+ a = 3.14d0
enddo
!$omp end distribute
!$omp end parallel
diff --git a/flang/test/Semantics/widening.f90 b/flang/test/Semantics/widening.f90
new file mode 100644
index 0000000000000..52090c171de98
--- /dev/null
+++ b/flang/test/Semantics/widening.f90
@@ -0,0 +1,48 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.00000001490116119384765625e-1_4 is inexact [-Wreal-constant-widening]
+real(8), parameter :: warning1 = 0.1
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.10000002384185791015625_4 is inexact [-Wreal-constant-widening]
+real(8) :: warning2 = 1.1
+real, parameter :: noWarning1 = 2.1
+real(8) :: noWarning2 = warning1
+real(8) :: noWarning3 = noWarning1
+real(8) :: noWarning4 = 3.125 ! exact
+real(8) :: noWarning5 = 4.1d0 ! explicit 'd'
+real(8) :: noWarning6 = 5.1_4 ! explicit suffix
+real(8) :: noWarning7 = real(6.1, 8) ! explicit conversion
+real(8) :: noWarning8 = real(7.1d0) ! explicit narrowing conversion
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 8.1000003814697265625_4 is inexact [-Wreal-constant-widening]
+real(8) :: warning3 = real(8.1) ! no-op conversion
+! WARNING: Default real literal in COMPLEX(8) context might need a kind suffix, as its rounded value (9.1000003814697265625_4,1.01000003814697265625e1_4) is inexact [-Wreal-constant-widening]
+complex(8), parameter :: warning4 = (9.1, 10.1)
+! WARNING: Default real literal in COMPLEX(8) context might need a kind suffix, as its rounded value (1.11000003814697265625e1_4,1.21000003814697265625e1_4) is inexact [-Wreal-constant-widening]
+complex(8) :: warning5 = (11.1, 12.1)
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value [REAL(4)::1.31000003814697265625e1_4] is inexact [-Wreal-constant-widening]
+real(8) :: warning6(1) = [ 13.1 ]
+real(8) warning7
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.41000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+data warning7/14.1/
+type derived
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.51000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+ real(8) :: warning8 = 15.1
+ real(8) :: noWarning9 = real(16.1, 8)
+ real :: noWarning10 = 17.1
+end type
+type(derived) dx
+real noWarning11
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.81000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+warning7 = 18.1
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 1.91000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+dx%warning8 = 19.1
+dx%noWarning10 = 20.1
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 2.11000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+dx = derived(21.1)
+dx = derived(22.125)
+noWarning11 = 23.1
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 2.41000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+print *, [real(8) :: 24.1]
+! WARNING: Default real literal in REAL(8) context might need a kind suffix, as its rounded value 2.51000003814697265625e1_4 is inexact [-Wreal-constant-widening]
+print *, [real(8) :: noWarning11, 25.1]
+print *, [real(8) :: noWarning1] ! ok
+end
More information about the flang-commits
mailing list