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