aboutsummaryrefslogtreecommitdiff
path: root/flang
diff options
context:
space:
mode:
Diffstat (limited to 'flang')
-rw-r--r--flang/include/flang/Runtime/io-api.h164
-rw-r--r--flang/lib/Lower/ConvertCall.cpp9
-rw-r--r--flang/lib/Lower/OpenMP/ReductionProcessor.cpp31
-rw-r--r--flang/lib/Lower/Runtime.cpp9
-rw-r--r--flang/runtime/environment.cpp2
-rw-r--r--flang/runtime/environment.h2
-rw-r--r--flang/runtime/freestanding-tools.h19
-rw-r--r--flang/runtime/io-api.cpp204
-rw-r--r--flang/runtime/io-error.cpp9
-rw-r--r--flang/runtime/io-error.h2
-rw-r--r--flang/runtime/namelist.cpp46
-rw-r--r--flang/test/Lower/HLFIR/assumed-rank-iface.f9023
-rw-r--r--flang/test/Lower/OpenMP/parallel-reduction-array.f902
-rw-r--r--flang/test/Lower/OpenMP/parallel-reduction-array2.f902
-rw-r--r--flang/test/Lower/OpenMP/parallel-reduction3.f90125
-rw-r--r--flang/test/Lower/OpenMP/wsloop-reduction-array-assumed-shape.f9090
-rw-r--r--flang/test/Lower/OpenMP/wsloop-reduction-array.f902
-rw-r--r--flang/test/Lower/OpenMP/wsloop-reduction-array2.f902
-rw-r--r--flang/test/Lower/stop-statement.f904
-rw-r--r--flang/unittests/Runtime/Time.cpp35
20 files changed, 498 insertions, 284 deletions
diff --git a/flang/include/flang/Runtime/io-api.h b/flang/include/flang/Runtime/io-api.h
index 328afc7..1b6c4f5 100644
--- a/flang/include/flang/Runtime/io-api.h
+++ b/flang/include/flang/Runtime/io-api.h
@@ -92,18 +92,18 @@ constexpr std::size_t RecommendedInternalIoScratchAreaBytes(
// Internal I/O to/from character arrays &/or non-default-kind character
// requires a descriptor, which is copied.
-Cookie IODECL(BeginInternalArrayListOutput)(const Descriptor &,
+Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginInternalArrayListInput)(const Descriptor &,
+Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginInternalArrayFormattedOutput)(const Descriptor &,
+Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &,
const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor = nullptr, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginInternalArrayFormattedInput)(const Descriptor &,
+Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &,
const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor = nullptr, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
@@ -111,20 +111,20 @@ Cookie IODECL(BeginInternalArrayFormattedInput)(const Descriptor &,
// Internal I/O to/from a default-kind character scalar can avoid a
// descriptor.
-Cookie IODECL(BeginInternalListOutput)(char *internal,
+Cookie IONAME(BeginInternalListOutput)(char *internal,
std::size_t internalLength, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginInternalListInput)(const char *internal,
+Cookie IONAME(BeginInternalListInput)(const char *internal,
std::size_t internalLength, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginInternalFormattedOutput)(char *internal,
+Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor = nullptr, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginInternalFormattedInput)(const char *internal,
+Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor = nullptr, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
@@ -139,63 +139,63 @@ Cookie IODECL(BeginInternalFormattedInput)(const char *internal,
// If handleError is false, and the unit number is out of range, the program
// will be terminated. Otherwise, if unit is out of range, a nonzero Iostat
// code is returned and ioMsg is set if it is not a nullptr.
-enum Iostat IODECL(CheckUnitNumberInRange64)(std::int64_t unit,
+enum Iostat IONAME(CheckUnitNumberInRange64)(std::int64_t unit,
bool handleError, char *ioMsg = nullptr, std::size_t ioMsgLength = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
-enum Iostat IODECL(CheckUnitNumberInRange128)(common::int128_t unit,
+enum Iostat IONAME(CheckUnitNumberInRange128)(common::int128_t unit,
bool handleError, char *ioMsg = nullptr, std::size_t ioMsgLength = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
// External synchronous I/O initiation
Cookie IODECL(BeginExternalListOutput)(ExternalUnit = DefaultOutputUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginExternalListInput)(ExternalUnit = DefaultInputUnit,
+Cookie IONAME(BeginExternalListInput)(ExternalUnit = DefaultInputUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginExternalFormattedOutput)(const char *format, std::size_t,
+Cookie IONAME(BeginExternalFormattedOutput)(const char *format, std::size_t,
const Descriptor *formatDescriptor = nullptr,
ExternalUnit = DefaultOutputUnit, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginExternalFormattedInput)(const char *format, std::size_t,
+Cookie IONAME(BeginExternalFormattedInput)(const char *format, std::size_t,
const Descriptor *formatDescriptor = nullptr,
ExternalUnit = DefaultInputUnit, const char *sourceFile = nullptr,
int sourceLine = 0);
-Cookie IODECL(BeginUnformattedOutput)(ExternalUnit = DefaultOutputUnit,
+Cookie IONAME(BeginUnformattedOutput)(ExternalUnit = DefaultOutputUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginUnformattedInput)(ExternalUnit = DefaultInputUnit,
+Cookie IONAME(BeginUnformattedInput)(ExternalUnit = DefaultInputUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
// WAIT(ID=)
-Cookie IODECL(BeginWait)(ExternalUnit, AsynchronousId,
+Cookie IONAME(BeginWait)(ExternalUnit, AsynchronousId,
const char *sourceFile = nullptr, int sourceLine = 0);
// WAIT(no ID=)
-Cookie IODECL(BeginWaitAll)(
+Cookie IONAME(BeginWaitAll)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
// Other I/O statements
-Cookie IODECL(BeginClose)(
+Cookie IONAME(BeginClose)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginFlush)(
+Cookie IONAME(BeginFlush)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginBackspace)(
+Cookie IONAME(BeginBackspace)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginEndfile)(
+Cookie IONAME(BeginEndfile)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginRewind)(
+Cookie IONAME(BeginRewind)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
// OPEN(UNIT=) and OPEN(NEWUNIT=) have distinct interfaces.
-Cookie IODECL(BeginOpenUnit)(
+Cookie IONAME(BeginOpenUnit)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginOpenNewUnit)(
+Cookie IONAME(BeginOpenNewUnit)(
const char *sourceFile = nullptr, int sourceLine = 0);
// The variant forms of INQUIRE() statements have distinct interfaces.
// BeginInquireIoLength() is basically a no-op output statement.
-Cookie IODECL(BeginInquireUnit)(
+Cookie IONAME(BeginInquireUnit)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginInquireFile)(const char *, std::size_t,
+Cookie IONAME(BeginInquireFile)(const char *, std::size_t,
const char *sourceFile = nullptr, int sourceLine = 0);
-Cookie IODECL(BeginInquireIoLength)(
+Cookie IONAME(BeginInquireIoLength)(
const char *sourceFile = nullptr, int sourceLine = 0);
// If an I/O statement has any IOSTAT=, ERR=, END=, or EOR= specifiers,
@@ -214,33 +214,33 @@ Cookie IODECL(BeginInquireIoLength)(
// }
// }
// if (EndIoStatement(cookie) == FORTRAN_RUTIME_IOSTAT_END) goto label666;
-void IODECL(EnableHandlers)(Cookie, bool hasIoStat = false, bool hasErr = false,
+void IONAME(EnableHandlers)(Cookie, bool hasIoStat = false, bool hasErr = false,
bool hasEnd = false, bool hasEor = false, bool hasIoMsg = false);
// ASYNCHRONOUS='YES' or 'NO' on READ/WRITE/OPEN
// Use GetAsynchronousId() to handle ID=.
-bool IODECL(SetAsynchronous)(Cookie, const char *, std::size_t);
+bool IONAME(SetAsynchronous)(Cookie, const char *, std::size_t);
// Control list options. These return false on a error that the
// Begin...() call has specified will be handled by the caller.
// The interfaces that pass a default-kind CHARACTER argument
// are limited to passing specific case-insensitive keyword values.
// ADVANCE=YES, NO
-bool IODECL(SetAdvance)(Cookie, const char *, std::size_t);
+bool IONAME(SetAdvance)(Cookie, const char *, std::size_t);
// BLANK=NULL, ZERO
-bool IODECL(SetBlank)(Cookie, const char *, std::size_t);
+bool IONAME(SetBlank)(Cookie, const char *, std::size_t);
// DECIMAL=COMMA, POINT
-bool IODECL(SetDecimal)(Cookie, const char *, std::size_t);
+bool IONAME(SetDecimal)(Cookie, const char *, std::size_t);
// DELIM=APOSTROPHE, QUOTE, NONE
-bool IODECL(SetDelim)(Cookie, const char *, std::size_t);
+bool IONAME(SetDelim)(Cookie, const char *, std::size_t);
// PAD=YES, NO
-bool IODECL(SetPad)(Cookie, const char *, std::size_t);
-bool IODECL(SetPos)(Cookie, std::int64_t);
-bool IODECL(SetRec)(Cookie, std::int64_t);
+bool IONAME(SetPad)(Cookie, const char *, std::size_t);
+bool IONAME(SetPos)(Cookie, std::int64_t);
+bool IONAME(SetRec)(Cookie, std::int64_t);
// ROUND=UP, DOWN, ZERO, NEAREST, COMPATIBLE, PROCESSOR_DEFINED
-bool IODECL(SetRound)(Cookie, const char *, std::size_t);
+bool IONAME(SetRound)(Cookie, const char *, std::size_t);
// SIGN=PLUS, SUPPRESS, PROCESSOR_DEFINED
-bool IODECL(SetSign)(Cookie, const char *, std::size_t);
+bool IONAME(SetSign)(Cookie, const char *, std::size_t);
// Data item transfer for modes other than NAMELIST:
// Any data object that can be passed as an actual argument without the
@@ -256,34 +256,34 @@ bool IODECL(SetSign)(Cookie, const char *, std::size_t);
// Once the statement has encountered an error, all following items will be
// ignored and also return false; but compiled code should check for errors
// and avoid the following items when they might crash.
-bool IODECL(OutputDescriptor)(Cookie, const Descriptor &);
-bool IODECL(InputDescriptor)(Cookie, const Descriptor &);
+bool IONAME(OutputDescriptor)(Cookie, const Descriptor &);
+bool IONAME(InputDescriptor)(Cookie, const Descriptor &);
// Formatted (including list directed) I/O data items
-bool IODECL(OutputInteger8)(Cookie, std::int8_t);
-bool IODECL(OutputInteger16)(Cookie, std::int16_t);
+bool IONAME(OutputInteger8)(Cookie, std::int8_t);
+bool IONAME(OutputInteger16)(Cookie, std::int16_t);
bool IODECL(OutputInteger32)(Cookie, std::int32_t);
-bool IODECL(OutputInteger64)(Cookie, std::int64_t);
-bool IODECL(OutputInteger128)(Cookie, common::int128_t);
-bool IODECL(InputInteger)(Cookie, std::int64_t &, int kind = 8);
-bool IODECL(OutputReal32)(Cookie, float);
-bool IODECL(InputReal32)(Cookie, float &);
-bool IODECL(OutputReal64)(Cookie, double);
-bool IODECL(InputReal64)(Cookie, double &);
-bool IODECL(OutputComplex32)(Cookie, float, float);
-bool IODECL(InputComplex32)(Cookie, float[2]);
-bool IODECL(OutputComplex64)(Cookie, double, double);
-bool IODECL(InputComplex64)(Cookie, double[2]);
-bool IODECL(OutputCharacter)(Cookie, const char *, std::size_t, int kind = 1);
-bool IODECL(OutputAscii)(Cookie, const char *, std::size_t);
-bool IODECL(InputCharacter)(Cookie, char *, std::size_t, int kind = 1);
-bool IODECL(InputAscii)(Cookie, char *, std::size_t);
-bool IODECL(OutputLogical)(Cookie, bool);
-bool IODECL(InputLogical)(Cookie, bool &);
+bool IONAME(OutputInteger64)(Cookie, std::int64_t);
+bool IONAME(OutputInteger128)(Cookie, common::int128_t);
+bool IONAME(InputInteger)(Cookie, std::int64_t &, int kind = 8);
+bool IONAME(OutputReal32)(Cookie, float);
+bool IONAME(InputReal32)(Cookie, float &);
+bool IONAME(OutputReal64)(Cookie, double);
+bool IONAME(InputReal64)(Cookie, double &);
+bool IONAME(OutputComplex32)(Cookie, float, float);
+bool IONAME(InputComplex32)(Cookie, float[2]);
+bool IONAME(OutputComplex64)(Cookie, double, double);
+bool IONAME(InputComplex64)(Cookie, double[2]);
+bool IONAME(OutputCharacter)(Cookie, const char *, std::size_t, int kind = 1);
+bool IONAME(OutputAscii)(Cookie, const char *, std::size_t);
+bool IONAME(InputCharacter)(Cookie, char *, std::size_t, int kind = 1);
+bool IONAME(InputAscii)(Cookie, char *, std::size_t);
+bool IONAME(OutputLogical)(Cookie, bool);
+bool IONAME(InputLogical)(Cookie, bool &);
// NAMELIST I/O must be the only data item in an (otherwise)
// list-directed I/O statement.
-bool IODECL(OutputNamelist)(Cookie, const NamelistGroup &);
-bool IODECL(InputNamelist)(Cookie, const NamelistGroup &);
+bool IONAME(OutputNamelist)(Cookie, const NamelistGroup &);
+bool IONAME(InputNamelist)(Cookie, const NamelistGroup &);
// When an I/O list item has a derived type with a specific defined
// I/O subroutine of the appropriate generic kind for the active
@@ -294,9 +294,9 @@ bool IODECL(InputNamelist)(Cookie, const NamelistGroup &);
// made such a generic interface inaccessible), these data item transfer
// APIs enable the I/O runtime to make the right calls to defined I/O
// subroutines.
-bool IODECL(OutputDerivedType)(
+bool IONAME(OutputDerivedType)(
Cookie, const Descriptor &, const NonTbpDefinedIoTable *);
-bool IODECL(InputDerivedType)(
+bool IONAME(InputDerivedType)(
Cookie, const Descriptor &, const NonTbpDefinedIoTable *);
// Additional specifier interfaces for the connection-list of
@@ -304,56 +304,56 @@ bool IODECL(InputDerivedType)(
// SetDelim(), GetIoMsg(), SetPad(), SetRound(), SetSign(),
// & SetAsynchronous() are also acceptable for OPEN.
// ACCESS=SEQUENTIAL, DIRECT, STREAM
-bool IODECL(SetAccess)(Cookie, const char *, std::size_t);
+bool IONAME(SetAccess)(Cookie, const char *, std::size_t);
// ACTION=READ, WRITE, or READWRITE
-bool IODECL(SetAction)(Cookie, const char *, std::size_t);
+bool IONAME(SetAction)(Cookie, const char *, std::size_t);
// CARRIAGECONTROL=LIST, FORTRAN, NONE
-bool IODECL(SetCarriagecontrol)(Cookie, const char *, std::size_t);
+bool IONAME(SetCarriagecontrol)(Cookie, const char *, std::size_t);
// CONVERT=NATIVE, LITTLE_ENDIAN, BIG_ENDIAN, or SWAP
-bool IODECL(SetConvert)(Cookie, const char *, std::size_t);
+bool IONAME(SetConvert)(Cookie, const char *, std::size_t);
// ENCODING=UTF-8, DEFAULT
-bool IODECL(SetEncoding)(Cookie, const char *, std::size_t);
+bool IONAME(SetEncoding)(Cookie, const char *, std::size_t);
// FORM=FORMATTED, UNFORMATTED
-bool IODECL(SetForm)(Cookie, const char *, std::size_t);
+bool IONAME(SetForm)(Cookie, const char *, std::size_t);
// POSITION=ASIS, REWIND, APPEND
-bool IODECL(SetPosition)(Cookie, const char *, std::size_t);
-bool IODECL(SetRecl)(Cookie, std::size_t); // RECL=
+bool IONAME(SetPosition)(Cookie, const char *, std::size_t);
+bool IONAME(SetRecl)(Cookie, std::size_t); // RECL=
// STATUS can be set during an OPEN or CLOSE statement.
// For OPEN: STATUS=OLD, NEW, SCRATCH, REPLACE, UNKNOWN
// For CLOSE: STATUS=KEEP, DELETE
-bool IODECL(SetStatus)(Cookie, const char *, std::size_t);
+bool IONAME(SetStatus)(Cookie, const char *, std::size_t);
-bool IODECL(SetFile)(Cookie, const char *, std::size_t chars);
+bool IONAME(SetFile)(Cookie, const char *, std::size_t chars);
// Acquires the runtime-created unit number for OPEN(NEWUNIT=)
-bool IODECL(GetNewUnit)(Cookie, int &, int kind = 4);
+bool IONAME(GetNewUnit)(Cookie, int &, int kind = 4);
// READ(SIZE=), after all input items
-std::size_t IODECL(GetSize)(Cookie);
+std::size_t IONAME(GetSize)(Cookie);
// INQUIRE(IOLENGTH=), after all output items
-std::size_t IODECL(GetIoLength)(Cookie);
+std::size_t IONAME(GetIoLength)(Cookie);
// GetIoMsg() does not modify its argument unless an error or
// end-of-record/file condition is present.
-void IODECL(GetIoMsg)(Cookie, char *, std::size_t); // IOMSG=
+void IONAME(GetIoMsg)(Cookie, char *, std::size_t); // IOMSG=
// Defines ID= on READ/WRITE(ASYNCHRONOUS='YES')
-AsynchronousId IODECL(GetAsynchronousId)(Cookie);
+AsynchronousId IONAME(GetAsynchronousId)(Cookie);
// INQUIRE() specifiers are mostly identified by their NUL-terminated
// case-insensitive names.
// ACCESS, ACTION, ASYNCHRONOUS, BLANK, CONVERT, DECIMAL, DELIM, DIRECT,
// ENCODING, FORM, FORMATTED, NAME, PAD, POSITION, READ, READWRITE, ROUND,
// SEQUENTIAL, SIGN, STREAM, UNFORMATTED, WRITE:
-bool IODECL(InquireCharacter)(Cookie, InquiryKeywordHash, char *, std::size_t);
+bool IONAME(InquireCharacter)(Cookie, InquiryKeywordHash, char *, std::size_t);
// EXIST, NAMED, OPENED, and PENDING (without ID):
-bool IODECL(InquireLogical)(Cookie, InquiryKeywordHash, bool &);
+bool IONAME(InquireLogical)(Cookie, InquiryKeywordHash, bool &);
// PENDING with ID
-bool IODECL(InquirePendingId)(Cookie, AsynchronousId, bool &);
+bool IONAME(InquirePendingId)(Cookie, AsynchronousId, bool &);
// NEXTREC, NUMBER, POS, RECL, SIZE
-bool IODECL(InquireInteger64)(
+bool IONAME(InquireInteger64)(
Cookie, InquiryKeywordHash, std::int64_t &, int kind = 8);
// This function must be called to end an I/O statement, and its
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/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/runtime/environment.cpp b/flang/runtime/environment.cpp
index b2c9665..b74067a 100644
--- a/flang/runtime/environment.cpp
+++ b/flang/runtime/environment.cpp
@@ -49,7 +49,6 @@ static void SetEnvironmentDefaults(const EnvironmentDefaultList *envDefaults) {
}
}
-RT_OFFLOAD_API_GROUP_BEGIN
Fortran::common::optional<Convert> GetConvertFromString(
const char *x, std::size_t n) {
static const char *keywords[]{
@@ -69,7 +68,6 @@ Fortran::common::optional<Convert> GetConvertFromString(
return Fortran::common::nullopt;
}
}
-RT_OFFLOAD_API_GROUP_END
void ExecutionEnvironment::Configure(int ac, const char *av[],
const char *env[], const EnvironmentDefaultList *envDefaults) {
diff --git a/flang/runtime/environment.h b/flang/runtime/environment.h
index b8b9f10..6c56993 100644
--- a/flang/runtime/environment.h
+++ b/flang/runtime/environment.h
@@ -31,7 +31,7 @@ RT_OFFLOAD_VAR_GROUP_END
// External unformatted I/O data conversions
enum class Convert { Unknown, Native, LittleEndian, BigEndian, Swap };
-RT_API_ATTRS Fortran::common::optional<Convert> GetConvertFromString(
+Fortran::common::optional<Convert> GetConvertFromString(
const char *, std::size_t);
struct ExecutionEnvironment {
diff --git a/flang/runtime/freestanding-tools.h b/flang/runtime/freestanding-tools.h
index 9089dc6..451bf13 100644
--- a/flang/runtime/freestanding-tools.h
+++ b/flang/runtime/freestanding-tools.h
@@ -52,11 +52,6 @@
#define STD_STRCPY_UNSUPPORTED 1
#endif
-#if !defined(STD_STRCMP_UNSUPPORTED) && \
- (defined(__CUDACC__) || defined(__CUDA__)) && defined(__CUDA_ARCH__)
-#define STD_STRCMP_UNSUPPORTED 1
-#endif
-
namespace Fortran::runtime {
#if STD_FILL_N_UNSUPPORTED
@@ -181,19 +176,5 @@ static inline RT_API_ATTRS char *strcpy(char *dest, const char *src) {
using std::strcpy;
#endif // !STD_STRCPY_UNSUPPORTED
-#if STD_STRCMP_UNSUPPORTED
-// Provides alternative implementation for std::strcmp(), if
-// it is not supported.
-static inline RT_API_ATTRS int strcmp(const char *lhs, const char *rhs) {
- while (*lhs != '\0' && *lhs == *rhs) {
- ++lhs;
- ++rhs;
- }
- return static_cast<unsigned char>(*lhs) - static_cast<unsigned char>(*rhs);
-}
-#else // !STD_STRCMP_UNSUPPORTED
-using std::strcmp;
-#endif // !STD_STRCMP_UNSUPPORTED
-
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_FREESTANDING_TOOLS_H_
diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp
index ccb5b57..3a86c9f 100644
--- a/flang/runtime/io-api.cpp
+++ b/flang/runtime/io-api.cpp
@@ -25,9 +25,8 @@
#include <memory>
namespace Fortran::runtime::io {
-RT_EXT_API_GROUP_BEGIN
-RT_API_ATTRS const char *InquiryKeywordHashDecode(
+const char *InquiryKeywordHashDecode(
char *buffer, std::size_t n, InquiryKeywordHash hash) {
if (n < 1) {
return nullptr;
@@ -45,7 +44,7 @@ RT_API_ATTRS const char *InquiryKeywordHashDecode(
}
template <Direction DIR>
-RT_API_ATTRS Cookie BeginInternalArrayListIO(const Descriptor &descriptor,
+Cookie BeginInternalArrayListIO(const Descriptor &descriptor,
void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
const char *sourceFile, int sourceLine) {
Terminator oom{sourceFile, sourceLine};
@@ -55,14 +54,14 @@ RT_API_ATTRS Cookie BeginInternalArrayListIO(const Descriptor &descriptor,
->ioStatementState();
}
-Cookie IODEF(BeginInternalArrayListOutput)(const Descriptor &descriptor,
+Cookie IONAME(BeginInternalArrayListOutput)(const Descriptor &descriptor,
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
int sourceLine) {
return BeginInternalArrayListIO<Direction::Output>(
descriptor, scratchArea, scratchBytes, sourceFile, sourceLine);
}
-Cookie IODEF(BeginInternalArrayListInput)(const Descriptor &descriptor,
+Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &descriptor,
void **scratchArea, std::size_t scratchBytes, const char *sourceFile,
int sourceLine) {
return BeginInternalArrayListIO<Direction::Input>(
@@ -70,7 +69,7 @@ Cookie IODEF(BeginInternalArrayListInput)(const Descriptor &descriptor,
}
template <Direction DIR>
-RT_API_ATTRS Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
+Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void ** /*scratchArea*/,
std::size_t /*scratchBytes*/, const char *sourceFile, int sourceLine) {
@@ -81,7 +80,7 @@ RT_API_ATTRS Cookie BeginInternalArrayFormattedIO(const Descriptor &descriptor,
->ioStatementState();
}
-Cookie IODEF(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
+Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void **scratchArea,
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
@@ -90,7 +89,7 @@ Cookie IODEF(BeginInternalArrayFormattedOutput)(const Descriptor &descriptor,
sourceLine);
}
-Cookie IODEF(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
+Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &descriptor,
const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void **scratchArea,
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
@@ -111,14 +110,14 @@ RT_API_ATTRS Cookie BeginInternalListIO(
->ioStatementState();
}
-Cookie IODEF(BeginInternalListOutput)(char *internal,
+Cookie IONAME(BeginInternalListOutput)(char *internal,
std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,
const char *sourceFile, int sourceLine) {
return BeginInternalListIO<Direction::Output>(internal, internalLength,
scratchArea, scratchBytes, sourceFile, sourceLine);
}
-Cookie IODEF(BeginInternalListInput)(const char *internal,
+Cookie IONAME(BeginInternalListInput)(const char *internal,
std::size_t internalLength, void **scratchArea, std::size_t scratchBytes,
const char *sourceFile, int sourceLine) {
return BeginInternalListIO<Direction::Input>(internal, internalLength,
@@ -126,7 +125,7 @@ Cookie IODEF(BeginInternalListInput)(const char *internal,
}
template <Direction DIR>
-RT_API_ATTRS Cookie BeginInternalFormattedIO(
+Cookie BeginInternalFormattedIO(
std::conditional_t<DIR == Direction::Input, const char, char> *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void ** /*scratchArea*/,
@@ -139,7 +138,7 @@ RT_API_ATTRS Cookie BeginInternalFormattedIO(
->ioStatementState();
}
-Cookie IODEF(BeginInternalFormattedOutput)(char *internal,
+Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void **scratchArea,
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
@@ -148,7 +147,7 @@ Cookie IODEF(BeginInternalFormattedOutput)(char *internal,
sourceFile, sourceLine);
}
-Cookie IODEF(BeginInternalFormattedInput)(const char *internal,
+Cookie IONAME(BeginInternalFormattedInput)(const char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
const Descriptor *formatDescriptor, void **scratchArea,
std::size_t scratchBytes, const char *sourceFile, int sourceLine) {
@@ -228,22 +227,24 @@ RT_API_ATTRS Cookie BeginExternalListIO(
}
}
+RT_EXT_API_GROUP_BEGIN
Cookie IODEF(BeginExternalListOutput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginExternalListIO<Direction::Output, ExternalListIoStatementState>(
unitNumber, sourceFile, sourceLine);
}
+RT_EXT_API_GROUP_END
-Cookie IODEF(BeginExternalListInput)(
+Cookie IONAME(BeginExternalListInput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
unitNumber, sourceFile, sourceLine);
}
template <Direction DIR>
-RT_API_ATTRS Cookie BeginExternalFormattedIO(const char *format,
- std::size_t formatLength, const Descriptor *formatDescriptor,
- ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
+Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
+ const Descriptor *formatDescriptor, ExternalUnit unitNumber,
+ const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Cookie errorCookie{nullptr};
ExternalFileUnit *unit{GetOrCreateUnit(
@@ -285,14 +286,14 @@ RT_API_ATTRS Cookie BeginExternalFormattedIO(const char *format,
}
}
-Cookie IODEF(BeginExternalFormattedOutput)(const char *format,
+Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
std::size_t formatLength, const Descriptor *formatDescriptor,
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginExternalFormattedIO<Direction::Output>(format, formatLength,
formatDescriptor, unitNumber, sourceFile, sourceLine);
}
-Cookie IODEF(BeginExternalFormattedInput)(const char *format,
+Cookie IONAME(BeginExternalFormattedInput)(const char *format,
std::size_t formatLength, const Descriptor *formatDescriptor,
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginExternalFormattedIO<Direction::Input>(format, formatLength,
@@ -300,7 +301,7 @@ Cookie IODEF(BeginExternalFormattedInput)(const char *format,
}
template <Direction DIR>
-RT_API_ATTRS Cookie BeginUnformattedIO(
+Cookie BeginUnformattedIO(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Cookie errorCookie{nullptr};
@@ -351,19 +352,19 @@ RT_API_ATTRS Cookie BeginUnformattedIO(
}
}
-Cookie IODEF(BeginUnformattedOutput)(
+Cookie IONAME(BeginUnformattedOutput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginUnformattedIO<Direction::Output>(
unitNumber, sourceFile, sourceLine);
}
-Cookie IODEF(BeginUnformattedInput)(
+Cookie IONAME(BeginUnformattedInput)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return BeginUnformattedIO<Direction::Input>(
unitNumber, sourceFile, sourceLine);
}
-Cookie IODEF(BeginOpenUnit)( // OPEN(without NEWUNIT=)
+Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
bool wasExtant{false};
@@ -383,7 +384,7 @@ Cookie IODEF(BeginOpenUnit)( // OPEN(without NEWUNIT=)
}
}
-Cookie IODEF(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
+Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
ExternalFileUnit &unit{
@@ -393,7 +394,7 @@ Cookie IODEF(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
sourceLine);
}
-Cookie IODEF(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,
+Cookie IONAME(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
@@ -409,12 +410,12 @@ Cookie IODEF(BeginWait)(ExternalUnit unitNumber, AsynchronousId id,
terminator, unitNumber, id == 0 ? IostatOk : IostatBadWaitUnit);
}
}
-Cookie IODEF(BeginWaitAll)(
+Cookie IONAME(BeginWaitAll)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
return IONAME(BeginWait)(unitNumber, 0 /*no ID=*/, sourceFile, sourceLine);
}
-Cookie IODEF(BeginClose)(
+Cookie IONAME(BeginClose)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
@@ -433,7 +434,7 @@ Cookie IODEF(BeginClose)(
}
}
-Cookie IODEF(BeginFlush)(
+Cookie IONAME(BeginFlush)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
@@ -451,7 +452,7 @@ Cookie IODEF(BeginFlush)(
}
}
-Cookie IODEF(BeginBackspace)(
+Cookie IONAME(BeginBackspace)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
@@ -469,7 +470,7 @@ Cookie IODEF(BeginBackspace)(
}
}
-Cookie IODEF(BeginEndfile)(
+Cookie IONAME(BeginEndfile)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Cookie errorCookie{nullptr};
@@ -489,7 +490,7 @@ Cookie IODEF(BeginEndfile)(
}
}
-Cookie IODEF(BeginRewind)(
+Cookie IONAME(BeginRewind)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
Cookie errorCookie{nullptr};
@@ -509,7 +510,7 @@ Cookie IODEF(BeginRewind)(
}
}
-Cookie IODEF(BeginInquireUnit)(
+Cookie IONAME(BeginInquireUnit)(
ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
if (ExternalFileUnit * unit{ExternalFileUnit::LookUp(unitNumber)}) {
@@ -529,14 +530,14 @@ Cookie IODEF(BeginInquireUnit)(
}
}
-Cookie IODEF(BeginInquireFile)(const char *path, std::size_t pathLength,
+Cookie IONAME(BeginInquireFile)(const char *path, std::size_t pathLength,
const char *sourceFile, int sourceLine) {
Terminator terminator{sourceFile, sourceLine};
auto trimmed{SaveDefaultCharacter(
path, TrimTrailingSpaces(path, pathLength), terminator)};
if (ExternalFileUnit *
unit{ExternalFileUnit::LookUp(
- trimmed.get(), Fortran::runtime::strlen(trimmed.get()))}) {
+ trimmed.get(), std::strlen(trimmed.get()))}) {
// INQUIRE(FILE=) to a connected unit
if (ChildIo * child{unit->GetChildIo()}) {
return &child->BeginIoStatement<InquireUnitState>(
@@ -553,7 +554,7 @@ Cookie IODEF(BeginInquireFile)(const char *path, std::size_t pathLength,
}
}
-Cookie IODEF(BeginInquireIoLength)(const char *sourceFile, int sourceLine) {
+Cookie IONAME(BeginInquireIoLength)(const char *sourceFile, int sourceLine) {
Terminator oom{sourceFile, sourceLine};
return &New<InquireIOLengthState>{oom}(sourceFile, sourceLine)
.release()
@@ -562,7 +563,7 @@ Cookie IODEF(BeginInquireIoLength)(const char *sourceFile, int sourceLine) {
// Control list items
-void IODEF(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
+void IONAME(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
bool hasEnd, bool hasEor, bool hasIoMsg) {
IoErrorHandler &handler{cookie->GetIoErrorHandler()};
if (hasIoStat) {
@@ -582,8 +583,8 @@ void IODEF(EnableHandlers)(Cookie cookie, bool hasIoStat, bool hasErr,
}
}
-static RT_API_ATTRS bool YesOrNo(const char *keyword, std::size_t length,
- const char *what, IoErrorHandler &handler) {
+static bool YesOrNo(const char *keyword, std::size_t length, const char *what,
+ IoErrorHandler &handler) {
static const char *keywords[]{"YES", "NO", nullptr};
switch (IdentifyValue(keyword, length, keywords)) {
case 0:
@@ -597,7 +598,8 @@ static RT_API_ATTRS bool YesOrNo(const char *keyword, std::size_t length,
}
}
-bool IODEF(SetAdvance)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetAdvance)(
+ Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
bool nonAdvancing{!YesOrNo(keyword, length, "ADVANCE", handler)};
@@ -614,7 +616,7 @@ bool IODEF(SetAdvance)(Cookie cookie, const char *keyword, std::size_t length) {
return !handler.InError();
}
-bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
static const char *keywords[]{"NULL", "ZERO", nullptr};
switch (IdentifyValue(keyword, length, keywords)) {
@@ -631,7 +633,8 @@ bool IODEF(SetBlank)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetDecimal)(
+ Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
static const char *keywords[]{"COMMA", "POINT", nullptr};
switch (IdentifyValue(keyword, length, keywords)) {
@@ -648,7 +651,7 @@ bool IODEF(SetDecimal)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
static const char *keywords[]{"APOSTROPHE", "QUOTE", "NONE", nullptr};
switch (IdentifyValue(keyword, length, keywords)) {
@@ -668,14 +671,14 @@ bool IODEF(SetDelim)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetPad)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
io.mutableModes().pad = YesOrNo(keyword, length, "PAD", handler);
return !handler.InError();
}
-bool IODEF(SetPos)(Cookie cookie, std::int64_t pos) {
+bool IONAME(SetPos)(Cookie cookie, std::int64_t pos) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (auto *unit{io.GetExternalFileUnit()}) {
@@ -686,7 +689,7 @@ bool IODEF(SetPos)(Cookie cookie, std::int64_t pos) {
return false;
}
-bool IODEF(SetRec)(Cookie cookie, std::int64_t rec) {
+bool IONAME(SetRec)(Cookie cookie, std::int64_t rec) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (auto *unit{io.GetExternalFileUnit()}) {
@@ -702,7 +705,7 @@ bool IODEF(SetRec)(Cookie cookie, std::int64_t rec) {
return true;
}
-bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
static const char *keywords[]{"UP", "DOWN", "ZERO", "NEAREST", "COMPATIBLE",
"PROCESSOR_DEFINED", nullptr};
@@ -732,7 +735,7 @@ bool IODEF(SetRound)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
static const char *keywords[]{
"PLUS", "SUPPRESS", "PROCESSOR_DEFINED", nullptr};
@@ -751,7 +754,7 @@ bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -787,7 +790,7 @@ bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
return true;
}
-bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -829,7 +832,7 @@ bool IODEF(SetAction)(Cookie cookie, const char *keyword, std::size_t length) {
return true;
}
-bool IODEF(SetAsynchronous)(
+bool IONAME(SetAsynchronous)(
Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
@@ -856,7 +859,7 @@ bool IODEF(SetAsynchronous)(
return !handler.InError();
}
-bool IODEF(SetCarriagecontrol)(
+bool IONAME(SetCarriagecontrol)(
Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
@@ -888,7 +891,8 @@ bool IODEF(SetCarriagecontrol)(
}
}
-bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetConvert)(
+ Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -912,7 +916,7 @@ bool IODEF(SetConvert)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
-bool IODEF(SetEncoding)(
+bool IONAME(SetEncoding)(
Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
@@ -944,7 +948,7 @@ bool IODEF(SetEncoding)(
return true;
}
-bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -972,7 +976,7 @@ bool IODEF(SetForm)(Cookie cookie, const char *keyword, std::size_t length) {
return true;
}
-bool IODEF(SetPosition)(
+bool IONAME(SetPosition)(
Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
@@ -1005,7 +1009,7 @@ bool IODEF(SetPosition)(
return true;
}
-bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {
+bool IONAME(SetRecl)(Cookie cookie, std::size_t n) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -1032,7 +1036,7 @@ bool IODEF(SetRecl)(Cookie cookie, std::size_t n) {
}
}
-bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
+bool IONAME(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
if (auto *open{io.get_if<OpenStatementState>()}) {
if (open->completedOperation()) {
@@ -1086,7 +1090,7 @@ bool IODEF(SetStatus)(Cookie cookie, const char *keyword, std::size_t length) {
"SetStatus() called when not in an OPEN or CLOSE statement");
}
-bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
+bool IONAME(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
IoStatementState &io{*cookie};
if (auto *open{io.get_if<OpenStatementState>()}) {
if (open->completedOperation()) {
@@ -1103,7 +1107,7 @@ bool IODEF(SetFile)(Cookie cookie, const char *path, std::size_t chars) {
return false;
}
-bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {
+bool IONAME(GetNewUnit)(Cookie cookie, int &unit, int kind) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
if (!open) {
@@ -1131,15 +1135,15 @@ bool IODEF(GetNewUnit)(Cookie cookie, int &unit, int kind) {
// Data transfers
-bool IODEF(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
+bool IONAME(OutputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
+bool IONAME(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(OutputInteger8)(Cookie cookie, std::int8_t n) {
+bool IONAME(OutputInteger8)(Cookie cookie, std::int8_t n) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputInteger8")) {
return false;
}
@@ -1150,7 +1154,7 @@ bool IODEF(OutputInteger8)(Cookie cookie, std::int8_t n) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(OutputInteger16)(Cookie cookie, std::int16_t n) {
+bool IONAME(OutputInteger16)(Cookie cookie, std::int16_t n) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputInteger16")) {
return false;
}
@@ -1161,6 +1165,7 @@ bool IODEF(OutputInteger16)(Cookie cookie, std::int16_t n) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
+RT_EXT_API_GROUP_BEGIN
bool IODEF(OutputInteger32)(Cookie cookie, std::int32_t n) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputInteger32")) {
return false;
@@ -1171,8 +1176,9 @@ bool IODEF(OutputInteger32)(Cookie cookie, std::int32_t n) {
TypeCategory::Integer, 4, reinterpret_cast<void *>(&n), 0);
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
+RT_EXT_API_GROUP_END
-bool IODEF(OutputInteger64)(Cookie cookie, std::int64_t n) {
+bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputInteger64")) {
return false;
}
@@ -1184,7 +1190,7 @@ bool IODEF(OutputInteger64)(Cookie cookie, std::int64_t n) {
}
#ifdef __SIZEOF_INT128__
-bool IODEF(OutputInteger128)(Cookie cookie, common::int128_t n) {
+bool IONAME(OutputInteger128)(Cookie cookie, common::int128_t n) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputInteger128")) {
return false;
}
@@ -1196,7 +1202,7 @@ bool IODEF(OutputInteger128)(Cookie cookie, common::int128_t n) {
}
#endif
-bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
+bool IONAME(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputInteger")) {
return false;
}
@@ -1207,7 +1213,7 @@ bool IODEF(InputInteger)(Cookie cookie, std::int64_t &n, int kind) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(OutputReal32)(Cookie cookie, float x) {
+bool IONAME(OutputReal32)(Cookie cookie, float x) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputReal32")) {
return false;
}
@@ -1217,7 +1223,7 @@ bool IODEF(OutputReal32)(Cookie cookie, float x) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(OutputReal64)(Cookie cookie, double x) {
+bool IONAME(OutputReal64)(Cookie cookie, double x) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputReal64")) {
return false;
}
@@ -1227,7 +1233,7 @@ bool IODEF(OutputReal64)(Cookie cookie, double x) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(InputReal32)(Cookie cookie, float &x) {
+bool IONAME(InputReal32)(Cookie cookie, float &x) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal32")) {
return false;
}
@@ -1237,7 +1243,7 @@ bool IODEF(InputReal32)(Cookie cookie, float &x) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(InputReal64)(Cookie cookie, double &x) {
+bool IONAME(InputReal64)(Cookie cookie, double &x) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputReal64")) {
return false;
}
@@ -1247,7 +1253,7 @@ bool IODEF(InputReal64)(Cookie cookie, double &x) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(OutputComplex32)(Cookie cookie, float r, float i) {
+bool IONAME(OutputComplex32)(Cookie cookie, float r, float i) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputComplex32")) {
return false;
}
@@ -1259,7 +1265,7 @@ bool IODEF(OutputComplex32)(Cookie cookie, float r, float i) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(OutputComplex64)(Cookie cookie, double r, double i) {
+bool IONAME(OutputComplex64)(Cookie cookie, double r, double i) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputComplex64")) {
return false;
}
@@ -1271,7 +1277,7 @@ bool IODEF(OutputComplex64)(Cookie cookie, double r, double i) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {
+bool IONAME(InputComplex32)(Cookie cookie, float z[2]) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex32")) {
return false;
}
@@ -1282,7 +1288,7 @@ bool IODEF(InputComplex32)(Cookie cookie, float z[2]) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {
+bool IONAME(InputComplex64)(Cookie cookie, double z[2]) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputComplex64")) {
return false;
}
@@ -1293,7 +1299,7 @@ bool IODEF(InputComplex64)(Cookie cookie, double z[2]) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(OutputCharacter)(
+bool IONAME(OutputCharacter)(
Cookie cookie, const char *x, std::size_t length, int kind) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputCharacter")) {
return false;
@@ -1305,11 +1311,11 @@ bool IODEF(OutputCharacter)(
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(OutputAscii)(Cookie cookie, const char *x, std::size_t length) {
+bool IONAME(OutputAscii)(Cookie cookie, const char *x, std::size_t length) {
return IONAME(OutputCharacter(cookie, x, length, 1));
}
-bool IODEF(InputCharacter)(
+bool IONAME(InputCharacter)(
Cookie cookie, char *x, std::size_t length, int kind) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputCharacter")) {
return false;
@@ -1320,11 +1326,11 @@ bool IODEF(InputCharacter)(
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(InputAscii)(Cookie cookie, char *x, std::size_t length) {
+bool IONAME(InputAscii)(Cookie cookie, char *x, std::size_t length) {
return IONAME(InputCharacter)(cookie, x, length, 1);
}
-bool IODEF(OutputLogical)(Cookie cookie, bool truth) {
+bool IONAME(OutputLogical)(Cookie cookie, bool truth) {
if (!cookie->CheckFormattedStmtType<Direction::Output>("OutputLogical")) {
return false;
}
@@ -1335,7 +1341,7 @@ bool IODEF(OutputLogical)(Cookie cookie, bool truth) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor);
}
-bool IODEF(InputLogical)(Cookie cookie, bool &truth) {
+bool IONAME(InputLogical)(Cookie cookie, bool &truth) {
if (!cookie->CheckFormattedStmtType<Direction::Input>("InputLogical")) {
return false;
}
@@ -1346,17 +1352,17 @@ bool IODEF(InputLogical)(Cookie cookie, bool &truth) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
}
-bool IODEF(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
+bool IONAME(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
const NonTbpDefinedIoTable *table) {
return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
}
-bool IODEF(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
+bool IONAME(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
const NonTbpDefinedIoTable *table) {
return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
}
-std::size_t IODEF(GetSize)(Cookie cookie) {
+std::size_t IONAME(GetSize)(Cookie cookie) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (!handler.InError()) {
@@ -1373,7 +1379,7 @@ std::size_t IODEF(GetSize)(Cookie cookie) {
return 0;
}
-std::size_t IODEF(GetIoLength)(Cookie cookie) {
+std::size_t IONAME(GetIoLength)(Cookie cookie) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (!handler.InError()) {
@@ -1389,7 +1395,7 @@ std::size_t IODEF(GetIoLength)(Cookie cookie) {
return 0;
}
-void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
+void IONAME(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (!handler.InError()) {
@@ -1400,7 +1406,7 @@ void IODEF(GetIoMsg)(Cookie cookie, char *msg, std::size_t length) {
}
}
-AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {
+AsynchronousId IONAME(GetAsynchronousId)(Cookie cookie) {
IoStatementState &io{*cookie};
IoErrorHandler &handler{io.GetIoErrorHandler()};
if (auto *ext{io.get_if<ExternalIoStatementBase>()}) {
@@ -1413,24 +1419,24 @@ AsynchronousId IODEF(GetAsynchronousId)(Cookie cookie) {
return 0;
}
-bool IODEF(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,
+bool IONAME(InquireCharacter)(Cookie cookie, InquiryKeywordHash inquiry,
char *result, std::size_t length) {
IoStatementState &io{*cookie};
return io.Inquire(inquiry, result, length);
}
-bool IODEF(InquireLogical)(
+bool IONAME(InquireLogical)(
Cookie cookie, InquiryKeywordHash inquiry, bool &result) {
IoStatementState &io{*cookie};
return io.Inquire(inquiry, result);
}
-bool IODEF(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
+bool IONAME(InquirePendingId)(Cookie cookie, AsynchronousId id, bool &result) {
IoStatementState &io{*cookie};
return io.Inquire(HashInquiryKeyword("PENDING"), id, result);
}
-bool IODEF(InquireInteger64)(
+bool IONAME(InquireInteger64)(
Cookie cookie, InquiryKeywordHash inquiry, std::int64_t &result, int kind) {
IoStatementState &io{*cookie};
std::int64_t n{0}; // safe "undefined" value
@@ -1446,15 +1452,17 @@ bool IODEF(InquireInteger64)(
return false;
}
+RT_EXT_API_GROUP_BEGIN
enum Iostat IODEF(EndIoStatement)(Cookie cookie) {
IoStatementState &io{*cookie};
return static_cast<enum Iostat>(io.EndIoStatement());
}
+RT_EXT_API_GROUP_END
template <typename INT>
-static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,
- bool handleError, char *ioMsg, std::size_t ioMsgLength,
- const char *sourceFile, int sourceLine) {
+static enum Iostat CheckUnitNumberInRangeImpl(INT unit, bool handleError,
+ char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,
+ int sourceLine) {
static_assert(sizeof(INT) >= sizeof(ExternalUnit),
"only intended to be used when the INT to ExternalUnit conversion is "
"narrowing");
@@ -1486,15 +1494,15 @@ static RT_API_ATTRS enum Iostat CheckUnitNumberInRangeImpl(INT unit,
return IostatOk;
}
-enum Iostat IODEF(CheckUnitNumberInRange64)(std::int64_t unit, bool handleError,
- char *ioMsg, std::size_t ioMsgLength, const char *sourceFile,
- int sourceLine) {
+enum Iostat IONAME(CheckUnitNumberInRange64)(std::int64_t unit,
+ bool handleError, char *ioMsg, std::size_t ioMsgLength,
+ const char *sourceFile, int sourceLine) {
return CheckUnitNumberInRangeImpl(
unit, handleError, ioMsg, ioMsgLength, sourceFile, sourceLine);
}
#ifdef __SIZEOF_INT128__
-enum Iostat IODEF(CheckUnitNumberInRange128)(common::int128_t unit,
+enum Iostat IONAME(CheckUnitNumberInRange128)(common::int128_t unit,
bool handleError, char *ioMsg, std::size_t ioMsgLength,
const char *sourceFile, int sourceLine) {
return CheckUnitNumberInRangeImpl(
@@ -1517,5 +1525,3 @@ void std::__libcpp_verbose_abort(char const *format, ...) {
std::abort();
}
#endif
-
-RT_EXT_API_GROUP_END
diff --git a/flang/runtime/io-error.cpp b/flang/runtime/io-error.cpp
index 7a90966..b006b82f 100644
--- a/flang/runtime/io-error.cpp
+++ b/flang/runtime/io-error.cpp
@@ -109,6 +109,8 @@ void IoErrorHandler::SignalPendingError() {
SignalError(error);
}
+RT_OFFLOAD_API_GROUP_END
+
void IoErrorHandler::SignalErrno() { SignalError(errno); }
bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
@@ -125,10 +127,7 @@ bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
// in LLVM v9.0.1 with inadequate modification for Fortran,
// since rectified.
bool ok{false};
-#if defined(RT_DEVICE_COMPILATION)
- // strerror_r is not available on device.
- msg = "errno description is not available on device";
-#elif HAVE_STRERROR_R
+#if HAVE_STRERROR_R
// strerror_r is thread-safe.
#if defined(__GLIBC__) && defined(_GNU_SOURCE)
// glibc defines its own incompatible version of strerror_r
@@ -158,6 +157,4 @@ bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
return false;
}
}
-
-RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime::io
diff --git a/flang/runtime/io-error.h b/flang/runtime/io-error.h
index 426573e..0fe11c9 100644
--- a/flang/runtime/io-error.h
+++ b/flang/runtime/io-error.h
@@ -61,7 +61,7 @@ public:
RT_API_ATTRS void SignalPendingError();
RT_API_ATTRS int GetIoStat() const { return ioStat_; }
- RT_API_ATTRS bool GetIoMsg(char *, std::size_t);
+ bool GetIoMsg(char *, std::size_t);
private:
enum Flag : std::uint8_t {
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index b9eed21..b502d41 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -17,20 +17,16 @@
namespace Fortran::runtime::io {
-RT_VAR_GROUP_BEGIN
// Max size of a group, symbol or component identifier that can appear in
// NAMELIST input, plus a byte for NUL termination.
-static constexpr RT_CONST_VAR_ATTRS std::size_t nameBufferSize{201};
-RT_VAR_GROUP_END
+static constexpr std::size_t nameBufferSize{201};
-RT_OFFLOAD_API_GROUP_BEGIN
-
-static inline RT_API_ATTRS char32_t GetComma(IoStatementState &io) {
+static inline char32_t GetComma(IoStatementState &io) {
return io.mutableModes().editingFlags & decimalComma ? char32_t{';'}
: char32_t{','};
}
-bool IODEF(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
+bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
IoStatementState &io{*cookie};
io.CheckFormattedStmtType<Direction::Output>("OutputNamelist");
io.mutableModes().inNamelist = true;
@@ -44,8 +40,7 @@ bool IODEF(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
if ((connection.NeedAdvance(prefixLen) &&
!(io.AdvanceRecord() && EmitAscii(io, " ", 1))) ||
!EmitAscii(io, prefix, prefixLen) ||
- (connection.NeedAdvance(
- Fortran::runtime::strlen(str) + (suffix != ' ')) &&
+ (connection.NeedAdvance(std::strlen(str) + (suffix != ' ')) &&
!(io.AdvanceRecord() && EmitAscii(io, " ", 1)))) {
return false;
}
@@ -89,20 +84,20 @@ bool IODEF(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
return EmitUpperCase("/", 1, "", ' ');
}
-static constexpr RT_API_ATTRS bool IsLegalIdStart(char32_t ch) {
+static constexpr bool IsLegalIdStart(char32_t ch) {
return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' ||
ch == '@';
}
-static constexpr RT_API_ATTRS bool IsLegalIdChar(char32_t ch) {
+static constexpr bool IsLegalIdChar(char32_t ch) {
return IsLegalIdStart(ch) || (ch >= '0' && ch <= '9');
}
-static constexpr RT_API_ATTRS char NormalizeIdChar(char32_t ch) {
+static constexpr char NormalizeIdChar(char32_t ch) {
return static_cast<char>(ch >= 'A' && ch <= 'Z' ? ch - 'A' + 'a' : ch);
}
-static RT_API_ATTRS bool GetLowerCaseName(
+static bool GetLowerCaseName(
IoStatementState &io, char buffer[], std::size_t maxLength) {
std::size_t byteLength{0};
if (auto ch{io.GetNextNonBlank(byteLength)}) {
@@ -124,7 +119,7 @@ static RT_API_ATTRS bool GetLowerCaseName(
return false;
}
-static RT_API_ATTRS Fortran::common::optional<SubscriptValue> GetSubscriptValue(
+static Fortran::common::optional<SubscriptValue> GetSubscriptValue(
IoStatementState &io) {
Fortran::common::optional<SubscriptValue> value;
std::size_t byteCount{0};
@@ -157,8 +152,8 @@ static RT_API_ATTRS Fortran::common::optional<SubscriptValue> GetSubscriptValue(
return value;
}
-static RT_API_ATTRS bool HandleSubscripts(IoStatementState &io,
- Descriptor &desc, const Descriptor &source, const char *name) {
+static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
+ const Descriptor &source, const char *name) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
// Allow for blanks in subscripts; they're nonstandard, but not
// ambiguous within the parentheses.
@@ -257,7 +252,7 @@ static RT_API_ATTRS bool HandleSubscripts(IoStatementState &io,
return false;
}
-static RT_API_ATTRS void StorageSequenceExtension(
+static void StorageSequenceExtension(
Descriptor &desc, const Descriptor &source) {
// Support the near-universal extension of NAMELIST input into a
// designatable storage sequence identified by its initial scalar array
@@ -279,7 +274,7 @@ static RT_API_ATTRS void StorageSequenceExtension(
}
}
-static RT_API_ATTRS bool HandleSubstring(
+static bool HandleSubstring(
IoStatementState &io, Descriptor &desc, const char *name) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
auto pair{desc.type().GetCategoryAndKind()};
@@ -340,7 +335,7 @@ static RT_API_ATTRS bool HandleSubstring(
return false;
}
-static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
+static bool HandleComponent(IoStatementState &io, Descriptor &desc,
const Descriptor &source, const char *name) {
IoErrorHandler &handler{io.GetIoErrorHandler()};
char compName[nameBufferSize];
@@ -349,8 +344,7 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
if (const typeInfo::DerivedType *
type{addendum ? addendum->derivedType() : nullptr}) {
if (const typeInfo::Component *
- comp{type->FindDataComponent(
- compName, Fortran::runtime::strlen(compName))}) {
+ comp{type->FindDataComponent(compName, std::strlen(compName))}) {
bool createdDesc{false};
if (comp->rank() > 0 && source.rank() > 0) {
// If base and component are both arrays, the component name
@@ -414,7 +408,7 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
// Advance to the terminal '/' of a namelist group or leading '&'/'$'
// of the next.
-static RT_API_ATTRS void SkipNamelistGroup(IoStatementState &io) {
+static void SkipNamelistGroup(IoStatementState &io) {
std::size_t byteCount{0};
while (auto ch{io.GetNextNonBlank(byteCount)}) {
io.HandleRelativePosition(byteCount);
@@ -437,7 +431,7 @@ static RT_API_ATTRS void SkipNamelistGroup(IoStatementState &io) {
}
}
-bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
+bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
IoStatementState &io{*cookie};
io.CheckFormattedStmtType<Direction::Input>("InputNamelist");
io.mutableModes().inNamelist = true;
@@ -476,7 +470,7 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
handler.SignalError("NAMELIST input group has no name");
return false;
}
- if (Fortran::runtime::strcmp(group.groupName, name) == 0) {
+ if (std::strcmp(group.groupName, name) == 0) {
break; // found it
}
SkipNamelistGroup(io);
@@ -495,7 +489,7 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
}
std::size_t itemIndex{0};
for (; itemIndex < group.items; ++itemIndex) {
- if (Fortran::runtime::strcmp(name, group.item[itemIndex].name) == 0) {
+ if (std::strcmp(name, group.item[itemIndex].name) == 0) {
break;
}
}
@@ -596,6 +590,8 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
return true;
}
+RT_OFFLOAD_API_GROUP_BEGIN
+
bool IsNamelistNameOrSlash(IoStatementState &io) {
if (auto *listInput{
io.get_if<ListDirectedStatementState<Direction::Input>>()}) {
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/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/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;