diff options
Diffstat (limited to 'flang')
66 files changed, 641 insertions, 113 deletions
diff --git a/flang/.gitignore b/flang/.gitignore index 4da4ee1..508e70c 100644 --- a/flang/.gitignore +++ b/flang/.gitignore @@ -5,7 +5,6 @@ build root tags TAGS -*.o .nfs* *.sw? *~ diff --git a/flang/include/flang/Common/api-attrs.h b/flang/include/flang/Common/api-attrs.h index 4d069c6..04ee307 100644 --- a/flang/include/flang/Common/api-attrs.h +++ b/flang/include/flang/Common/api-attrs.h @@ -133,6 +133,18 @@ #undef RT_DEVICE_COMPILATION #endif +/* + * Recurrence in the call graph prevents computing minimal stack size + * required for a kernel execution. This macro can be used to disable + * some F18 runtime functionality that is implemented using recurrent + * function calls or to use alternative implementation. + */ +#if (defined(__CUDACC__) || defined(__CUDA__)) && defined(__CUDA_ARCH__) +#define RT_DEVICE_AVOID_RECURSION 1 +#else +#undef RT_DEVICE_AVOID_RECURSION +#endif + #if defined(__CUDACC__) #define RT_DIAG_PUSH _Pragma("nv_diagnostic push") #define RT_DIAG_POP _Pragma("nv_diagnostic pop") diff --git a/flang/include/flang/Common/windows-include.h b/flang/include/flang/Common/windows-include.h new file mode 100644 index 0000000..75ef497 --- /dev/null +++ b/flang/include/flang/Common/windows-include.h @@ -0,0 +1,25 @@ +//===-- include/flang/Common/windows-include.h ------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Wrapper around windows.h that works around the name conflicts. +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_COMMON_WINDOWS_INCLUDE_H_ +#define FORTRAN_COMMON_WINDOWS_INCLUDE_H_ + +#ifdef _WIN32 + +#define WIN32_LEAN_AND_MEAN +#define NOMINMAX + +#include <windows.h> + +#endif // _WIN32 + +#endif // FORTRAN_COMMON_WINDOWS_INCLUDE_H_ diff --git a/flang/include/flang/Frontend/CodeGenOptions.h b/flang/include/flang/Frontend/CodeGenOptions.h index b0bbace..918192a 100644 --- a/flang/include/flang/Frontend/CodeGenOptions.h +++ b/flang/include/flang/Frontend/CodeGenOptions.h @@ -87,7 +87,7 @@ public: /// \brief Code object version for AMDGPU. llvm::CodeObjectVersionKind CodeObjectVersion = - llvm::CodeObjectVersionKind::COV_4; + llvm::CodeObjectVersionKind::COV_5; /// Optimization remark with an optional regular expression pattern. struct OptRemark { diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 6eba243..315a3f6 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1340,15 +1340,6 @@ static PreparedDummyArgument preparePresentUserCallActualArgument( } else { addr = hlfir::genVariableRawAddress(loc, builder, entity); } - // The last extent created for assumed-rank descriptors must be -1 (18.5.3 - // point 5.). This should be done when creating the assumed-size shape for - // consistency. - if (auto baseBoxDummy = mlir::dyn_cast<fir::BaseBoxType>(dummyType)) - if (baseBoxDummy.isAssumedRank()) - if (const Fortran::semantics::Symbol *sym = - Fortran::evaluate::UnwrapWholeSymbolDataRef(*arg.entity)) - if (Fortran::semantics::IsAssumedSizeArray(sym->GetUltimate())) - TODO(loc, "passing assumed-size to assumed-rank array"); // For ranked actual passed to assumed-rank dummy, the cast to assumed-rank // box is inserted when building the fir.call op. Inserting it here would diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index e07ae42..f59c784 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -358,9 +358,16 @@ static mlir::Value genComponentDefaultInit( } else if (const auto *proc{ component .detailsIf<Fortran::semantics::ProcEntityDetails>()}) { - if (proc->init().has_value()) - TODO(loc, "procedure pointer component default initialization"); - else + if (proc->init().has_value()) { + auto sym{*proc->init()}; + if (sym) // Has a procedure target. + componentValue = + Fortran::lower::convertProcedureDesignatorInitialTarget(converter, + loc, *sym); + else // Has NULL() target. + componentValue = + fir::factory::createNullBoxProc(builder, loc, componentTy); + } else componentValue = builder.create<fir::ZeroOp>(loc, componentTy); } assert(componentValue && "must have been computed"); diff --git a/flang/lib/Lower/OpenMP/ReductionProcessor.cpp b/flang/lib/Lower/OpenMP/ReductionProcessor.cpp index 0d05ca5..c1c9411 100644 --- a/flang/lib/Lower/OpenMP/ReductionProcessor.cpp +++ b/flang/lib/Lower/OpenMP/ReductionProcessor.cpp @@ -13,6 +13,7 @@ #include "ReductionProcessor.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/HLFIRTools.h" #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIRType.h" @@ -522,12 +523,20 @@ void ReductionProcessor::addDeclareReduction( if (reductionSymbols) reductionSymbols->push_back(symbol); mlir::Value symVal = converter.getSymbolAddress(*symbol); - auto redType = mlir::cast<fir::ReferenceType>(symVal.getType()); + mlir::Type eleType; + auto refType = mlir::dyn_cast_or_null<fir::ReferenceType>(symVal.getType()); + if (refType) + eleType = refType.getEleTy(); + else + eleType = symVal.getType(); // all arrays must be boxed so that we have convenient access to all the // information needed to iterate over the array - if (mlir::isa<fir::SequenceType>(redType.getEleTy())) { - hlfir::Entity entity{symVal}; + if (mlir::isa<fir::SequenceType>(eleType)) { + // For Host associated symbols, use `SymbolBox` instead + Fortran::lower::SymbolBox symBox = + converter.lookupOneLevelUpSymbol(*symbol); + hlfir::Entity entity{symBox.getAddr()}; entity = genVariableBox(currentLocation, builder, entity); mlir::Value box = entity.getBase(); @@ -538,11 +547,25 @@ void ReductionProcessor::addDeclareReduction( builder.create<fir::StoreOp>(currentLocation, box, alloca); symVal = alloca; - redType = mlir::cast<fir::ReferenceType>(symVal.getType()); + } else if (mlir::isa<fir::BaseBoxType>(symVal.getType())) { + // boxed arrays are passed as values not by reference. Unfortunately, + // we can't pass a box by value to omp.redution_declare, so turn it + // into a reference + + auto alloca = + builder.create<fir::AllocaOp>(currentLocation, symVal.getType()); + builder.create<fir::StoreOp>(currentLocation, symVal, alloca); + symVal = alloca; } else if (auto declOp = symVal.getDefiningOp<hlfir::DeclareOp>()) { symVal = declOp.getBase(); } + // this isn't the same as the by-val and by-ref passing later in the + // pipeline. Both styles assume that the variable is a reference at + // this point + assert(mlir::isa<fir::ReferenceType>(symVal.getType()) && + "reduction input var is a reference"); + reductionVars.push_back(symVal); } const bool isByRef = doReductionByRef(reductionVars); diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index e769592..3474832 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -55,6 +55,8 @@ static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) { void Fortran::lower::genStopStatement( Fortran::lower::AbstractConverter &converter, const Fortran::parser::StopStmt &stmt) { + const bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) == + Fortran::parser::StopStmt::Kind::ErrorStop; fir::FirOpBuilder &builder = converter.getFirOpBuilder(); mlir::Location loc = converter.getCurrentLocation(); Fortran::lower::StatementContext stmtCtx; @@ -94,13 +96,12 @@ void Fortran::lower::genStopStatement( } else { callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder); calleeType = callee.getFunctionType(); - operands.push_back( - builder.createIntegerConstant(loc, calleeType.getInput(0), 0)); + // Default to values are advised in F'2023 11.4 p2. + operands.push_back(builder.createIntegerConstant( + loc, calleeType.getInput(0), isError ? 1 : 0)); } // Second operand indicates ERROR STOP - bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) == - Fortran::parser::StopStmt::Kind::ErrorStop; operands.push_back(builder.createIntegerConstant( loc, calleeType.getInput(operands.size()), isError)); diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index 069ba81..5f6de94 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -5259,9 +5259,12 @@ mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType, remainder); } + auto fastMathFlags = builder.getFastMathFlags(); // F128 arith::RemFOp may be lowered to a runtime call that may be unsupported // on the target, so generate a call to Fortran Runtime's ModuloReal16. - if (resultType == mlir::FloatType::getF128(builder.getContext())) + if (resultType == mlir::FloatType::getF128(builder.getContext()) || + (fastMathFlags & mlir::arith::FastMathFlags::ninf) == + mlir::arith::FastMathFlags::none) return builder.createConvert( loc, resultType, fir::runtime::genModulo(builder, loc, args[0], args[1])); diff --git a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp index 4dcbd13..81d5d21 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp @@ -118,6 +118,20 @@ struct ForcedMod16 { } }; +/// Placeholder for real*10 version of Modulo Intrinsic +struct ForcedModulo10 { + static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal10)); + static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() { + return [](mlir::MLIRContext *ctx) { + auto fltTy = mlir::FloatType::getF80(ctx); + auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8)); + auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int)); + return mlir::FunctionType::get(ctx, {fltTy, fltTy, strTy, intTy}, + {fltTy}); + }; + } +}; + /// Placeholder for real*16 version of Modulo Intrinsic struct ForcedModulo16 { static constexpr const char *name = ExpandAndQuoteKey(RTNAME(ModuloReal16)); @@ -349,7 +363,13 @@ mlir::Value fir::runtime::genModulo(fir::FirOpBuilder &builder, // MODULO is lowered into math operations in intrinsics lowering, // so genModulo() should only be used for F128 data type now. - if (fltTy.isF128()) + if (fltTy.isF32()) + func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal4)>(loc, builder); + else if (fltTy.isF64()) + func = fir::runtime::getRuntimeFunc<mkRTKey(ModuloReal8)>(loc, builder); + else if (fltTy.isF80()) + func = fir::runtime::getRuntimeFunc<ForcedModulo10>(loc, builder); + else if (fltTy.isF128()) func = fir::runtime::getRuntimeFunc<ForcedModulo16>(loc, builder); else fir::intrinsicTypeTODO(builder, fltTy, loc, "MODULO"); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index dec8fee..b2de377 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -948,6 +948,11 @@ void CheckHelper::CheckObjectEntity( "Component '%s' with ATTRIBUTES(DEVICE) must also be allocatable"_err_en_US, symbol.name()); } + if (IsAssumedSizeArray(symbol)) { + messages_.Say( + "Object '%s' with ATTRIBUTES(DEVICE) may not be assumed size"_err_en_US, + symbol.name()); + } break; case common::CUDADataAttr::Managed: if (!IsAutomatic(symbol) && !IsAllocatable(symbol) && diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp index fabfe60..b573c5d 100644 --- a/flang/runtime/command.cpp +++ b/flang/runtime/command.cpp @@ -16,9 +16,7 @@ #include <limits> #ifdef _WIN32 -#define WIN32_LEAN_AND_MEAN -#define NOMINMAX -#include <windows.h> +#include "flang/Common/windows-include.h" // On Windows GetCurrentProcessId returns a DWORD aka uint32_t #include <processthreadsapi.h> diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h index 7063858..0b188a1 100644 --- a/flang/runtime/descriptor-io.h +++ b/flang/runtime/descriptor-io.h @@ -250,6 +250,7 @@ static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io, const typeInfo::Component &component, const Descriptor &origDescriptor, const SubscriptValue origSubscripts[], Terminator &terminator, const NonTbpDefinedIoTable *table) { +#if !defined(RT_DEVICE_AVOID_RECURSION) if (component.genre() == typeInfo::Component::Genre::Data) { // Create a descriptor for the component StaticDescriptor<maxRank, true, 16 /*?*/> statDesc; @@ -266,6 +267,9 @@ static RT_API_ATTRS bool DefaultComponentIO(IoStatementState &io, const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)}; return DescriptorIO<DIR>(io, compDesc, table); } +#else + terminator.Crash("not yet implemented: component IO"); +#endif } template <Direction DIR> diff --git a/flang/runtime/edit-output.cpp b/flang/runtime/edit-output.cpp index b710c29..a06ed25 100644 --- a/flang/runtime/edit-output.cpp +++ b/flang/runtime/edit-output.cpp @@ -751,43 +751,50 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditEXOutput(const DataEdit &edit) { template <int KIND> RT_API_ATTRS bool RealOutputEditing<KIND>::Edit(const DataEdit &edit) { - switch (edit.descriptor) { + const DataEdit *editPtr{&edit}; + DataEdit newEdit; + if (editPtr->descriptor == 'G') { + // Avoid recursive call as in Edit(EditForGOutput(edit)). + newEdit = EditForGOutput(*editPtr); + editPtr = &newEdit; + RUNTIME_CHECK(io_.GetIoErrorHandler(), editPtr->descriptor != 'G'); + } + switch (editPtr->descriptor) { case 'D': - return EditEorDOutput(edit); + return EditEorDOutput(*editPtr); case 'E': - if (edit.variation == 'X') { - return EditEXOutput(edit); + if (editPtr->variation == 'X') { + return EditEXOutput(*editPtr); } else { - return EditEorDOutput(edit); + return EditEorDOutput(*editPtr); } case 'F': - return EditFOutput(edit); + return EditFOutput(*editPtr); case 'B': - return EditBOZOutput<1>(io_, edit, + return EditBOZOutput<1>(io_, *editPtr, reinterpret_cast<const unsigned char *>(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); case 'O': - return EditBOZOutput<3>(io_, edit, + return EditBOZOutput<3>(io_, *editPtr, reinterpret_cast<const unsigned char *>(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); case 'Z': - return EditBOZOutput<4>(io_, edit, + return EditBOZOutput<4>(io_, *editPtr, reinterpret_cast<const unsigned char *>(&x_), common::BitsForBinaryPrecision(common::PrecisionOfRealKind(KIND)) >> 3); - case 'G': - return Edit(EditForGOutput(edit)); case 'L': - return EditLogicalOutput(io_, edit, *reinterpret_cast<const char *>(&x_)); + return EditLogicalOutput( + io_, *editPtr, *reinterpret_cast<const char *>(&x_)); case 'A': // legacy extension return EditCharacterOutput( - io_, edit, reinterpret_cast<char *>(&x_), sizeof x_); + io_, *editPtr, reinterpret_cast<char *>(&x_), sizeof x_); default: - if (edit.IsListDirected()) { - return EditListDirectedOutput(edit); + if (editPtr->IsListDirected()) { + return EditListDirectedOutput(*editPtr); } io_.GetIoErrorHandler().SignalError(IostatErrorInFormat, "Data edit descriptor '%c' may not be used with a REAL data item", - edit.descriptor); + editPtr->descriptor); return false; } return false; diff --git a/flang/runtime/emit-encoded.h b/flang/runtime/emit-encoded.h index ac8c7d7..4b5e390 100644 --- a/flang/runtime/emit-encoded.h +++ b/flang/runtime/emit-encoded.h @@ -18,22 +18,26 @@ namespace Fortran::runtime::io { -template <typename CONTEXT, typename CHAR> +template <typename CONTEXT, typename CHAR, bool NL_ADVANCES_RECORD = true> RT_API_ATTRS bool EmitEncoded( CONTEXT &to, const CHAR *data, std::size_t chars) { ConnectionState &connection{to.GetConnectionState()}; - if (connection.access == Access::Stream && - connection.internalIoCharKind == 0) { - // Stream output: treat newlines as record advancements so that the left tab - // limit is correctly managed - while (const CHAR * nl{FindCharacter(data, CHAR{'\n'}, chars)}) { - auto pos{static_cast<std::size_t>(nl - data)}; - if (!EmitEncoded(to, data, pos)) { - return false; + if constexpr (NL_ADVANCES_RECORD) { + if (connection.access == Access::Stream && + connection.internalIoCharKind == 0) { + // Stream output: treat newlines as record advancements so that the left + // tab limit is correctly managed + while (const CHAR * nl{FindCharacter(data, CHAR{'\n'}, chars)}) { + auto pos{static_cast<std::size_t>(nl - data)}; + // The [data, data + pos) does not contain the newline, + // so we can avoid the recursion by calling proper specialization. + if (!EmitEncoded<CONTEXT, CHAR, false>(to, data, pos)) { + return false; + } + data += pos + 1; + chars -= pos + 1; + to.AdvanceRecord(); } - data += pos + 1; - chars -= pos + 1; - to.AdvanceRecord(); } } if (connection.useUTF8<CHAR>()) { diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp index c84930c..0f5bc50 100644 --- a/flang/runtime/execute.cpp +++ b/flang/runtime/execute.cpp @@ -16,9 +16,7 @@ #include <future> #include <limits> #ifdef _WIN32 -#define LEAN_AND_MEAN -#define NOMINMAX -#include <windows.h> +#include "flang/Common/windows-include.h" #else #include <signal.h> #include <sys/wait.h> diff --git a/flang/runtime/file.cpp b/flang/runtime/file.cpp index 67764f1..acd5d33d 100644 --- a/flang/runtime/file.cpp +++ b/flang/runtime/file.cpp @@ -17,9 +17,8 @@ #include <stdlib.h> #include <sys/stat.h> #ifdef _WIN32 -#define NOMINMAX +#include "flang/Common/windows-include.h" #include <io.h> -#include <windows.h> #else #include <unistd.h> #endif diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp index 022e4c8..1a5d32e 100644 --- a/flang/runtime/io-stmt.cpp +++ b/flang/runtime/io-stmt.cpp @@ -220,7 +220,11 @@ ExternalIoStatementBase::ExternalIoStatementBase( MutableModes &ExternalIoStatementBase::mutableModes() { if (const ChildIo * child{unit_.GetChildIo()}) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child->parent().mutableModes(); +#else + ReportUnsupportedChildIo(); +#endif } return unit_.modes; } @@ -891,17 +895,29 @@ ChildIoStatementState<DIR>::ChildIoStatementState( template <Direction DIR> MutableModes &ChildIoStatementState<DIR>::mutableModes() { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().mutableModes(); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> ConnectionState &ChildIoStatementState<DIR>::GetConnectionState() { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().GetConnectionState(); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> ExternalFileUnit *ChildIoStatementState<DIR>::GetExternalFileUnit() const { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().GetExternalFileUnit(); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> int ChildIoStatementState<DIR>::EndIoStatement() { @@ -914,22 +930,38 @@ template <Direction DIR> int ChildIoStatementState<DIR>::EndIoStatement() { template <Direction DIR> bool ChildIoStatementState<DIR>::Emit( const char *data, std::size_t bytes, std::size_t elementBytes) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().Emit(data, bytes, elementBytes); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> std::size_t ChildIoStatementState<DIR>::GetNextInputBytes(const char *&p) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().GetNextInputBytes(p); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> void ChildIoStatementState<DIR>::HandleAbsolutePosition(std::int64_t n) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().HandleAbsolutePosition(n); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR> void ChildIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return child_.parent().HandleRelativePosition(n); +#else + ReportUnsupportedChildIo(); +#endif } template <Direction DIR, typename CHAR> @@ -957,13 +989,21 @@ int ChildFormattedIoStatementState<DIR, CHAR>::EndIoStatement() { template <Direction DIR, typename CHAR> bool ChildFormattedIoStatementState<DIR, CHAR>::AdvanceRecord(int n) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return this->child().parent().AdvanceRecord(n); +#else + this->ReportUnsupportedChildIo(); +#endif } template <Direction DIR> bool ChildUnformattedIoStatementState<DIR>::Receive( char *data, std::size_t bytes, std::size_t elementBytes) { +#if !defined(RT_DEVICE_AVOID_RECURSION) return this->child().parent().Receive(data, bytes, elementBytes); +#else + this->ReportUnsupportedChildIo(); +#endif } template <Direction DIR> int ChildListIoStatementState<DIR>::EndIoStatement() { diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h index 8b57523..6053aeb 100644 --- a/flang/runtime/io-stmt.h +++ b/flang/runtime/io-stmt.h @@ -296,6 +296,10 @@ public: RT_API_ATTRS void BadInquiryKeywordHashCrash(InquiryKeywordHash); + RT_API_ATTRS void ReportUnsupportedChildIo() const { + Crash("not yet implemented: child IO"); + } + protected: bool completedOperation_{false}; }; diff --git a/flang/runtime/lock.h b/flang/runtime/lock.h index 9f27a82..46ca287 100644 --- a/flang/runtime/lock.h +++ b/flang/runtime/lock.h @@ -25,9 +25,7 @@ #if USE_PTHREADS #include <pthread.h> #elif defined(_WIN32) -// Do not define macros for "min" and "max" -#define NOMINMAX -#include <windows.h> +#include "flang/Common/windows-include.h" #else #include <mutex> #endif diff --git a/flang/runtime/numeric-templates.h b/flang/runtime/numeric-templates.h index af552f9..4936e77 100644 --- a/flang/runtime/numeric-templates.h +++ b/flang/runtime/numeric-templates.h @@ -237,8 +237,12 @@ inline RT_API_ATTRS T RealMod( if (ISNANTy<T>::compute(a) || ISNANTy<T>::compute(p) || ISINFTy<T>::compute(a)) { return QNANTy<T>::compute(); - } else if (ISINFTy<T>::compute(p)) { - return a; + } else if (IS_MODULO && ISINFTy<T>::compute(p)) { + // Other compilers behave consistently for MOD(x, +/-INF) + // and always return x. This is probably related to + // implementation of std::fmod(). Stick to this behavior + // for MOD, but return NaN for MODULO(x, +/-INF). + return QNANTy<T>::compute(); } T aAbs{ABSTy<T>::compute(a)}; T pAbs{ABSTy<T>::compute(p)}; @@ -248,8 +252,19 @@ inline RT_API_ATTRS T RealMod( if (auto pInt{static_cast<std::int64_t>(p)}; p == pInt) { // Fast exact case for integer operands auto mod{aInt - (aInt / pInt) * pInt}; - if (IS_MODULO && (aInt > 0) != (pInt > 0)) { - mod += pInt; + if constexpr (IS_MODULO) { + if (mod == 0) { + // Return properly signed zero. + return pInt > 0 ? T{0} : -T{0}; + } + if ((aInt > 0) != (pInt > 0)) { + mod += pInt; + } + } else { + if (mod == 0) { + // Return properly signed zero. + return aInt > 0 ? T{0} : -T{0}; + } } return static_cast<T>(mod); } @@ -297,7 +312,11 @@ inline RT_API_ATTRS T RealMod( } if constexpr (IS_MODULO) { if ((a < 0) != (p < 0)) { - tmp += p; + if (tmp == 0.) { + tmp = -tmp; + } else { + tmp += p; + } } } return tmp; diff --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp index 6c648d3..0e38cff 100644 --- a/flang/runtime/unit.cpp +++ b/flang/runtime/unit.cpp @@ -206,7 +206,7 @@ bool ExternalFileUnit::BeginReadingRecord(IoErrorHandler &handler) { if (anyWriteSinceLastPositioning_ && access == Access::Sequential) { // Most Fortran implementations allow a READ after a WRITE; // the read then just hits an EOF. - DoEndfile(handler); + DoEndfile<false, Direction::Input>(handler); } recordLength.reset(); RUNTIME_CHECK(handler, isUnformatted.has_value()); @@ -671,13 +671,23 @@ void ExternalFileUnit::DoImpliedEndfile(IoErrorHandler &handler) { impliedEndfile_ = false; } +template <bool ANY_DIR, Direction DIR> void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) { if (IsRecordFile() && access != Access::Direct) { furthestPositionInRecord = std::max(positionInRecord, furthestPositionInRecord); if (leftTabLimit) { // last I/O was non-advancing if (access == Access::Sequential && direction_ == Direction::Output) { - AdvanceRecord(handler); + if constexpr (ANY_DIR || DIR == Direction::Output) { + // When DoEndfile() is called from BeginReadingRecord(), + // this call to AdvanceRecord() may appear as a recursion + // though it may never happen. Expose the call only + // under the constexpr direction check. + AdvanceRecord(handler); + } else { + // This check always fails if we are here. + RUNTIME_CHECK(handler, direction_ != Direction::Output); + } } else { // Access::Stream or input leftTabLimit.reset(); ++currentRecordNumber; @@ -695,6 +705,12 @@ void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) { anyWriteSinceLastPositioning_ = false; } +template void ExternalFileUnit::DoEndfile(IoErrorHandler &handler); +template void ExternalFileUnit::DoEndfile<false, Direction::Output>( + IoErrorHandler &handler); +template void ExternalFileUnit::DoEndfile<false, Direction::Input>( + IoErrorHandler &handler); + void ExternalFileUnit::CommitWrites() { frameOffsetInFile_ += recordOffsetInFrame_ + recordLength.value_or(furthestPositionInRecord); diff --git a/flang/runtime/unit.h b/flang/runtime/unit.h index a6ee597..e59fbbc 100644 --- a/flang/runtime/unit.h +++ b/flang/runtime/unit.h @@ -204,6 +204,7 @@ private: RT_API_ATTRS void BackspaceVariableFormattedRecord(IoErrorHandler &); RT_API_ATTRS bool SetVariableFormattedRecordLength(); RT_API_ATTRS void DoImpliedEndfile(IoErrorHandler &); + template <bool ANY_DIR = true, Direction DIR = Direction::Output> RT_API_ATTRS void DoEndfile(IoErrorHandler &); RT_API_ATTRS void CommitWrites(); RT_API_ATTRS bool CheckDirectAccess(IoErrorHandler &); diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-as b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-as new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-as @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.bfd b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.bfd new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.bfd @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.gold b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.gold new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/i386-unknown-linux-gnu-ld.gold @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-as b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-as new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-as @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.bfd b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.bfd new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.bfd @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.gold b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.gold new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/bin/x86_64-unknown-linux-gnu-ld.gold @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/as b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/as new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/as @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.bfd b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.bfd new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.bfd @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.gold b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.gold new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/bin/ld.gold @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/lib/.keep b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/lib/.keep new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/i386-unknown-linux-gnu/lib/.keep diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/crtbegin.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/crtbegin.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/crtbegin.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbegin.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbegin.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbegin.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbeginT.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbeginT.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtbeginT.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtfastmath.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtfastmath.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/crtfastmath.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbegin.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbegin.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbegin.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbeginT.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbeginT.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtbeginT.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtfastmath.o b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtfastmath.o new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/x32/crtfastmath.o diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/as b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/as new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/as @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.bfd b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.bfd new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.bfd @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.gold b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.gold new file mode 100755 index 0000000..b23e556 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.gold @@ -0,0 +1 @@ +#!/bin/true diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.lld b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.lld new file mode 100755 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/bin/ld.lld diff --git a/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/lib/.keep b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/lib/.keep new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/flang/test/Driver/Inputs/basic_cross_linux_tree/usr/x86_64-unknown-linux-gnu/lib/.keep diff --git a/flang/test/Driver/driver-help-hidden.f90 b/flang/test/Driver/driver-help-hidden.f90 index bf3660d..4405b64 100644 --- a/flang/test/Driver/driver-help-hidden.f90 +++ b/flang/test/Driver/driver-help-hidden.f90 @@ -104,6 +104,9 @@ ! CHECK-NEXT: -fversion-loops-for-stride ! CHECK-NEXT: Create unit-strided versions of loops ! CHECK-NEXT: -fxor-operator Enable .XOR. as a synonym of .NEQV. +! CHECK-NEXT: --gcc-install-dir=<value> +! CHECK-NEXT: Use GCC installation in the specified directory. The directory ends with path components like 'lib{,32,64}/gcc{,-cross}/$triple/$version'. Note: executables (e.g. ld) used by the compiler are not overridden by the selected GCC installation +! CHECK-NEXT: --gcc-toolchain=<value> Specify a directory where Clang can find 'include' and 'lib{,32,64}/gcc{,-cross}/$triple/$version'. Clang will use the GCC installation with the largest version ! CHECK-NEXT: -gline-directives-only Emit debug line info directives only ! CHECK-NEXT: -gline-tables-only Emit debug line number tables only ! CHECK-NEXT: -gpulibc Link the LLVM C Library for GPUs diff --git a/flang/test/Driver/driver-help.f90 b/flang/test/Driver/driver-help.f90 index b4280a4..c80453f 100644 --- a/flang/test/Driver/driver-help.f90 +++ b/flang/test/Driver/driver-help.f90 @@ -92,6 +92,9 @@ ! HELP-NEXT: -fversion-loops-for-stride ! HELP-NEXT: Create unit-strided versions of loops ! HELP-NEXT: -fxor-operator Enable .XOR. as a synonym of .NEQV. +! HELP-NEXT: --gcc-install-dir=<value> +! HELP-NEXT: Use GCC installation in the specified directory. The directory ends with path components like 'lib{,32,64}/gcc{,-cross}/$triple/$version'. Note: executables (e.g. ld) used by the compiler are not overridden by the selected GCC installation +! HELP-NEXT: --gcc-toolchain=<value> Specify a directory where Clang can find 'include' and 'lib{,32,64}/gcc{,-cross}/$triple/$version'. Clang will use the GCC installation with the largest version ! HELP-NEXT: -gline-directives-only Emit debug line info directives only ! HELP-NEXT: -gline-tables-only Emit debug line number tables only ! HELP-NEXT: -gpulibc Link the LLVM C Library for GPUs diff --git a/flang/test/Driver/gcc-toolchain-install-dir.f90 b/flang/test/Driver/gcc-toolchain-install-dir.f90 new file mode 100644 index 0000000..5a073b0 --- /dev/null +++ b/flang/test/Driver/gcc-toolchain-install-dir.f90 @@ -0,0 +1,21 @@ +!! Test that --gcc-toolchain and --gcc-install-dir options are working as expected. +!! It does not test cross-compiling (--sysroot), so crtbegin.o, libgcc/compiler-rt, libc, libFortranRuntime, etc. are not supposed to be affected. +!! PREFIX is captured twice because the driver escapes backslashes (occuring in Windows paths) in the -### output, but not on the "Selected GCC installation:" line. + +! RUN: %flang 2>&1 -### -v -o %t %s -no-integrated-as -fuse-ld=ld --target=i386-unknown-linux-gnu --gcc-install-dir=%S/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0 | FileCheck %s --check-prefix=CHECK-I386 +! RUN: %flang 2>&1 -### -v -o %t %s -no-integrated-as -fuse-ld=ld --target=i386-unknown-linux-gnu --gcc-toolchain=%S/Inputs/basic_cross_linux_tree/usr | FileCheck %s --check-prefix=CHECK-I386 +! CHECK-I386: Selected GCC installation: [[PREFIX:[^"]+]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0 +! CHECK-I386: "-fc1" "-triple" "i386-unknown-linux-gnu" +! CHECK-I386: "[[PREFIX:[^"]+]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/../../../../i386-unknown-linux-gnu/bin{{/|\\\\}}as" +! CHECK-I386: "[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/../../../../i386-unknown-linux-gnu/bin{{/|\\\\}}ld" {{.*}} "-m" "elf_i386" +! CHECK-I386-SAME: "-L[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0" +! CHECK-I386-SAME: "-L[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/i386-unknown-linux-gnu/10.2.0/../../../../i386-unknown-linux-gnu/lib" + +! RUN: %flang 2>&1 -### -v -o %t %s -no-integrated-as -fuse-ld=ld --target=x86_64-unknown-linux-gnu --gcc-install-dir=%S/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0 | FileCheck %s --check-prefix=CHECK-X86-64 +! RUN: %flang 2>&1 -### -v -o %t %s -no-integrated-as -fuse-ld=ld --target=x86_64-unknown-linux-gnu --gcc-toolchain=%S/Inputs/basic_cross_linux_tree/usr | FileCheck %s --check-prefix=CHECK-X86-64 +! CHECK-X86-64: Selected GCC installation: [[PREFIX:[^"]+]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0 +! CHECK-X86-64: "-fc1" "-triple" "x86_64-unknown-linux-gnu" +! CHECK-X86-64: "[[PREFIX:[^"]+]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/../../../../x86_64-unknown-linux-gnu/bin{{/|\\\\}}as" "--64" +! CHECK-X86-64: "[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/../../../../x86_64-unknown-linux-gnu/bin{{/|\\\\}}ld" {{.*}} "-m" "elf_x86_64" +! CHECK-X86-64-SAME: "-L[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0" +! CHECK-X86-64-SAME: "-L[[PREFIX]]/Inputs/basic_cross_linux_tree/usr/lib/gcc/x86_64-unknown-linux-gnu/10.2.0/../../../../x86_64-unknown-linux-gnu/lib" diff --git a/flang/test/Lower/AMD/code-object-version.f90 b/flang/test/Lower/AMD/code-object-version.f90 index 455f454..4380734 100644 --- a/flang/test/Lower/AMD/code-object-version.f90 +++ b/flang/test/Lower/AMD/code-object-version.f90 @@ -5,8 +5,8 @@ !RUN: %flang_fc1 -emit-hlfir -triple amdgcn-amd-amdhsa -target-cpu gfx908 -mcode-object-version=5 %s -o - | FileCheck --check-prefix=COV_5 %s !RUN: %flang_fc1 -emit-hlfir -triple amdgcn-amd-amdhsa -target-cpu gfx908 -mcode-object-version=6 %s -o - | FileCheck --check-prefix=COV_6 %s -!COV_DEFAULT: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(400 : i32) {addr_space = 4 : i32} : i32 -!COV_NONE-NOT: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(400 : i32) {addr_space = 4 : i32} : i32 +!COV_DEFAULT: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(500 : i32) {addr_space = 4 : i32} : i32 +!COV_NONE-NOT: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(500 : i32) {addr_space = 4 : i32} : i32 !COV_4: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(400 : i32) {addr_space = 4 : i32} : i32 !COV_5: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(500 : i32) {addr_space = 4 : i32} : i32 !COV_6: llvm.mlir.global weak_odr hidden local_unnamed_addr constant @__oclc_ABI_version(600 : i32) {addr_space = 4 : i32} : i32 diff --git a/flang/test/Lower/HLFIR/assumed-rank-iface.f90 b/flang/test/Lower/HLFIR/assumed-rank-iface.f90 index 5df7944..155ce8f 100644 --- a/flang/test/Lower/HLFIR/assumed-rank-iface.f90 +++ b/flang/test/Lower/HLFIR/assumed-rank-iface.f90 @@ -133,9 +133,20 @@ end subroutine ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<?x?xi32>>) -> !fir.box<!fir.array<*:i32>> ! CHECK: fir.call @_QPint_opt_assumed_rank(%[[VAL_11]]) fastmath<contract> : (!fir.box<!fir.array<*:i32>>) -> () -! TODO: set assumed size last extent to -1. -!subroutine int_r2_assumed_size_to_assumed_rank(x) -! use ifaces, only : int_assumed_rank -! integer :: x(10, *) -! call int_assumed_rank(x) -!end subroutine +subroutine int_r2_assumed_size_to_assumed_rank(x) + use ifaces, only : int_assumed_rank + integer :: x(10, *) + call int_assumed_rank(x) +end subroutine +! CHECK-LABEL: func.func @_QPint_r2_assumed_size_to_assumed_rank( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<10x?xi32>> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]] = arith.constant 10 : i64 +! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (i64) -> index +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]] = arith.cmpi sgt, %[[VAL_2]], %[[VAL_3]] : index +! CHECK: %[[VAL_5:.*]] = arith.select %[[VAL_4]], %[[VAL_2]], %[[VAL_3]] : index +! CHECK: %[[VAL_6:.*]] = arith.constant -1 : index +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_5]], %[[VAL_6]] : (index, index) -> !fir.shape<2> +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_7]]) {uniq_name = "_QFint_r2_assumed_size_to_assumed_rankEx"} : (!fir.ref<!fir.array<10x?xi32>>, !fir.shape<2>) -> (!fir.box<!fir.array<10x?xi32>>, !fir.ref<!fir.array<10x?xi32>>) +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]]#0 : (!fir.box<!fir.array<10x?xi32>>) -> !fir.box<!fir.array<*:i32>> +! CHECK: fir.call @_QPint_assumed_rank(%[[VAL_9]]) fastmath<contract> : (!fir.box<!fir.array<*:i32>>) -> () diff --git a/flang/test/Lower/HLFIR/procedure-pointer-component-default-init.f90 b/flang/test/Lower/HLFIR/procedure-pointer-component-default-init.f90 new file mode 100644 index 0000000..8593126 --- /dev/null +++ b/flang/test/Lower/HLFIR/procedure-pointer-component-default-init.f90 @@ -0,0 +1,41 @@ +! Test procedure pointer component default initialization when the size +! of the derived type is 32 bytes and larger. +! RUN: bbc -emit-hlfir -o - %s | FileCheck %s + + interface + subroutine sub() + end + end interface + type dt + real :: r1 = 5.0 + procedure(real), pointer, nopass :: pp1 => null() + real, pointer :: rp1 => null() + procedure(), pointer, nopass :: pp2 => sub + end type + type(dt) :: dd1 + end + +! CHECK-LABEL: func.func @_QQmain() { +! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QFEdd1) : !fir.ref<!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>> +! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_14]] {uniq_name = "_QFEdd1"} : (!fir.ref<!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>>) -> (!fir.ref<!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>>, !fir.ref<!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>>) +! CHECK: } + +! CHECK-LABEL: fir.global internal @_QFEdd1 : !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> { +! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %cst = arith.constant 5.000000e+00 : f32 +! CHECK: %[[VAL_1:.*]] = fir.field_index r1, !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_2:.*]] = fir.insert_value %[[VAL_0]], %cst, ["r1", !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>] : (!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>, f32) -> !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_3:.*]] = fir.zero_bits () -> f32 +! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_3]] : (() -> f32) -> !fir.boxproc<() -> f32> +! CHECK: %[[VAL_5:.*]] = fir.field_index pp1, !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_4]], ["pp1", !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>] : (!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>, !fir.boxproc<() -> f32>) -> !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_7:.*]] = fir.zero_bits !fir.ptr<f32> +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_7]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>> +! CHECK: %[[VAL_9:.*]] = fir.field_index rp1, !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_10:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_8]], ["rp1", !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>] : (!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>, !fir.box<!fir.ptr<f32>>) -> !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_11:.*]] = fir.address_of(@_QPsub) : () -> () +! CHECK: %[[VAL_12:.*]] = fir.emboxproc %[[VAL_11]] : (() -> ()) -> !fir.boxproc<() -> ()> +! CHECK: %[[VAL_13:.*]] = fir.field_index pp2, !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: %[[VAL_14:.*]] = fir.insert_value %[[VAL_10]], %[[VAL_12]], ["pp2", !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>] : (!fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}>, !fir.boxproc<() -> ()>) -> !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: fir.has_value %[[VAL_14]] : !fir.type<_QFTdt{r1:f32,pp1:!fir.boxproc<() -> f32>,rp1:!fir.box<!fir.ptr<f32>>,pp2:!fir.boxproc<() -> ()>}> +! CHECK: } diff --git a/flang/test/Lower/Intrinsics/modulo.f90 b/flang/test/Lower/Intrinsics/modulo.f90 index 383cb34..ac18e59 100644 --- a/flang/test/Lower/Intrinsics/modulo.f90 +++ b/flang/test/Lower/Intrinsics/modulo.f90 @@ -1,11 +1,13 @@ -! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s +! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s -check-prefixes=HONORINF,ALL +! RUN: flang-new -fc1 -menable-no-infs -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s -check-prefixes=CHECK,ALL -! CHECK-LABEL: func @_QPmodulo_testr( -! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f64>{{.*}}, %[[arg1:.*]]: !fir.ref<f64>{{.*}}, %[[arg2:.*]]: !fir.ref<f64>{{.*}}) { +! ALL-LABEL: func @_QPmodulo_testr( +! ALL-SAME: %[[arg0:.*]]: !fir.ref<f64>{{.*}}, %[[arg1:.*]]: !fir.ref<f64>{{.*}}, %[[arg2:.*]]: !fir.ref<f64>{{.*}}) { subroutine modulo_testr(r, a, p) real(8) :: r, a, p - ! CHECK-DAG: %[[a:.*]] = fir.load %[[arg1]] : !fir.ref<f64> - ! CHECK-DAG: %[[p:.*]] = fir.load %[[arg2]] : !fir.ref<f64> + ! ALL-DAG: %[[a:.*]] = fir.load %[[arg1]] : !fir.ref<f64> + ! ALL-DAG: %[[p:.*]] = fir.load %[[arg2]] : !fir.ref<f64> + ! HONORINF: %[[res:.*]] = fir.call @_FortranAModuloReal8(%[[a]], %[[p]] ! CHECK-DAG: %[[rem:.*]] = arith.remf %[[a]], %[[p]] {{.*}}: f64 ! CHECK-DAG: %[[zero:.*]] = arith.constant 0.000000e+00 : f64 ! CHECK-DAG: %[[remNotZero:.*]] = arith.cmpf une, %[[rem]], %[[zero]] {{.*}} : f64 @@ -15,12 +17,12 @@ subroutine modulo_testr(r, a, p) ! CHECK-DAG: %[[mustAddP:.*]] = arith.andi %[[remNotZero]], %[[signDifferent]] : i1 ! CHECK-DAG: %[[remPlusP:.*]] = arith.addf %[[rem]], %[[p]] {{.*}}: f64 ! CHECK: %[[res:.*]] = arith.select %[[mustAddP]], %[[remPlusP]], %[[rem]] : f64 - ! CHECK: fir.store %[[res]] to %[[arg0]] : !fir.ref<f64> + ! ALL: fir.store %[[res]] to %[[arg0]] : !fir.ref<f64> r = modulo(a, p) end subroutine -! CHECK-LABEL: func @_QPmodulo_testi( -! CHECK-SAME: %[[arg0:.*]]: !fir.ref<i64>{{.*}}, %[[arg1:.*]]: !fir.ref<i64>{{.*}}, %[[arg2:.*]]: !fir.ref<i64>{{.*}}) { +! ALL-LABEL: func @_QPmodulo_testi( +! ALL-SAME: %[[arg0:.*]]: !fir.ref<i64>{{.*}}, %[[arg1:.*]]: !fir.ref<i64>{{.*}}, %[[arg2:.*]]: !fir.ref<i64>{{.*}}) { subroutine modulo_testi(r, a, p) integer(8) :: r, a, p ! CHECK-DAG: %[[a:.*]] = fir.load %[[arg1]] : !fir.ref<i64> diff --git a/flang/test/Lower/OpenMP/parallel-reduction-array.f90 b/flang/test/Lower/OpenMP/parallel-reduction-array.f90 index 735a998..56dcabb 100644 --- a/flang/test/Lower/OpenMP/parallel-reduction-array.f90 +++ b/flang/test/Lower/OpenMP/parallel-reduction-array.f90 @@ -50,7 +50,7 @@ end program ! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index ! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "_QFEi"} : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>, !fir.ref<!fir.array<3xi32>>) -! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1(%[[VAL_2]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>> +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#0(%[[VAL_2]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>> ! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.box<!fir.array<3xi32>> ! CHECK: fir.store %[[VAL_4]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.array<3xi32>>> ! CHECK: omp.parallel byref reduction(@add_reduction_byref_box_3xi32 %[[VAL_5]] -> %[[VAL_6:.*]] : !fir.ref<!fir.box<!fir.array<3xi32>>>) { diff --git a/flang/test/Lower/OpenMP/parallel-reduction-array2.f90 b/flang/test/Lower/OpenMP/parallel-reduction-array2.f90 index 4834047..94bff41 100644 --- a/flang/test/Lower/OpenMP/parallel-reduction-array2.f90 +++ b/flang/test/Lower/OpenMP/parallel-reduction-array2.f90 @@ -50,7 +50,7 @@ end program ! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index ! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_2]]) {uniq_name = "_QFEi"} : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>, !fir.ref<!fir.array<3xi32>>) -! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#1(%[[VAL_2]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>> +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_3]]#0(%[[VAL_2]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>> ! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.box<!fir.array<3xi32>> ! CHECK: fir.store %[[VAL_4]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.array<3xi32>>> ! CHECK: omp.parallel byref reduction(@add_reduction_byref_box_3xi32 %[[VAL_5]] -> %[[VAL_6:.*]] : !fir.ref<!fir.box<!fir.array<3xi32>>>) { diff --git a/flang/test/Lower/OpenMP/parallel-reduction3.f90 b/flang/test/Lower/OpenMP/parallel-reduction3.f90 new file mode 100644 index 0000000..b257597 --- /dev/null +++ b/flang/test/Lower/OpenMP/parallel-reduction3.f90 @@ -0,0 +1,125 @@ +! NOTE: Assertions have been autogenerated by utils/generate-test-checks.py + +! The script is designed to make adding checks to +! a test case fast, it is *not* designed to be authoritative +! about what constitutes a good test! The CHECK should be +! minimized and named to reflect the test intent. + +! RUN: bbc -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s +! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s + + + +! CHECK-LABEL: omp.declare_reduction @add_reduction_byref_box_Uxi32 : !fir.ref<!fir.box<!fir.array<?xi32>>> init { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<?xi32>>>): +! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32 +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index) +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xi32>, %[[VAL_4]]#1 {bindc_name = ".tmp"} +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_5]]) {uniq_name = ".tmp"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>) +! CHECK: hlfir.assign %[[VAL_1]] to %[[VAL_7]]#0 : i32, !fir.box<!fir.array<?xi32>> +! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.box<!fir.array<?xi32>> +! CHECK: fir.store %[[VAL_7]]#0 to %[[VAL_8]] : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: omp.yield(%[[VAL_8]] : !fir.ref<!fir.box<!fir.array<?xi32>>>) + +! CHECK-LABEL: } combiner { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<?xi32>>>, %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.array<?xi32>>>): +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index) +! CHECK: %[[VAL_6:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_5]]#1 step %[[VAL_7]] unordered { +! CHECK: %[[VAL_9:.*]] = fir.array_coor %[[VAL_2]](%[[VAL_6]]) %[[VAL_8]] : (!fir.box<!fir.array<?xi32>>, !fir.shapeshift<1>, index) -> !fir.ref<i32> +! CHECK: %[[VAL_10:.*]] = fir.array_coor %[[VAL_3]](%[[VAL_6]]) %[[VAL_8]] : (!fir.box<!fir.array<?xi32>>, !fir.shapeshift<1>, index) -> !fir.ref<i32> +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_9]] : !fir.ref<i32> +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_10]] : !fir.ref<i32> +! CHECK: %[[VAL_13:.*]] = arith.addi %[[VAL_11]], %[[VAL_12]] : i32 +! CHECK: fir.store %[[VAL_13]] to %[[VAL_9]] : !fir.ref<i32> +! CHECK: } +! CHECK: omp.yield(%[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xi32>>>) +! CHECK: } + +! CHECK-LABEL: func.func @_QPs( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "x"}) { +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFsEx"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) +! CHECK: %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFsEi"} +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFsEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<i32> +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> i64 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index +! CHECK: %[[VAL_7:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_8:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_7]] : index +! CHECK: %[[VAL_9:.*]] = arith.select %[[VAL_8]], %[[VAL_6]], %[[VAL_7]] : index +! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.array<?xi32>, %[[VAL_9]] {bindc_name = "c", uniq_name = "_QFsEc"} +! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_9]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10]](%[[VAL_11]]) {uniq_name = "_QFsEc"} : (!fir.ref<!fir.array<?xi32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xi32>>, !fir.ref<!fir.array<?xi32>>) +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : i32 +! CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_12]]#0 : i32, !fir.box<!fir.array<?xi32>> +! CHECK: omp.parallel { +! CHECK: %[[VAL_14:.*]] = fir.alloca i32 {adapt.valuebyref, pinned} +! CHECK: %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_14]] {uniq_name = "_QFsEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_17:.*]] = arith.constant 100 : i32 +! CHECK: %[[VAL_18:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_19:.*]] = fir.alloca !fir.box<!fir.array<?xi32>> +! CHECK: fir.store %[[VAL_12]]#0 to %[[VAL_19]] : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: omp.wsloop byref reduction(@add_reduction_byref_box_Uxi32 %[[VAL_19]] -> %[[VAL_20:.*]] : !fir.ref<!fir.box<!fir.array<?xi32>>>) for (%[[VAL_21:.*]]) : i32 = (%[[VAL_16]]) to (%[[VAL_17]]) inclusive step (%[[VAL_18]]) { +! CHECK: fir.store %[[VAL_21]] to %[[VAL_15]]#1 : !fir.ref<i32> +! CHECK: %[[VAL_22:.*]]:2 = hlfir.declare %[[VAL_20]] {uniq_name = "_QFsEc"} : (!fir.ref<!fir.box<!fir.array<?xi32>>>) -> (!fir.ref<!fir.box<!fir.array<?xi32>>>, !fir.ref<!fir.box<!fir.array<?xi32>>>) +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_22]]#0 : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_15]]#0 : !fir.ref<i32> +! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_26:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_25]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index) +! CHECK: %[[VAL_27:.*]] = fir.shape %[[VAL_26]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_28:.*]] = hlfir.elemental %[[VAL_27]] unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> { +! CHECK: ^bb0(%[[VAL_29:.*]]: index): +! CHECK: %[[VAL_30:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_31:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_30]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index) +! CHECK: %[[VAL_32:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_33:.*]] = arith.subi %[[VAL_31]]#0, %[[VAL_32]] : index +! CHECK: %[[VAL_34:.*]] = arith.addi %[[VAL_29]], %[[VAL_33]] : index +! CHECK: %[[VAL_35:.*]] = hlfir.designate %[[VAL_23]] (%[[VAL_34]]) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32> +! CHECK: %[[VAL_36:.*]] = fir.load %[[VAL_35]] : !fir.ref<i32> +! CHECK: %[[VAL_37:.*]] = arith.addi %[[VAL_36]], %[[VAL_24]] : i32 +! CHECK: hlfir.yield_element %[[VAL_37]] : i32 +! CHECK: } +! CHECK: %[[VAL_38:.*]] = fir.load %[[VAL_22]]#0 : !fir.ref<!fir.box<!fir.array<?xi32>>> +! CHECK: hlfir.assign %[[VAL_28]] to %[[VAL_38]] : !hlfir.expr<?xi32>, !fir.box<!fir.array<?xi32>> +! CHECK: hlfir.destroy %[[VAL_28]] : !hlfir.expr<?xi32> +! CHECK: omp.yield +! CHECK: } +! CHECK: omp.terminator +! CHECK: } +! CHECK: %[[VAL_39:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_40:.*]] = hlfir.designate %[[VAL_12]]#0 (%[[VAL_39]]) : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32> +! CHECK: %[[VAL_41:.*]] = fir.load %[[VAL_40]] : !fir.ref<i32> +! CHECK: %[[VAL_42:.*]] = arith.constant 5050 : i32 +! CHECK: %[[VAL_43:.*]] = arith.cmpi ne, %[[VAL_41]], %[[VAL_42]] : i32 +! CHECK: cf.cond_br %[[VAL_43]], ^bb1, ^bb2 +! CHECK: ^bb1: +! CHECK: %[[VAL_44:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_45:.*]] = arith.constant false +! CHECK: %[[VAL_46:.*]] = arith.constant false +! CHECK: %[[VAL_47:.*]] = fir.call @_FortranAStopStatement(%[[VAL_44]], %[[VAL_45]], %[[VAL_46]]) fastmath<contract> : (i32, i1, i1) -> none +! CHECK: fir.unreachable +! CHECK: ^bb2: +! CHECK: return +! CHECK: } +! CHECK: func.func private @_FortranAStopStatement(i32, i1, i1) -> none attributes {fir.runtime} + +subroutine s(x) + integer :: x + integer :: c(x) + c = 0 + !$omp parallel do reduction(+:c) + do i = 1, 100 + c = c + i + end do + !$omp end parallel do + + if (c(1) /= 5050) stop 1 +end subroutine s
\ No newline at end of file diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-array-assumed-shape.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-array-assumed-shape.f90 new file mode 100644 index 0000000..a1f339f --- /dev/null +++ b/flang/test/Lower/OpenMP/wsloop-reduction-array-assumed-shape.f90 @@ -0,0 +1,90 @@ +! RUN: bbc -emit-hlfir -fopenmp -o - %s | FileCheck %s +! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s | FileCheck %s + +program reduce_assumed_shape +real(8), dimension(2) :: r +r = 0 +call reduce(r) +print *, r + +contains +subroutine reduce(r) + implicit none + real(8),intent(inout) :: r(:) + integer :: i = 0 + + !$omp parallel do reduction(+:r) + do i=0,10 + r(1) = i + r(2) = 1 + enddo + !$omp end parallel do +end subroutine +end program + +! CHECK-LABEL: omp.declare_reduction @add_reduction_byref_box_Uxf64 : !fir.ref<!fir.box<!fir.array<?xf64>>> init { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<?xf64>>>): +! CHECK: %[[VAL_1:.*]] = arith.constant 0.000000e+00 : f64 +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_3]] : (!fir.box<!fir.array<?xf64>>, index) -> (index, index, index) +! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1> +! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.array<?xf64>, %[[VAL_4]]#1 {bindc_name = ".tmp"} +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]](%[[VAL_5]]) {uniq_name = ".tmp"} : (!fir.ref<!fir.array<?xf64>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf64>>, !fir.ref<!fir.array<?xf64>>) +! CHECK: hlfir.assign %[[VAL_1]] to %[[VAL_7]]#0 : f64, !fir.box<!fir.array<?xf64>> +! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.box<!fir.array<?xf64>> +! CHECK: fir.store %[[VAL_7]]#0 to %[[VAL_8]] : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: omp.yield(%[[VAL_8]] : !fir.ref<!fir.box<!fir.array<?xf64>>>) + +! CHECK-LABEL: } combiner { +! CHECK: ^bb0(%[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.array<?xf64>>>, %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.array<?xf64>>>): +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.array<?xf64>>, index) -> (index, index, index) +! CHECK: %[[VAL_6:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_5]]#1 step %[[VAL_7]] unordered { +! CHECK: %[[VAL_9:.*]] = fir.array_coor %[[VAL_2]](%[[VAL_6]]) %[[VAL_8]] : (!fir.box<!fir.array<?xf64>>, !fir.shapeshift<1>, index) -> !fir.ref<f64> +! CHECK: %[[VAL_10:.*]] = fir.array_coor %[[VAL_3]](%[[VAL_6]]) %[[VAL_8]] : (!fir.box<!fir.array<?xf64>>, !fir.shapeshift<1>, index) -> !fir.ref<f64> +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_9]] : !fir.ref<f64> +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_10]] : !fir.ref<f64> +! CHECK: %[[VAL_13:.*]] = arith.addf %[[VAL_11]], %[[VAL_12]] fastmath<contract> : f64 +! CHECK: fir.store %[[VAL_13]] to %[[VAL_9]] : !fir.ref<f64> +! CHECK: } +! CHECK: omp.yield(%[[VAL_0]] : !fir.ref<!fir.box<!fir.array<?xf64>>>) +! CHECK: } + +! CHECK-LABEL: func.func private @_QFPreduce( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xf64>> {fir.bindc_name = "r"}) attributes {{.*}} { +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFFreduceEi) : !fir.ref<i32> +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFFreduceEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = {{.*}}, uniq_name = "_QFFreduceEr"} : (!fir.box<!fir.array<?xf64>>) -> (!fir.box<!fir.array<?xf64>>, !fir.box<!fir.array<?xf64>>) +! CHECK: omp.parallel { +! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {adapt.valuebyref, pinned} +! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFFreduceEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>) +! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i32 +! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box<!fir.array<?xf64>> +! CHECK: fir.store %[[VAL_3]]#1 to %[[VAL_9]] : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: omp.wsloop byref reduction(@add_reduction_byref_box_Uxf64 %[[VAL_9]] -> %[[VAL_10:.*]] : !fir.ref<!fir.box<!fir.array<?xf64>>>) for (%[[VAL_11:.*]]) : i32 = (%[[VAL_6]]) to (%[[VAL_7]]) inclusive step (%[[VAL_8]]) { +! CHECK: fir.store %[[VAL_11]] to %[[VAL_5]]#1 : !fir.ref<i32> +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10]] {fortran_attrs = {{.*}}, uniq_name = "_QFFreduceEr"} : (!fir.ref<!fir.box<!fir.array<?xf64>>>) -> (!fir.ref<!fir.box<!fir.array<?xf64>>>, !fir.ref<!fir.box<!fir.array<?xf64>>>) +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32> +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> f64 +! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_15]] (%[[VAL_16]]) : (!fir.box<!fir.array<?xf64>>, index) -> !fir.ref<f64> +! CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_17]] : f64, !fir.ref<f64> +! CHECK: %[[VAL_18:.*]] = arith.constant 1.000000e+00 : f64 +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_12]]#0 : !fir.ref<!fir.box<!fir.array<?xf64>>> +! CHECK: %[[VAL_20:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_19]] (%[[VAL_20]]) : (!fir.box<!fir.array<?xf64>>, index) -> !fir.ref<f64> +! CHECK: hlfir.assign %[[VAL_18]] to %[[VAL_21]] : f64, !fir.ref<f64> +! CHECK: omp.yield +! CHECK: } +! CHECK: omp.terminator +! CHECK: } +! CHECK: return +! CHECK: } diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 index a20ed1c..a898204 100644 --- a/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 +++ b/flang/test/Lower/OpenMP/wsloop-reduction-array.f90 @@ -60,7 +60,7 @@ end program ! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i32 ! CHECK: %[[VAL_9:.*]] = arith.constant 10 : i32 ! CHECK: %[[VAL_10:.*]] = arith.constant 1 : i32 -! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_5]]#1(%[[VAL_4]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xi32>> +! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_5]]#0(%[[VAL_4]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xi32>> ! CHECK: %[[VAL_12:.*]] = fir.alloca !fir.box<!fir.array<2xi32>> ! CHECK: fir.store %[[VAL_11]] to %[[VAL_12]] : !fir.ref<!fir.box<!fir.array<2xi32>>> ! CHECK: omp.wsloop byref reduction(@add_reduction_byref_box_2xi32 %[[VAL_12]] -> %[[VAL_13:.*]] : !fir.ref<!fir.box<!fir.array<2xi32>>>) for (%[[VAL_14:.*]]) : i32 = (%[[VAL_8]]) to (%[[VAL_9]]) inclusive step (%[[VAL_10]]) { diff --git a/flang/test/Lower/OpenMP/wsloop-reduction-array2.f90 b/flang/test/Lower/OpenMP/wsloop-reduction-array2.f90 index 6159987..f3745c8 100644 --- a/flang/test/Lower/OpenMP/wsloop-reduction-array2.f90 +++ b/flang/test/Lower/OpenMP/wsloop-reduction-array2.f90 @@ -60,7 +60,7 @@ end program ! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i32 ! CHECK: %[[VAL_9:.*]] = arith.constant 10 : i32 ! CHECK: %[[VAL_10:.*]] = arith.constant 1 : i32 -! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_5]]#1(%[[VAL_4]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xi32>> +! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_5]]#0(%[[VAL_4]]) : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<2xi32>> ! CHECK: %[[VAL_12:.*]] = fir.alloca !fir.box<!fir.array<2xi32>> ! CHECK: fir.store %[[VAL_11]] to %[[VAL_12]] : !fir.ref<!fir.box<!fir.array<2xi32>>> ! CHECK: omp.wsloop byref reduction(@add_reduction_byref_box_2xi32 %[[VAL_12]] -> %[[VAL_13:.*]] : !fir.ref<!fir.box<!fir.array<2xi32>>>) for (%[[VAL_14:.*]]) : i32 = (%[[VAL_8]]) to (%[[VAL_9]]) inclusive step (%[[VAL_10]]) { diff --git a/flang/test/Lower/stop-statement.f90 b/flang/test/Lower/stop-statement.f90 index bc94a7e..cf0665c 100644 --- a/flang/test/Lower/stop-statement.f90 +++ b/flang/test/Lower/stop-statement.f90 @@ -21,10 +21,10 @@ end subroutine ! CHECK-LABEL: stop_error subroutine stop_error() error stop - ! CHECK-DAG: %[[c0:.*]] = arith.constant 0 : i32 + ! CHECK-DAG: %[[c_1:.*]] = arith.constant 1 : i32 ! CHECK-DAG: %[[true:.*]] = arith.constant true ! CHECK-DAG: %[[false:.*]] = arith.constant false - ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c0]], %[[true]], %[[false]]) + ! CHECK: fir.call @_Fortran{{.*}}StopStatement(%[[c_1]], %[[true]], %[[false]]) ! CHECK-NEXT: fir.unreachable end subroutine diff --git a/flang/test/Semantics/cuf03.cuf b/flang/test/Semantics/cuf03.cuf index 41bfbb7..7384a10 100644 --- a/flang/test/Semantics/cuf03.cuf +++ b/flang/test/Semantics/cuf03.cuf @@ -51,7 +51,8 @@ module m contains attributes(device) subroutine devsubr(n,da) integer, intent(in) :: n - real, device :: da(*) ! ok + !ERROR: Object 'da' with ATTRIBUTES(DEVICE) may not be assumed size + real, device :: da(*) real, managed :: ma(n) ! ok !WARNING: Pointer 'dp' may not be associated in a device subprogram real, device, pointer :: dp diff --git a/flang/unittests/Runtime/Numeric.cpp b/flang/unittests/Runtime/Numeric.cpp index 43263d1..b69ff21 100644 --- a/flang/unittests/Runtime/Numeric.cpp +++ b/flang/unittests/Runtime/Numeric.cpp @@ -65,6 +65,30 @@ TEST(Numeric, Mod) { EXPECT_EQ(RTNAME(ModReal4)(Real<4>{-8.0}, Real<4>(5.0)), -3.0); EXPECT_EQ(RTNAME(ModReal8)(Real<8>{8.0}, Real<8>(-5.0)), 3.0); EXPECT_EQ(RTNAME(ModReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0); + EXPECT_EQ( + RTNAME(ModReal4)(Real<4>{0.5}, std::numeric_limits<Real<4>>::infinity()), + 0.5); + EXPECT_EQ( + RTNAME(ModReal4)(Real<4>{-0.5}, std::numeric_limits<Real<4>>::infinity()), + -0.5); + EXPECT_EQ( + RTNAME(ModReal4)(Real<4>{0.5}, -std::numeric_limits<Real<4>>::infinity()), + 0.5); + EXPECT_EQ(RTNAME(ModReal4)( + Real<4>{-0.5}, -std::numeric_limits<Real<4>>::infinity()), + -0.5); + EXPECT_EQ( + RTNAME(ModReal8)(Real<8>{0.5}, std::numeric_limits<Real<8>>::infinity()), + 0.5); + EXPECT_EQ( + RTNAME(ModReal8)(Real<8>{-0.5}, std::numeric_limits<Real<8>>::infinity()), + -0.5); + EXPECT_EQ( + RTNAME(ModReal8)(Real<8>{0.5}, -std::numeric_limits<Real<8>>::infinity()), + 0.5); + EXPECT_EQ(RTNAME(ModReal8)( + Real<8>{-0.5}, -std::numeric_limits<Real<8>>::infinity()), + -0.5); } TEST(Numeric, Modulo) { @@ -76,6 +100,28 @@ TEST(Numeric, Modulo) { EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{-8.0}, Real<4>(5.0)), 2.0); EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{8.0}, Real<8>(-5.0)), -2.0); EXPECT_EQ(RTNAME(ModuloReal8)(Real<8>{-8.0}, Real<8>(-5.0)), -3.0); + // MODULO(x, INF) == NaN + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal4)( + Real<4>{0.5}, std::numeric_limits<Real<4>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal4)( + Real<4>{-0.5}, std::numeric_limits<Real<4>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal4)( + Real<4>{0.5}, -std::numeric_limits<Real<4>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal4)( + Real<4>{-0.5}, -std::numeric_limits<Real<4>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal8)( + Real<8>{-0.5}, std::numeric_limits<Real<8>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal8)( + Real<8>{0.5}, std::numeric_limits<Real<8>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal8)( + Real<8>{-0.5}, -std::numeric_limits<Real<8>>::infinity()))); + EXPECT_TRUE(std::isnan(RTNAME(ModuloReal8)( + Real<8>{0.5}, -std::numeric_limits<Real<8>>::infinity()))); + // MODULO(x, y) for integer values of x and y with 0 remainder. + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{5.0}, Real<4>(1.0)), 0.0); + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{5.0}, Real<4>(-1.0)), -0.0); + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{-5.0}, Real<4>(1.0)), 0.0); + EXPECT_EQ(RTNAME(ModuloReal4)(Real<4>{-5.0}, Real<4>(-1.0)), -0.0); } TEST(Numeric, Nearest) { diff --git a/flang/unittests/Runtime/Time.cpp b/flang/unittests/Runtime/Time.cpp index ec0caa7..5c93282 100644 --- a/flang/unittests/Runtime/Time.cpp +++ b/flang/unittests/Runtime/Time.cpp @@ -12,7 +12,7 @@ #include "flang/Runtime/time-intrinsic.h" #include <algorithm> #include <cctype> -#include <charconv> +#include <cerrno> #include <string> using namespace Fortran::runtime; @@ -104,10 +104,9 @@ TEST(TimeIntrinsics, DateAndTime) { EXPECT_TRUE(true); } else { count_t number{-1}; - auto [_, ec]{ - std::from_chars(date.data(), date.data() + date.size(), number)}; - ASSERT_TRUE(ec != std::errc::invalid_argument && - ec != std::errc::result_out_of_range); + // Use stol to allow GCC 7.5 to build tests + number = std::stol(date); + ASSERT_TRUE(errno != ERANGE); EXPECT_GE(number, 0); auto year = number / 10000; auto month = (number - year * 10000) / 100; @@ -121,14 +120,15 @@ TEST(TimeIntrinsics, DateAndTime) { } // Validate time is hhmmss.sss or blank. + std::string acceptedPattern("hhmmss.sss"); if (isBlank(time)) { EXPECT_TRUE(true); } else { count_t number{-1}; - auto [next, ec]{ - std::from_chars(time.data(), time.data() + date.size(), number)}; - ASSERT_TRUE(ec != std::errc::invalid_argument && - ec != std::errc::result_out_of_range); + // Use stol to allow GCC 7.5 to build tests + auto dotPosition = acceptedPattern.find('.'); + number = std::stol(time.substr(0, dotPosition)); + ASSERT_TRUE(errno != ERANGE); ASSERT_GE(number, 0); auto hours = number / 10000; auto minutes = (number - hours * 10000) / 100; @@ -137,15 +137,11 @@ TEST(TimeIntrinsics, DateAndTime) { EXPECT_LE(minutes, 59); // Accept 60 for leap seconds. EXPECT_LE(seconds, 60); - ASSERT_TRUE(next != time.data() + time.size()); - EXPECT_EQ(*next, '.'); + EXPECT_EQ(time.substr(dotPosition, 1), "."); count_t milliseconds{-1}; - ASSERT_TRUE(next + 1 != time.data() + time.size()); - auto [_, ec2]{ - std::from_chars(next + 1, time.data() + date.size(), milliseconds)}; - ASSERT_TRUE(ec2 != std::errc::invalid_argument && - ec2 != std::errc::result_out_of_range); + milliseconds = std::stol(time.substr(dotPosition + 1, 3)); + ASSERT_TRUE(errno != ERANGE); EXPECT_GE(milliseconds, 0); EXPECT_LE(milliseconds, 999); } @@ -157,10 +153,9 @@ TEST(TimeIntrinsics, DateAndTime) { ASSERT_TRUE(zone.size() > 1); EXPECT_TRUE(zone[0] == '+' || zone[0] == '-'); count_t number{-1}; - auto [next, ec]{ - std::from_chars(zone.data() + 1, zone.data() + zone.size(), number)}; - ASSERT_TRUE(ec != std::errc::invalid_argument && - ec != std::errc::result_out_of_range); + // Use stol to allow GCC 7.5 to build tests + number = std::stol(zone.substr(1, 4)); + ASSERT_TRUE(errno != ERANGE); ASSERT_GE(number, 0); auto hours = number / 100; auto minutes = number % 100; |