From 45e4d59504fd980d62eb0958869537c238e5149d Mon Sep 17 00:00:00 2001 From: Peter Klausler 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/clause-validity01.f90 | 4 +- .../Semantics/OpenMP/combined-constructs.f90 | 150 +++++++++--------- .../Semantics/OpenMP/device-constructs.f90 | 60 +++---- .../Semantics/OpenMP/nested-distribute.f90 | 12 +- flang/test/Semantics/widening.f90 | 48 ++++++ 30 files changed, 505 insertions(+), 290 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 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 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 &); +// 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 &, const DynamicType &toType, FoldingContext &); +void CheckRealWidening(const Expr &, + const std::optional &, 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..9ae37cd999aa9 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 &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 Reshape(const ConstantSubscripts &) const; std::size_t CopyFrom(const ConstantBase &source, std::size_t count, ConstantSubscripts &resultSubscripts, const std::vector *dimOrder); - Result result_; + Result result_; // usually empty except for Real & Complex std::vector values_; }; @@ -209,6 +211,7 @@ class Constant> : 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 *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 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; // 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 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 class Type - : public TypeBase { + : public TypeBase, + public TrackInexactLiteralConversion { public: static constexpr int precision{common::PrecisionOfRealKind(KIND)}; static constexpr int bits{common::BitsForBinaryPrecision(precision)}; @@ -289,7 +306,8 @@ class Type // The KIND type parameter on COMPLEX is the kind of each of its components. template class Type - : public TypeBase { + : public TypeBase, + public TrackInexactLiteralConversion { public: using Part = Type; using Scalar = value::Complex; 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; using UsageWarnings = EnumSet; 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 &expr) { } } +class SuspiciousRealLiteralFinder + : public AnyTraverse { +public: + using Base = AnyTraverse; + SuspiciousRealLiteralFinder(int kind, FoldingContext &c) + : Base{*this}, kind_{kind}, context_{c} {} + using Base::operator(); + template + bool operator()(const Constant> &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 + bool operator()(const Constant> &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 + bool operator()(const Convert, 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 &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 &expr, + const std::optional &toType, FoldingContext &context) { + if (toType) { + CheckRealWidening(expr, *toType, context); + } +} + +class InexactLiteralConversionFlagClearer + : public AnyTraverse { +public: + using Base = AnyTraverse; + InexactLiteralConversionFlagClearer() : Base(*this) {} + using Base::operator(); + template + bool operator()(const Constant> &x) const { + auto &mut{const_cast &>(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> 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{x})}; if (!converted && symbol.owner().context().IsEnabled( @@ -433,6 +516,7 @@ std::optional> 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> FoldOperation( if (auto array{ApplyElementwise(context, x)}) { return *array; } - using Result = Type; + using ComplexType = Type; if (auto folded{OperandsAreConstants(x)}) { - return Expr{ - Constant{Scalar{folded->first, folded->second}}}; + using RealType = typename ComplexType::Part; + Constant result{ + Scalar{folded->first, folded->second}}; + if (const auto *re{UnwrapConstantValue(x.left())}; + re && re->result().isFromInexactLiteralConversion()) { + result.result().set_isFromInexactLiteralConversion(); + } else if (const auto *im{UnwrapConstantValue(x.right())}; + im && im->result().isFromInexactLiteralConversion()) { + result.result().set_isFromInexactLiteralConversion(); + } + return Expr{std::move(result)}; } - return Expr{std::move(x)}; + return Expr{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 class ArrayConstructorFolder { *charLength_, std::move(elements_), ConstantSubscripts{n}}}; } } else { - return Expr{ - Constant{std::move(elements_), ConstantSubscripts{n}}}; + return Expr{Constant{ + std::move(elements_), ConstantSubscripts{n}, resultInfo_}}; } } return Expr{std::move(array)}; @@ -1343,6 +1343,11 @@ template 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 class ArrayConstructorFolder { std::vector> elements_; std::optional charLength_; bool knownCharLength_{false}; + typename Constant::Result resultInfo_; }; template 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::AsFortran( return o; } +template +std::string ConstantBase::AsFortran() const { + std::string result; + llvm::raw_string_ostream sstream(result); + AsFortran(sstream); + return result; +} + template llvm::raw_ostream &Constant>::AsFortran( llvm::raw_ostream &o) const { @@ -126,6 +134,14 @@ llvm::raw_ostream &Constant>::AsFortran( return o; } +template +std::string Constant>::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 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::AsFortran( return o; } +template +std::string Real::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 Real Real::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 std::optional> DataInitializationCompiler::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 Constant ReadRealLiteral( - parser::CharBlock source, FoldingContext &context) { + parser::CharBlock source, FoldingContext &context, bool isDefaultKind) { const char *p{source.begin()}; auto valWithFlags{ Scalar::Read(p, context.targetCharacteristics().roundingMode())}; @@ -838,19 +838,24 @@ Constant ReadRealLiteral( if (context.targetCharacteristics().areSubnormalsFlushedToZero()) { value = value.FlushSubnormalToZero(); } - return {value}; + typename Constant::Result resultInfo; + resultInfo.set_isFromInexactLiteralConversion( + isDefaultKind && valWithFlags.flags.test(RealFlag::Inexact)); + return {value, resultInfo}; } struct RealTypeVisitor { using Result = std::optional>; 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 Result Test() { if (kind == T::kind) { - return {AsCategoryExpr(ReadRealLiteral(literal, context))}; + return { + AsCategoryExpr(ReadRealLiteral(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 &&expr, bool keepConvertImplicit) { +static MaybeExpr ImplicitConvertTo(const Symbol &sym, Expr &&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 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 9301cf85305d4..77c427e0a85ae 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 @@ -355,7 +355,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 @@ -363,7 +363,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/clause-validity01.f90 b/flang/test/Semantics/OpenMP/clause-validity01.f90 index e725e2670e8dc..5f74978f38279 100644 --- a/flang/test/Semantics/OpenMP/clause-validity01.f90 +++ b/flang/test/Semantics/OpenMP/clause-validity01.f90 @@ -21,8 +21,8 @@ integer(omp_allocator_handle_kind) :: xy_alloc xy_alloc = omp_init_allocator(xy_memspace, 1, xy_traits) - arrayA = 1.414 - arrayB = 3.14 + arrayA = 1.414d0 + arrayB = 3.14d0 N = 1024 ! 2.5 parallel-clause -> if-clause | 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