maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Drill down to a working implementation of the APIs for an 

internal formatted WRITE with no data list items.

Improve argument names in io-api.h

Bump up error number to not conflict with errno values

Use Fortran::runtime::io namespace

Add wrapper around malloc/free, allow use of unique_ptr with wrapper

IoErrorHandler

Revamp FormatContext, use virtual member functions

Update comment syntax, allow for old C

12HHELLO, WORLD

Remove files not yet ready for review

Use std::forward

Fix gcc build warnings

Fix redundant filename in license boilerplate

Reduce runtime dependence on compiler binary libraries, fixing shared lib builds

Original-commit: flang-compiler/f18@839a91f1d6
Reviewed-on: https://github.com/flang-compiler/f18/pull/946
This commit is contained in:
peter klausler 2020-01-16 13:51:25 -08:00
parent 6149ff9bc9
commit 491122d1cd
22 changed files with 687 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
flang/include/flang/ISO_Fortran_binding.h
View File

@ -30,8 +30,9 @@ inline namespace Fortran_2018 {
#define CFI_MAX_RANK 15
typedef unsigned char CFI_rank_t;
// This type is probably larger than a default Fortran INTEGER
// and should be used for all array indexing and loop bound calculations.
/* This type is probably larger than a default Fortran INTEGER
* and should be used for all array indexing and loop bound calculations.
*/
typedef ptrdiff_t CFI_index_t;
typedef unsigned char CFI_attribute_t;

7
flang/runtime/CMakeLists.txt
View File

@ -11,7 +11,11 @@ add_library(FortranRuntime
derived-type.cc
descriptor.cc
format.cc
io-api.cc
io-error.cc
io-stmt.cc
main.cc
memory.cc
stop.cc
terminator.cc
transformational.cc
@ -19,5 +23,6 @@ add_library(FortranRuntime
)
target_link_libraries(FortranRuntime
FortranEvaluate
FortranCommon
FortranDecimal
)

6
flang/runtime/entry-names.h
View File

@ -16,7 +16,7 @@
// runtime library must change in some way that breaks backward compatibility.
#ifndef RTNAME
#define PREFIX _Fortran
#define REVISION A
#define RTNAME(name) PREFIX##REVISION##name
#define NAME_WITH_PREFIX_AND_REVISION(prefix, revision, name) \
prefix##revision##name
#define RTNAME(name) NAME_WITH_PREFIX_AND_REVISION(_Fortran, A, name)
#endif

173
flang/runtime/format.cc
View File

@ -7,23 +7,43 @@
//===----------------------------------------------------------------------===//
#include "format.h"
#include "io-stmt.h"
#include "../lib/common/format.h"
#include "../lib/decimal/decimal.h"
#include <limits>
namespace Fortran::runtime {
namespace Fortran::runtime::io {
// Default FormatContext virtual member functions
void FormatContext::Emit(const char *, std::size_t) {
Crash("Cannot emit data from this FORMAT string");
}
void FormatContext::Emit(const char16_t *, std::size_t) {
Crash("Cannot emit data from this FORMAT string");
}
void FormatContext::Emit(const char32_t *, std::size_t) {
Crash("Cannot emit data from this FORMAT string");
}
void FormatContext::HandleSlash(int) {
Crash("A / control edit descriptor may not appear in this FORMAT string");
}
void FormatContext::HandleAbsolutePosition(int) {
Crash("A Tn control edit descriptor may not appear in this FORMAT string");
}
void FormatContext::HandleRelativePosition(int) {
Crash("An nX, TLn, or TRn control edit descriptor may not appear in this "
"FORMAT string");
}
template<typename CHAR>
FormatControl<CHAR>::FormatControl(FormatContext &context, const CHAR *format,
std::size_t formatLength, const MutableModes &modes, int maxHeight)
: context_{context}, modes_{modes}, maxHeight_{static_cast<std::uint8_t>(
maxHeight)},
format_{format}, formatLength_{static_cast<int>(formatLength)} {
FormatControl<CHAR>::FormatControl(Terminator &terminator, const CHAR *format,
std::size_t formatLength, int maxHeight)
: maxHeight_{static_cast<std::uint8_t>(maxHeight)}, format_{format},
formatLength_{static_cast<int>(formatLength)} {
// The additional two items are for the whole string and a
// repeated non-parenthesized edit descriptor.
if (maxHeight > std::numeric_limits<std::int8_t>::max()) {
context_.terminator.Crash(
"internal Fortran runtime error: maxHeight %d", maxHeight);
terminator.Crash("internal Fortran runtime error: maxHeight %d", maxHeight);
}
stack_[0].start = offset_;
stack_[0].remaining = Iteration::unlimited; // 13.4(8)
@ -43,38 +63,23 @@ int FormatControl<CHAR>::GetMaxParenthesisNesting(
return validator.maxNesting();
}
static void HandleCharacterLiteral(
FormatContext &context, const char *str, std::size_t chars) {
if (context.handleCharacterLiteral1) {
context.handleCharacterLiteral1(str, chars);
}
}
static void HandleCharacterLiteral(
FormatContext &context, const char16_t *str, std::size_t chars) {
if (context.handleCharacterLiteral2) {
context.handleCharacterLiteral2(str, chars);
}
}
static void HandleCharacterLiteral(
FormatContext &context, const char32_t *str, std::size_t chars) {
if (context.handleCharacterLiteral4) {
context.handleCharacterLiteral4(str, chars);
}
}
template<typename CHAR> int FormatControl<CHAR>::GetIntField(CHAR firstCh) {
template<typename CHAR>
int FormatControl<CHAR>::GetIntField(Terminator &terminator, CHAR firstCh) {
CHAR ch{firstCh ? firstCh : PeekNext()};
if (ch < '0' || ch > '9') {
context_.terminator.Crash(
if (ch != '-' && ch != '+' && (ch < '0' || ch > '9')) {
terminator.Crash(
"Invalid FORMAT: integer expected at '%c'", static_cast<char>(ch));
}
int result{0};
bool negate{ch == '-'};
if (negate) {
firstCh = '\0';
ch = PeekNext();
}
while (ch >= '0' && ch <= '9') {
if (result >
std::numeric_limits<int>::max() / 10 - (static_cast<int>(ch) - '0')) {
context_.terminator.Crash("FORMAT integer field out of range");
terminator.Crash("FORMAT integer field out of range");
}
result = 10 * result + ch - '0';
if (firstCh) {
@ -84,11 +89,15 @@ template<typename CHAR> int FormatControl<CHAR>::GetIntField(CHAR firstCh) {
}
ch = PeekNext();
}
if (negate && (result *= -1) > 0) {
terminator.Crash("FORMAT integer field out of range");
}
return result;
}
static void HandleControl(MutableModes &modes, std::uint16_t &scale,
FormatContext &context, char ch, char next, int n) {
static void HandleControl(
FormatContext &context, std::uint16_t &scale, char ch, char next, int n) {
MutableModes &modes{context.mutableModes()};
switch (ch) {
case 'B':
if (next == 'Z') {
@ -130,9 +139,7 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
break;
case 'X':
if (!next) {
if (context.handleRelativePosition) {
context.handleRelativePosition(n);
}
context.HandleRelativePosition(n);
return;
}
break;
@ -148,25 +155,20 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
break;
case 'T': {
if (!next) { // Tn
if (context.handleAbsolutePosition) {
context.handleAbsolutePosition(n);
}
context.HandleAbsolutePosition(n);
return;
}
if (next == 'L' || next == 'R') { // TLn & TRn
if (context.handleRelativePosition) {
context.handleRelativePosition(next == 'L' ? -n : n);
}
context.HandleRelativePosition(next == 'L' ? -n : n);
return;
}
} break;
default: break;
}
if (next) {
context.terminator.Crash(
"Unknown '%c%c' edit descriptor in FORMAT", ch, next);
context.Crash("Unknown '%c%c' edit descriptor in FORMAT", ch, next);
} else {
context.terminator.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
context.Crash("Unknown '%c' edit descriptor in FORMAT", ch);
}
}
@ -174,35 +176,34 @@ static void HandleControl(MutableModes &modes, std::uint16_t &scale,
// Handles all repetition counts and control edit descriptors.
// Generally assumes that the format string has survived the common
// format validator gauntlet.
template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
template<typename CHAR>
int FormatControl<CHAR>::CueUpNextDataEdit(FormatContext &context, bool stop) {
int unlimitedLoopCheck{-1};
while (true) {
std::optional<int> repeat;
bool unlimited{false};
CHAR ch{Capitalize(GetNextChar())};
CHAR ch{Capitalize(GetNextChar(context))};
while (ch == ',' || ch == ':') {
// Skip commas, and don't complain if they're missing; the format
// validator does that.
if (stop && ch == ':') {
return 0;
}
ch = Capitalize(GetNextChar());
ch = Capitalize(GetNextChar(context));
}
if (ch >= '0' && ch <= '9') { // repeat count
repeat = GetIntField(ch);
ch = GetNextChar();
if (ch == '-' || ch == '+' || (ch >= '0' && ch <= '9')) {
repeat = GetIntField(context, ch);
ch = GetNextChar(context);
} else if (ch == '*') {
unlimited = true;
ch = GetNextChar();
ch = GetNextChar(context);
if (ch != '(') {
context_.terminator.Crash(
"Invalid FORMAT: '*' may appear only before '('");
context.Crash("Invalid FORMAT: '*' may appear only before '('");
}
}
if (ch == '(') {
if (height_ >= maxHeight_) {
context_.terminator.Crash(
"FORMAT stack overflow: too many nested parentheses");
context.Crash("FORMAT stack overflow: too many nested parentheses");
}
stack_[height_].start = offset_ - 1; // the '('
if (unlimited || height_ == 0) {
@ -218,15 +219,18 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
}
++height_;
} else if (height_ == 0) {
context_.terminator.Crash("FORMAT lacks initial '('");
context.Crash("FORMAT lacks initial '('");
} else if (ch == ')') {
if (height_ == 1 && stop) {
return 0; // end of FORMAT and no data items remain
if (height_ == 1) {
if (stop) {
return 0; // end of FORMAT and no data items remain
}
context.HandleSlash(); // implied / before rightmost )
}
if (stack_[height_ - 1].remaining == Iteration::unlimited) {
offset_ = stack_[height_ - 1].start + 1;
if (offset_ == unlimitedLoopCheck) {
context_.terminator.Crash(
context.Crash(
"Unlimited repetition in FORMAT lacks data edit descriptors");
}
} else if (stack_[height_ - 1].remaining-- > 0) {
@ -242,8 +246,7 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
++offset_;
}
if (offset_ >= formatLength_) {
context_.terminator.Crash(
"FORMAT missing closing quote on character literal");
context.Crash("FORMAT missing closing quote on character literal");
}
++offset_;
std::size_t chars{
@ -255,14 +258,13 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
} else {
--chars;
}
HandleCharacterLiteral(context_, format_ + start, chars);
context.Emit(format_ + start, chars);
} else if (ch == 'H') {
// 9HHOLLERITH
if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
context_.terminator.Crash("Invalid width on Hollerith in FORMAT");
context.Crash("Invalid width on Hollerith in FORMAT");
}
HandleCharacterLiteral(
context_, format_ + offset_, static_cast<std::size_t>(*repeat));
context.Emit(format_ + offset_, static_cast<std::size_t>(*repeat));
offset_ += *repeat;
} else if (ch >= 'A' && ch <= 'Z') {
int start{offset_ - 1};
@ -276,35 +278,33 @@ template<typename CHAR> int FormatControl<CHAR>::CueUpNextDataEdit(bool stop) {
ch == 'F' || ch == 'D' || ch == 'G'))) {
// Data edit descriptor found
offset_ = start;
return repeat ? *repeat : 1;
return repeat && *repeat > 0 ? *repeat : 1;
} else {
// Control edit descriptor
if (ch == 'T') { // Tn, TLn, TRn
repeat = GetIntField();
repeat = GetIntField(context);
}
HandleControl(modes_, scale_, context_, static_cast<char>(ch),
static_cast<char>(next), repeat ? *repeat : 1);
HandleControl(context, scale_, static_cast<char>(ch),
static_cast<char>(next), repeat && *repeat > 0 ? *repeat : 1);
}
} else if (ch == '/') {
if (context_.handleSlash) {
context_.handleSlash();
}
context.HandleSlash(repeat && *repeat > 0 ? *repeat : 1);
} else {
context_.terminator.Crash(
"Invalid character '%c' in FORMAT", static_cast<char>(ch));
context.Crash("Invalid character '%c' in FORMAT", static_cast<char>(ch));
}
}
}
template<typename CHAR>
void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
void FormatControl<CHAR>::GetNext(
FormatContext &context, DataEdit &edit, int maxRepeat) {
// TODO: DT editing
// Return the next data edit descriptor
int repeat{CueUpNextDataEdit()};
int repeat{CueUpNextDataEdit(context)};
auto start{offset_};
edit.descriptor = static_cast<char>(Capitalize(GetNextChar()));
edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
if (edit.descriptor == 'E') {
edit.variation = static_cast<char>(Capitalize(PeekNext()));
if (edit.variation >= 'A' && edit.variation <= 'Z') {
@ -316,15 +316,15 @@ void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
edit.variation = '\0';
}
edit.width = GetIntField();
edit.modes = modes_;
edit.width = GetIntField(context);
edit.modes = context.mutableModes();
if (PeekNext() == '.') {
++offset_;
edit.digits = GetIntField();
edit.digits = GetIntField(context);
CHAR ch{PeekNext()};
if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
++offset_;
edit.expoDigits = GetIntField();
edit.expoDigits = GetIntField(context);
} else {
edit.expoDigits.reset();
}
@ -355,8 +355,9 @@ void FormatControl<CHAR>::GetNext(DataEdit &edit, int maxRepeat) {
}
}
template<typename CHAR> void FormatControl<CHAR>::FinishOutput() {
CueUpNextDataEdit(true /* stop at colon or end of FORMAT */);
template<typename CHAR>
void FormatControl<CHAR>::FinishOutput(FormatContext &context) {
CueUpNextDataEdit(context, true /* stop at colon or end of FORMAT */);
}
template class FormatControl<char>;

44
flang/runtime/format.h
View File

@ -16,7 +16,7 @@
#include <cinttypes>
#include <optional>
namespace Fortran::runtime {
namespace Fortran::runtime::io {
enum EditingFlags {
blankZero = 1, // BLANK=ZERO or BZ edit
@ -27,6 +27,8 @@ enum EditingFlags {
struct MutableModes {
std::uint8_t editingFlags{0}; // BN, DP, SS
common::RoundingMode roundingMode{common::RoundingMode::TiesToEven}; // RN
bool pad{false}; // PAD= mode on READ
char delim{'\0'}; // DELIM=
};
// A single edit descriptor extracted from a FORMAT
@ -40,14 +42,20 @@ struct DataEdit {
int repeat{1};
};
struct FormatContext {
Terminator &terminator;
void (*handleCharacterLiteral1)(const char *, std::size_t){nullptr};
void (*handleCharacterLiteral2)(const char16_t *, std::size_t){nullptr};
void (*handleCharacterLiteral4)(const char32_t *, std::size_t){nullptr};
void (*handleSlash)(){nullptr};
void (*handleAbsolutePosition)(int){nullptr}; // Tn
void (*handleRelativePosition)(int){nullptr}; // nX, TRn, TLn (negated)
class FormatContext : virtual public Terminator {
public:
FormatContext() {}
explicit FormatContext(const MutableModes &modes) : mutableModes_{modes} {}
virtual void Emit(const char *, std::size_t);
virtual void Emit(const char16_t *, std::size_t);
virtual void Emit(const char32_t *, std::size_t);
virtual void HandleSlash(int = 1);
virtual void HandleRelativePosition(int);
virtual void HandleAbsolutePosition(int);
MutableModes &mutableModes() { return mutableModes_; }
private:
MutableModes mutableModes_;
};
// Generates a sequence of DataEdits from a FORMAT statement or
@ -55,8 +63,8 @@ struct FormatContext {
// Errors are fatal. See clause 13.4 in Fortran 2018 for background.
template<typename CHAR = char> class FormatControl {
public:
FormatControl(FormatContext &, const CHAR *format, std::size_t formatLength,
const MutableModes &initialModes, int maxHeight = maxMaxHeight);
FormatControl(Terminator &, const CHAR *format, std::size_t formatLength,
int maxHeight = maxMaxHeight);
// Determines the max parenthesis nesting level by scanning and validating
// the FORMAT string.
@ -71,10 +79,10 @@ public:
// Extracts the next data edit descriptor, handling control edit descriptors
// along the way.
void GetNext(DataEdit &, int maxRepeat = 1);
void GetNext(FormatContext &, DataEdit &, int maxRepeat = 1);
// Emit any remaining character literals after the last data item.
void FinishOutput();
void FinishOutput(FormatContext &);
private:
static constexpr std::uint8_t maxMaxHeight{100};
@ -94,21 +102,21 @@ private:
SkipBlanks();
return offset_ < formatLength_ ? format_[offset_] : '\0';
}
CHAR GetNextChar() {
CHAR GetNextChar(Terminator &terminator) {
SkipBlanks();
if (offset_ >= formatLength_) {
context_.terminator.Crash("FORMAT missing at least one ')'");
terminator.Crash("FORMAT missing at least one ')'");
}
return format_[offset_++];
}
int GetIntField(CHAR firstCh = '\0');
int GetIntField(Terminator &, CHAR firstCh = '\0');
// Advances through the FORMAT until the next data edit
// descriptor has been found; handles control edit descriptors
// along the way. Returns the repeat count that appeared
// before the descriptor (defaulting to 1) and leaves offset_
// pointing to the data edit.
int CueUpNextDataEdit(bool stop = false);
int CueUpNextDataEdit(FormatContext &, bool stop = false);
static constexpr CHAR Capitalize(CHAR ch) {
return ch >= 'a' && ch <= 'z' ? ch + 'A' - 'a' : ch;
@ -117,8 +125,6 @@ private:
// Data members are arranged and typed so as to reduce size.
// This structure may be allocated in stack space loaned by the
// user program for internal I/O.
FormatContext &context_;
MutableModes modes_;
std::uint16_t scale_{0}; // kP
const std::uint8_t maxHeight_{maxMaxHeight};
std::uint8_t height_{0};

31
flang/runtime/io-api.cc Normal file
View File

@ -0,0 +1,31 @@
//===-- runtime/io.cc -------------------------------------------*- 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
//
//===----------------------------------------------------------------------===//
#include "io-api.h"
#include "format.h"
#include "io-stmt.h"
#include "memory.h"
#include "terminator.h"
#include <cstdlib>
#include <memory>
namespace Fortran::runtime::io {
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
void ** /*scratchArea*/, std::size_t /*scratchBytes*/,
const char *sourceFile, int sourceLine) {
Terminator oom{sourceFile, sourceLine};
return &New<InternalFormattedIoStatementState<false>>{}(oom, internal,
internalLength, format, formatLength, sourceFile, sourceLine);
}
enum Iostat IONAME(EndIoStatement)(Cookie io) {
return static_cast<enum Iostat>(io->EndIoStatement());
}
}

61
flang/runtime/io-api.h
View File

@ -19,7 +19,7 @@
namespace Fortran::runtime {
class Descriptor;
class NamelistGroup;
};
}
namespace Fortran::runtime::io {
@ -60,30 +60,32 @@ Cookie IONAME(BeginInternalArrayListInput)(const Descriptor &,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInternalArrayFormattedOutput)(const Descriptor &,
const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
Cookie IONAME(BeginInternalArrayFormattedInput)(const Descriptor &,
const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
const char *format, std::size_t formatLength, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
// Internal I/O to/from a default-kind character scalar can avoid a
// descriptor.
Cookie IONAME(BeginInternalListOutput)(char *internal, std::size_t bytes,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInternalListInput)(char *internal, std::size_t bytes,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInternalFormattedOutput)(char *internal, std::size_t bytes,
const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
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 IONAME(BeginInternalFormattedInput)(char *internal, std::size_t bytes,
const char *format, std::size_t formatBytes, void **scratchArea = nullptr,
Cookie IONAME(BeginInternalListInput)(char *internal,
std::size_t internalLength, void **scratchArea = nullptr,
std::size_t scratchBytes = 0, const char *sourceFile = nullptr,
int sourceLine = 0);
Cookie IONAME(BeginInternalFormattedOutput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInternalFormattedInput)(char *internal,
std::size_t internalLength, const char *format, std::size_t formatLength,
void **scratchArea = nullptr, std::size_t scratchBytes = 0,
const char *sourceFile = nullptr, int sourceLine = 0);
// Internal namelist I/O
Cookie IONAME(BeginInternalNamelistOutput)(const Descriptor &,
@ -110,10 +112,10 @@ Cookie IONAME(BeginUnformattedOutput)(ExternalUnit = DefaultUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginUnformattedInput)(ExternalUnit = DefaultUnit,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginNamelistOutput)(const NamelistGroup &,
Cookie IONAME(BeginExternalNamelistOutput)(const NamelistGroup &,
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
int sourceLine = 0);
Cookie IONAME(BeginNamelistInput)(const NamelistGroup &,
Cookie IONAME(BeginExternalNamelistInput)(const NamelistGroup &,
ExternalUnit = DefaultUnit, const char *sourceFile = nullptr,
int sourceLine = 0);
@ -150,7 +152,8 @@ Cookie IONAME(BeginInquireUnit)(
ExternalUnit, const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInquireFile)(const char *, std::size_t, int kind = 1,
const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInquireIoLength(const char *sourceFile = nullptr, int sourceLine = 0);
Cookie IONAME(BeginInquireIoLength)(
const char *sourceFile = nullptr, int sourceLine = 0);
// If an I/O statement has any IOSTAT=, ERR=, END=, or EOR= specifiers,
// call EnableHandlers() immediately after the Begin...() call.
@ -228,28 +231,28 @@ bool IONAME(InputLogical)(Cookie, bool &);
// SetDelim(), GetIoMsg(), SetPad(), SetRound(), & SetSign()
// are also acceptable for OPEN.
// ACCESS=SEQUENTIAL, DIRECT, STREAM
bool IONAME(SetAccess, Cookie, const char *, std::size_t);
bool IONAME(SetAccess)(Cookie, const char *, std::size_t);
// ACTION=READ, WRITE, or READWRITE
bool IONAME(SetAction, Cookie, const char *, std::size_t);
bool IONAME(SetAction)(Cookie, const char *, std::size_t);
// ASYNCHRONOUS=YES, NO
bool IONAME(SetAsynchronous, Cookie, const char *, std::size_t);
bool IONAME(SetAsynchronous)(Cookie, const char *, std::size_t);
// ENCODING=UTF-8, DEFAULT
bool IONAME(SetEncoding, Cookie, const char *, std::size_t);
bool IONAME(SetEncoding)(Cookie, const char *, std::size_t);
// FORM=FORMATTED, UNFORMATTED
bool IONAME(SetForm, Cookie, const char *, std::size_t);
bool IONAME(SetForm)(Cookie, const char *, std::size_t);
// POSITION=ASIS, REWIND, APPEND
bool IONAME(SetPosition, Cookie, const char *, std::size_t);
bool IONAME(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 IONAME(SetStatus, Cookie, const char *, std::size_t);
bool IONAME(SetStatus)(Cookie, const char *, std::size_t);
// SetFile() may pass a CHARACTER argument of non-default kind,
// and such filenames are converted to UTF-8 before being
// presented to the filesystem.
bool IONAME(SetFile, Cookie, const char *, std::size_t, int kind = 1);
bool IONAME(SetFile)(Cookie, const char *, std::size_t, int kind = 1);
// GetNewUnit() must not be called until after all Set...()
// connection list specifiers have been called after
@ -271,13 +274,15 @@ void IONAME(GetIoMsg)(Cookie, char *, std::size_t); // IOMSG=
// ACCESS, ACTION, ASYNCHRONOUS, BLANK, DECIMAL, DELIM, DIRECT, ENCODING,
// FORM, FORMATTED, NAME, PAD, POSITION, READ, READWRITE, ROUND,
// SEQUENTIAL, SIGN, STREAM, UNFORMATTED, WRITE:
bool IONAME(InquireCharacter)(Cookie, const char *specifier, char *, std::size_t);
bool IONAME(InquireCharacter)(
Cookie, const char *specifier, char *, std::size_t);
// EXIST, NAMED, OPENED, and PENDING (without ID):
bool IONAME(InquireLogical)(Cookie, const char *specifier, bool &);
// PENDING with ID
bool IONAME(InquirePendingId)(Cookie, std::int64_t, bool &);
// NEXTREC, NUMBER, POS, RECL, SIZE
bool IONAME(InquireInteger64)(Cookie, const char *specifier, std::int64_t &, int kind = 8);
bool IONAME(InquireInteger64)(
Cookie, const char *specifier, std::int64_t &, int kind = 8);
// The value of IOSTAT= is zero when no error, end-of-record,
// or end-of-file condition has arisen; errors are positive values.
@ -307,6 +312,6 @@ enum Iostat {
// rather than by terminating the image.
enum Iostat IONAME(EndIoStatement)(Cookie);
}; // extern "C"
} // extern "C"
}
#endif

67
flang/runtime/io-error.cc Normal file
View File

@ -0,0 +1,67 @@
//===-- runtime/io-error.cc -------------------------------------*- 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
//
//===----------------------------------------------------------------------===//
#include "io-error.h"
#include "magic-numbers.h"
#include <cerrno>
#include <cstdio>
#include <cstring>
namespace Fortran::runtime::io {
void IoErrorHandler::Begin(const char *sourceFileName, int sourceLine) {
flags_ = 0;
ioStat_ = 0;
hitEnd_ = false;
hitEor_ = false;
SetLocation(sourceFileName, sourceLine);
}
void IoErrorHandler::SignalError(int iostatOrErrno) {
if (iostatOrErrno != 0) {
if (flags_ & hasIoStat) {
if (!ioStat_) {
ioStat_ = iostatOrErrno;
}
} else if (iostatOrErrno == FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT) {
Crash("INQUIRE on internal unit");
} else {
Crash("I/O error %d: %s", iostatOrErrno, std::strerror(iostatOrErrno));
}
}
}
void IoErrorHandler::SignalEnd() {
if (flags_ & hasEnd) {
hitEnd_ = true;
} else {
Crash("End of file");
}
}
void IoErrorHandler::SignalEor() {
if (flags_ & hasEor) {
hitEor_ = true;
} else {
Crash("End of record");
}
}
int IoErrorHandler::GetIoStat() const {
if (ioStat_) {
return ioStat_;
} else if (hitEnd_) {
return FORTRAN_RUNTIME_IOSTAT_END;
} else if (hitEor_) {
return FORTRAN_RUNTIME_IOSTAT_EOR;
} else {
return 0;
}
}
}

50
flang/runtime/io-error.h Normal file
View File

@ -0,0 +1,50 @@
//===-- runtime/io-error.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
//
//===----------------------------------------------------------------------===//
// Distinguishes I/O error conditions; fatal ones lead to termination,
// and those that the user program has chosen to handle are recorded
// so that the highest-priority one can be returned as IOSTAT=.
#ifndef FORTRAN_RUNTIME_IO_ERROR_H_
#define FORTRAN_RUNTIME_IO_ERROR_H_
#include "terminator.h"
#include <cinttypes>
namespace Fortran::runtime::io {
class IoErrorHandler : virtual public Terminator {
public:
using Terminator::Terminator;
void Begin(const char *sourceFileName, int sourceLine);
void HasIoStat() { flags_ |= hasIoStat; }
void HasErrLabel() { flags_ |= hasErr; }
void HasEndLabel() { flags_ |= hasEnd; }
void HasEorLabel() { flags_ |= hasEor; }
void SignalError(int iostatOrErrno);
void SignalEnd();
void SignalEor();
int GetIoStat() const;
private:
enum Flag : std::uint8_t {
hasIoStat = 1, // IOSTAT=
hasErr = 2, // ERR=
hasEnd = 4, // END=
hasEor = 8, // EOR=
};
std::uint8_t flags_{0};
bool hitEnd_{false};
bool hitEor_{false};
int ioStat_{0};
};
}
#endif // FORTRAN_RUNTIME_IO_ERROR_H_

88
flang/runtime/io-stmt.cc Normal file
View File

@ -0,0 +1,88 @@
//===-- runtime/io-stmt.cc --------------------------------------*- 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
//
//===----------------------------------------------------------------------===//
#include "io-stmt.h"
#include "memory.h"
#include <algorithm>
#include <cstring>
namespace Fortran::runtime::io {
int IoStatementState::EndIoStatement() { return GetIoStat(); }
int InternalIoStatementState::EndIoStatement() {
auto result{GetIoStat()};
if (free_) {
FreeMemory(this);
}
return result;
}
InternalIoStatementState::InternalIoStatementState(
const char *sourceFile, int sourceLine)
: IoStatementState(sourceFile, sourceLine) {}
template<bool isInput, typename CHAR>
InternalFormattedIoStatementState<isInput,
CHAR>::InternalFormattedIoStatementState(Buffer internal,
std::size_t internalLength, const CHAR *format, std::size_t formatLength,
const char *sourceFile, int sourceLine)
: InternalIoStatementState{sourceFile, sourceLine}, FormatContext{},
internal_{internal}, internalLength_{internalLength}, format_{*this, format,
formatLength} {
std::fill_n(internal_, internalLength_, static_cast<CHAR>(' '));
}
template<bool isInput, typename CHAR>
void InternalFormattedIoStatementState<isInput, CHAR>::Emit(
const CHAR *data, std::size_t chars) {
if constexpr (isInput) {
FormatContext::Emit(data, chars); // default Crash()
} else if (at_ + chars > internalLength_) {
SignalEor();
} else {
std::memcpy(internal_ + at_, data, chars * sizeof(CHAR));
at_ += chars;
}
}
template<bool isInput, typename CHAR>
void InternalFormattedIoStatementState<isInput, CHAR>::HandleAbsolutePosition(
int n) {
if (n < 0 || static_cast<std::size_t>(n) >= internalLength_) {
Crash("T%d control edit descriptor is out of range", n);
} else {
at_ = n;
}
}
template<bool isInput, typename CHAR>
void InternalFormattedIoStatementState<isInput, CHAR>::HandleRelativePosition(
int n) {
if (n < 0) {
at_ -= std::min(at_, -static_cast<std::size_t>(n));
} else {
at_ += n;
if (at_ > internalLength_) {
Crash("TR%d control edit descriptor is out of range", n);
}
}
}
template<bool isInput, typename CHAR>
int InternalFormattedIoStatementState<isInput, CHAR>::EndIoStatement() {
format_.FinishOutput(*this);
auto result{GetIoStat()};
if (free_) {
FreeMemory(this);
}
return result;
}
template class InternalFormattedIoStatementState<false>;
}

64
flang/runtime/io-stmt.h Normal file
View File

@ -0,0 +1,64 @@
//===-- runtime/io-stmt.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
//
//===----------------------------------------------------------------------===//
// Represents state of an I/O statement in progress
#ifndef FORTRAN_RUNTIME_IO_STMT_H_
#define FORTRAN_RUNTIME_IO_STMT_H_
#include "descriptor.h"
#include "format.h"
#include "io-error.h"
#include <type_traits>
namespace Fortran::runtime::io {
class IoStatementState : public IoErrorHandler {
public:
using IoErrorHandler::IoErrorHandler;
virtual int EndIoStatement();
protected:
};
class InternalIoStatementState : public IoStatementState {
public:
InternalIoStatementState(const char *sourceFile, int sourceLine);
virtual int EndIoStatement();
protected:
bool free_{true};
};
template<bool IsInput, typename CHAR = char>
class InternalFormattedIoStatementState : public InternalIoStatementState,
private FormatContext {
private:
using Buffer = std::conditional_t<IsInput, const CHAR *, CHAR *>;
public:
InternalFormattedIoStatementState(Buffer internal, std::size_t internalLength,
const CHAR *format, std::size_t formatLength,
const char *sourceFile = nullptr, int sourceLine = 0);
void Emit(const CHAR *, std::size_t chars);
// TODO pmk: void HandleSlash(int);
void HandleRelativePosition(int);
void HandleAbsolutePosition(int);
int EndIoStatement();
private:
Buffer internal_;
std::size_t internalLength_;
std::size_t at_{0};
FormatControl<CHAR> format_; // must be last, may be partial
};
extern template class InternalFormattedIoStatementState<false>;
}
#endif // FORTRAN_RUNTIME_IO_STMT_H_

4
flang/runtime/magic-numbers.h
View File

@ -17,6 +17,8 @@ These include:
to an IOSTAT= or STAT= specifier on a Fortran I/O statement
or coindexed data reference (see Fortran 2018 12.11.5,
16.10.2, and 16.10.2.33)
Codes from <errno.h>, e.g. ENOENT, are assumed to be positive
and are used "raw" as IOSTAT values.
#endif
#ifndef FORTRAN_RUNTIME_MAGIC_NUMBERS_H_
#define FORTRAN_RUNTIME_MAGIC_NUMBERS_H_
@ -24,7 +26,7 @@ These include:
#define FORTRAN_RUNTIME_IOSTAT_END (-1)
#define FORTRAN_RUNTIME_IOSTAT_EOR (-2)
#define FORTRAN_RUNTIME_IOSTAT_FLUSH (-3)
#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 1
#define FORTRAN_RUNTIME_IOSTAT_INQUIRE_INTERNAL_UNIT 255
#define FORTRAN_RUNTIME_STAT_FAILED_IMAGE 10
#define FORTRAN_RUNTIME_STAT_LOCKED 11

42
flang/runtime/main.cc
View File

@ -7,24 +7,37 @@
//===----------------------------------------------------------------------===//
#include "main.h"
#include "io-stmt.h"
#include "terminator.h"
#include <cfenv>
#include <cstdio>
#include <cstdlib>
#include <limits>
namespace Fortran::runtime {
int argc;
const char **argv;
const char **envp;
ExecutionEnvironment executionEnvironment;
void ExecutionEnvironment::Configure(
int ac, const char *av[], const char *env[]) {
argc = ac;
argv = av;
envp = env;
listDirectedOutputLineLengthLimit = 79; // PGI default
if (auto *x{std::getenv("FORT_FMT_RECL")}) {
char *end;
auto n{std::strtol(x, &end, 10)};
if (n > 0 && n < std::numeric_limits<int>::max() && *end == '\0') {
listDirectedOutputLineLengthLimit = n;
} else {
std::fprintf(
stderr, "Fortran runtime: FORT_FMT_RECL=%s is invalid; ignored\n", x);
}
}
}
}
extern "C" {
void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
Fortran::runtime::argc = argc;
Fortran::runtime::argv = argv;
Fortran::runtime::envp = envp;
static void ConfigureFloatingPoint() {
#ifdef feclearexcept // a macro in some environments; omit std::
feclearexcept(FE_ALL_EXCEPT);
#else
@ -35,8 +48,13 @@ void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
#else
std::fesetround(FE_TONEAREST);
#endif
}
extern "C" {
void RTNAME(ProgramStart)(int argc, const char *argv[], const char *envp[]) {
std::atexit(Fortran::runtime::NotifyOtherImagesOfNormalEnd);
// TODO: Runtime configuration settings from environment
Fortran::runtime::executionEnvironment.Configure(argc, argv, envp);
ConfigureFloatingPoint();
}
}

14
flang/runtime/main.h
View File

@ -1,4 +1,4 @@
//===-- runtime/main.cc -----------------------------------------*- C++ -*-===//
//===-- runtime/main.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.
@ -12,9 +12,15 @@
#include "entry-names.h"
namespace Fortran::runtime {
extern int argc;
extern const char **argv;
extern const char **envp;
struct ExecutionEnvironment {
void Configure(int argc, const char *argv[], const char *envp[]);
int argc;
const char **argv;
const char **envp;
int listDirectedOutputLineLengthLimit;
};
extern ExecutionEnvironment executionEnvironment;
}
extern "C" {

33
flang/runtime/memory.cc Normal file
View File

@ -0,0 +1,33 @@
//===-- runtime/memory.cc ---------------------------------------*- 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
//
//===----------------------------------------------------------------------===//
#include "memory.h"
#include "terminator.h"
#include <cstdlib>
namespace Fortran::runtime {
void *AllocateMemoryOrCrash(Terminator &terminator, std::size_t bytes) {
if (void *p{std::malloc(bytes)}) {
return p;
}
if (bytes > 0) {
terminator.Crash(
"Fortran runtime internal error: out of memory, needed %zd bytes",
bytes);
}
return nullptr;
}
void FreeMemory(void *p) { std::free(p); }
void FreeMemoryAndNullify(void *&p) {
std::free(p);
p = nullptr;
}
}

43
flang/runtime/memory.h Normal file
View File

@ -0,0 +1,43 @@
//===-- runtime/memory.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
//
//===----------------------------------------------------------------------===//
// Thin wrapper around malloc()/free() to isolate the dependency,
// ease porting, and provide an owning pointer.
#ifndef FORTRAN_RUNTIME_MEMORY_H_
#define FORTRAN_RUNTIME_MEMORY_H_
#include <memory>
namespace Fortran::runtime {
class Terminator;
void *AllocateMemoryOrCrash(Terminator &, std::size_t bytes);
template<typename A> A &AllocateOrCrash(Terminator &t) {
return *reinterpret_cast<A *>(AllocateMemoryOrCrash(t, sizeof(A)));
}
void FreeMemory(void *);
void FreeMemoryAndNullify(void *&);
template<typename A> struct New {
template<typename... X> A &operator()(Terminator &terminator, X&&... x) {
return *new (AllocateMemoryOrCrash(terminator, sizeof(A))) A{std::forward<X>(x)...};
}
};
namespace {
template<typename A> class OwningPtrDeleter {
void operator()(A *p) { FreeMemory(p); }
};
}
template<typename A> using OwningPtr = std::unique_ptr<A, OwningPtrDeleter<A>>;
}
#endif // FORTRAN_RUNTIME_MEMORY_H_

6
flang/runtime/terminator.cc
View File

@ -35,6 +35,12 @@ namespace Fortran::runtime {
std::abort();
}
[[noreturn]] void Terminator::CheckFailed(
const char *predicate, const char *file, int line) {
Crash("Internal error: RUNTIME_CHECK(%s) failed at %s(%d)", predicate, file,
line);
}
void NotifyOtherImagesOfNormalEnd() {
// TODO
}

8
flang/runtime/terminator.h
View File

@ -29,12 +29,20 @@ public:
}
[[noreturn]] void Crash(const char *message, ...);
[[noreturn]] void CrashArgs(const char *message, va_list &);
[[noreturn]] void CheckFailed(
const char *predicate, const char *file, int line);
private:
const char *sourceFileName_{nullptr};
int sourceLine_{0};
};
#define RUNTIME_CHECK(terminator, pred) \
if (pred) \
; \
else \
(terminator).CheckFailed(#pred, __FILE__, __LINE__)
void NotifyOtherImagesOfNormalEnd();
void NotifyOtherImagesOfFailImageStatement();
void NotifyOtherImagesOfErrorTermination();

15
flang/runtime/transformational.cc
View File

@ -8,7 +8,6 @@
#include "transformational.h"
#include "../lib/common/idioms.h"
#include "../lib/evaluate/integer.h"
#include <algorithm>
#include <bitset>
#include <cinttypes>
@ -16,18 +15,12 @@
namespace Fortran::runtime {
template<int BITS> inline std::int64_t LoadInt64(const char *p) {
using Int = const evaluate::value::Integer<BITS>;
Int *ip{reinterpret_cast<Int *>(p)};
return ip->ToInt64();
}
static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
switch (bytes) {
case 1: return LoadInt64<8>(p);
case 2: return LoadInt64<16>(p);
case 4: return LoadInt64<32>(p);
case 8: return LoadInt64<64>(p);
case 1: return *reinterpret_cast<const std::int8_t *>(p);
case 2: return *reinterpret_cast<const std::int16_t *>(p);
case 4: return *reinterpret_cast<const std::int32_t *>(p);
case 8: return *reinterpret_cast<const std::int64_t *>(p);
default: CRASH_NO_CASE;
}
}

10
flang/test/runtime/CMakeLists.txt
View File

@ -19,3 +19,13 @@ target_link_libraries(format-test
)
add_test(Format format-test)
add_executable(hello-world
hello.cc
)
target_link_libraries(hello-world
FortranRuntime
)
add_test(HelloWorld hello-world)

87
flang/test/runtime/format.cc
View File

@ -1,5 +1,6 @@
// Test basic FORMAT string traversal
#include "../runtime/format.h"
#include "../runtime/terminator.h"
#include <cstdarg>
#include <cstring>
#include <iostream>
@ -7,24 +8,50 @@
#include <string>
using namespace Fortran::runtime;
using namespace Fortran::runtime::io;
using namespace std::literals::string_literals;
static int failures{0};
using Results = std::list<std::string>;
static Results results;
static void handleCharacterLiteral(const char *s, std::size_t len) {
// Test harness context for format control
struct TestFormatContext : virtual public Terminator, public FormatContext {
TestFormatContext() : Terminator{"format.cc", 1} {}
void Emit(const char *, std::size_t);
void HandleSlash(int = 1);
void HandleRelativePosition(int);
void HandleAbsolutePosition(int);
void Report(const DataEdit &);
void Check(Results &);
Results results;
};
// Override the runtime's Crash() for testing purposes
[[noreturn]] void Fortran::runtime::Terminator::Crash(const char *message, ...) {
std::va_list ap;
va_start(ap, message);
char buffer[1000];
std::vsnprintf(buffer, sizeof buffer, message, ap);
va_end(ap);
throw std::string{buffer};
}
void TestFormatContext::Emit(const char *s, std::size_t len) {
std::string str{s, len};
results.push_back("'"s + str + '\'');
}
static void handleSlash() { results.emplace_back("/"); }
void TestFormatContext::HandleSlash(int n) {
while (n-- > 0) {
results.emplace_back("/");
}
}
static void handleAbsolutePosition(int n) {
void TestFormatContext::HandleAbsolutePosition(int n) {
results.push_back("T"s + std::to_string(n));
}
static void handleRelativePosition(int n) {
void TestFormatContext::HandleRelativePosition(int n) {
if (n < 0) {
results.push_back("TL"s + std::to_string(-n));
} else {
@ -32,7 +59,7 @@ static void handleRelativePosition(int n) {
}
}
static void Report(const DataEdit &edit) {
void TestFormatContext::Report(const DataEdit &edit) {
std::string str{edit.descriptor};
if (edit.repeat != 1) {
str = std::to_string(edit.repeat) + '*' + str;
@ -51,17 +78,7 @@ static void Report(const DataEdit &edit) {
results.push_back(str);
}
// Override the Crash() in the runtime library
void Terminator::Crash(const char *message, ...) {
std::va_list ap;
va_start(ap, message);
char buffer[1000];
std::vsnprintf(buffer, sizeof buffer, message, ap);
va_end(ap);
throw std::string{buffer};
}
static void Check(Results &expect) {
void TestFormatContext::Check(Results &expect) {
if (expect != results) {
std::cerr << "expected:";
for (const std::string &s : expect) {
@ -78,37 +95,33 @@ static void Check(Results &expect) {
results.clear();
}
static void Test(FormatContext &context, int n, const char *format,
Results &&expect, int repeat = 1) {
MutableModes modes;
FormatControl control{context, format, std::strlen(format), modes};
static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
TestFormatContext context;
FormatControl control{context, format, std::strlen(format)};
try {
for (int j{0}; j < n; ++j) {
DataEdit edit;
control.GetNext(edit, repeat);
Report(edit);
control.GetNext(context, edit, repeat);
context.Report(edit);
}
control.FinishOutput();
control.FinishOutput(context);
} catch (const std::string &crash) {
results.push_back("Crash:"s + crash);
context.results.push_back("Crash:"s + crash);
}
Check(expect);
context.Check(expect);
}
int main() {
Terminator terminator{"source", 1};
FormatContext context{terminator, &handleCharacterLiteral, nullptr, nullptr,
&handleSlash, &handleAbsolutePosition, &handleRelativePosition};
Test(context, 1, "('PI=',F9.7)", Results{"'PI='", "F9.7"});
Test(context, 1, "(3HPI=F9.7)", Results{"'PI='", "F9.7"});
Test(context, 1, "(3HPI=/F9.7)", Results{"'PI='", "/", "F9.7"});
Test(context, 2, "('PI=',F9.7)", Results{"'PI='", "F9.7", "'PI='", "F9.7"});
Test(context, 2, "(2('PI=',F9.7),'done')",
Test(1, "('PI=',F9.7)", Results{"'PI='", "F9.7"});
Test(1, "(3HPI=F9.7)", Results{"'PI='", "F9.7"});
Test(1, "(3HPI=/F9.7)", Results{"'PI='", "/", "F9.7"});
Test(2, "('PI=',F9.7)", Results{"'PI='", "F9.7", "/", "'PI='", "F9.7"});
Test(2, "(2('PI=',F9.7),'done')",
Results{"'PI='", "F9.7", "'PI='", "F9.7", "'done'"});
Test(context, 2, "(3('PI=',F9.7,:),'tooFar')",
Test(2, "(3('PI=',F9.7,:),'tooFar')",
Results{"'PI='", "F9.7", "'PI='", "F9.7"});
Test(context, 2, "(*('PI=',F9.7,:),'tooFar')",
Test(2, "(*('PI=',F9.7,:),'tooFar')",
Results{"'PI='", "F9.7", "'PI='", "F9.7"});
Test(context, 1, "(3F9.7)", Results{"2*F9.7"}, 2);
Test(1, "(3F9.7)", Results{"2*F9.7"}, 2);
return failures > 0;
}

33
flang/test/runtime/hello.cc Normal file
View File

@ -0,0 +1,33 @@
// Basic tests of I/O API
#include "../../runtime/io-api.h"
#include <cstring>
#include <iostream>
using namespace Fortran::runtime::io;
static int failures{0};
int main() {
char buffer[32];
const char *format1{"(12HHELLO, WORLD)"};
auto cookie{IONAME(BeginInternalFormattedOutput)(buffer, sizeof buffer, format1, std::strlen(format1))};
if (auto status{IONAME(EndIoStatement)(cookie)}) {
std::cerr << "format1 failed, status " << static_cast<int>(status) << '\n';
++failures;
}
std::string got1{buffer, sizeof buffer};
std::string expect1{"HELLO, WORLD"};
expect1.resize(got1.length(), ' ');
if (got1 != expect1) {
std::cerr << "format1 failed, got '" << got1 << "', expected '" << expect1 << "'\n";
++failures;
}
if (failures == 0) {
std::cout << "PASS\n";
} else {
std::cout << "FAIL " << failures << " tests\n";
}
return failures > 0;
}