376 changes: 297 additions & 79 deletions flang/runtime/unit.cpp
View file

Large diffs are not rendered by default.

49 changes: 37 additions & 12 deletions flang/runtime/unit.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@

namespace Fortran::runtime::io {

class UnitMap;

class ExternalFileUnit : public ConnectionState,
public OpenFile,
public FileFrame<ExternalFileUnit> {
Expand All @@ -36,19 +38,21 @@ class ExternalFileUnit : public ConnectionState,

static ExternalFileUnit *LookUp(int unit);
static ExternalFileUnit &LookUpOrCrash(int unit, const Terminator &);
static ExternalFileUnit &LookUpOrCreate(int unit, bool *wasExtant = nullptr);
static int NewUnit();
static void InitializePredefinedUnits();
static ExternalFileUnit &LookUpOrCreate(
int unit, const Terminator &, bool *wasExtant = nullptr);
static ExternalFileUnit *LookUpForClose(int unit);
static int NewUnit(const Terminator &);
static void CloseAll(IoErrorHandler &);

void OpenUnit(OpenStatus, Position, OwningPtr<char> &&path,
std::size_t pathLength, IoErrorHandler &);
void CloseUnit(CloseStatus, IoErrorHandler &);
void DestroyClosed();

template<typename A, typename... X>
IoStatementState &BeginIoStatement(X &&... xs) {
// TODO: lock().Take() here, and keep it until EndIoStatement()?
// Nested I/O from derived types wouldn't work, though.
// TODO: Child data transfer statements vs. locking
lock_.Take(); // dropped in EndIoStatement()
A &state{u_.emplace<A>(std::forward<X>(xs)...)};
if constexpr (!std::is_same_v<A, OpenStatementState>) {
state.mutableModes() = ConnectionState::modes;
Expand All @@ -58,26 +62,47 @@ class ExternalFileUnit : public ConnectionState,
}

bool Emit(const char *, std::size_t bytes, IoErrorHandler &);
std::optional<char32_t> GetCurrentChar(IoErrorHandler &);
void SetLeftTabLimit();
bool AdvanceRecord(IoErrorHandler &);
bool HandleAbsolutePosition(std::int64_t, IoErrorHandler &);
bool HandleRelativePosition(std::int64_t, IoErrorHandler &);

void BackspaceRecord(IoErrorHandler &);
void FlushIfTerminal(IoErrorHandler &);
void EndIoStatement();
void SetPosition(std::int64_t pos) {
frameOffsetInFile_ = pos;
recordOffsetInFrame_ = 0;
}

private:
bool SetPositionInRecord(std::int64_t, IoErrorHandler &);
static UnitMap &GetUnitMap();
void NextSequentialUnformattedInputRecord(IoErrorHandler &);
void NextSequentialFormattedInputRecord(IoErrorHandler &);
void BackspaceSequentialUnformattedRecord(IoErrorHandler &);
void BackspaceSequentialFormattedRecord(IoErrorHandler &);

int unitNumber_{-1};
bool isReading_{false};

Lock lock_;

// When an I/O statement is in progress on this unit, holds its state.
std::variant<std::monostate, OpenStatementState, CloseStatementState,
ExternalFormattedIoStatementState<false>,
ExternalListIoStatementState<false>, UnformattedIoStatementState<false>>
ExternalFormattedIoStatementState<Direction::Output>,
ExternalFormattedIoStatementState<Direction::Input>,
ExternalListIoStatementState<Direction::Output>,
ExternalListIoStatementState<Direction::Input>,
UnformattedIoStatementState<Direction::Output>,
UnformattedIoStatementState<Direction::Input>>
u_;
// Points to the active alternative, if any, in u_, for use as a Cookie

// Points to the active alternative (if any) in u_ for use as a Cookie
std::optional<IoStatementState> io_;

// Subtle: The beginning of the frame can't be allowed to advance
// during a single list-directed READ due to the possibility of a
// multi-record CHARACTER value with a "r*" repeat count.
std::int64_t frameOffsetInFile_{0};
std::int64_t recordOffsetInFrame_{0}; // of currentRecordNumber
};

}
Expand Down
14 changes: 6 additions & 8 deletions flang/test/Evaluate/reshape.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,8 @@ using namespace Fortran::runtime;
int main() {
static const SubscriptValue ones[]{1, 1, 1};
static const SubscriptValue sourceExtent[]{2, 3, 4};
std::unique_ptr<Descriptor> source{
Descriptor::Create(TypeCategory::Integer, sizeof(std::int32_t), nullptr,
3, sourceExtent, CFI_attribute_allocatable)};
auto source{Descriptor::Create(TypeCategory::Integer, sizeof(std::int32_t),
nullptr, 3, sourceExtent, CFI_attribute_allocatable)};
source->Check();
MATCH(3, source->rank());
MATCH(sizeof(std::int32_t), source->ElementBytes());
Expand All @@ -25,12 +24,12 @@ int main() {
MATCH(4, source->GetDimension(2).Extent());
MATCH(24, source->Elements());
for (std::size_t j{0}; j < 24; ++j) {
*source->Element<std::int32_t>(j * sizeof(std::int32_t)) = j;
*source->OffsetElement<std::int32_t>(j * sizeof(std::int32_t)) = j;
}

static const std::int16_t shapeData[]{8, 4};
static const SubscriptValue shapeExtent{2};
std::unique_ptr<Descriptor> shape{Descriptor::Create(TypeCategory::Integer,
auto shape{Descriptor::Create(TypeCategory::Integer,
static_cast<int>(sizeof shapeData[0]),
const_cast<void *>(reinterpret_cast<const void *>(shapeData)), 1,
&shapeExtent, CFI_attribute_pointer)};
Expand All @@ -54,15 +53,14 @@ int main() {
MATCH(2, pad.GetDimension(1).Extent());
MATCH(3, pad.GetDimension(2).Extent());

std::unique_ptr<Descriptor> result{RESHAPE(*source, *shape, &pad)};

auto result{RESHAPE(*source, *shape, &pad)};
TEST(result.get() != nullptr);
result->Check();
MATCH(sizeof(std::int32_t), result->ElementBytes());
MATCH(2, result->rank());
TEST(result->type().IsInteger());
for (std::int32_t j{0}; j < 32; ++j) {
MATCH(j, *result->Element<std::int32_t>(j * sizeof(std::int32_t)));
MATCH(j, *result->OffsetElement<std::int32_t>(j * sizeof(std::int32_t)));
}
for (std::int32_t j{0}; j < 32; ++j) {
SubscriptValue ss[2]{1 + (j % 8), 1 + (j / 8)};
Expand Down
17 changes: 17 additions & 0 deletions flang/test/Runtime/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,12 +10,17 @@ if(CMAKE_COMPILER_IS_GNUCXX OR (CMAKE_CXX_COMPILER_ID MATCHES "Clang"))
set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fexceptions")
endif()

add_library(RuntimeTesting
testing.cpp
)

add_executable(format-test
format.cpp
)

target_link_libraries(format-test
FortranRuntime
RuntimeTesting
)

add_test(Format format-test)
Expand All @@ -26,6 +31,7 @@ add_executable(hello-world

target_link_libraries(hello-world
FortranRuntime
RuntimeTesting
)

add_test(HelloWorld hello-world)
Expand All @@ -37,3 +43,14 @@ add_executable(external-hello-world
target_link_libraries(external-hello-world
FortranRuntime
)

add_executable(list-input-test
list-input.cpp
)

target_link_libraries(list-input-test
FortranRuntime
RuntimeTesting
)

add_test(ListInput list-input-test)
40 changes: 15 additions & 25 deletions flang/test/Runtime/format.cpp
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
// Tests basic FORMAT string traversal

#include "testing.h"
#include "../runtime/format-implementation.h"
#include "../runtime/terminator.h"
#include "../runtime/io-error.h"
#include <cstdarg>
#include <cstring>
#include <iostream>
Expand All @@ -12,20 +13,19 @@ using namespace Fortran::runtime;
using namespace Fortran::runtime::io;
using namespace std::literals::string_literals;

static int failures{0};
using Results = std::vector<std::string>;

// A test harness context for testing FormatControl
class TestFormatContext : public Terminator {
class TestFormatContext : public IoErrorHandler {
public:
using CharType = char;
TestFormatContext() : Terminator{"format.cpp", 1} {}
TestFormatContext() : IoErrorHandler{"format.cpp", 1} {}
bool Emit(const char *, std::size_t);
bool Emit(const char16_t *, std::size_t);
bool Emit(const char32_t *, std::size_t);
bool AdvanceRecord(int = 1);
bool HandleRelativePosition(std::int64_t);
bool HandleAbsolutePosition(std::int64_t);
void HandleRelativePosition(std::int64_t);
void HandleAbsolutePosition(std::int64_t);
void Report(const DataEdit &);
void Check(Results &);
Results results;
Expand All @@ -35,17 +35,6 @@ class TestFormatContext : public Terminator {
MutableModes mutableModes_;
};

// Override the runtime's Crash() for testing purposes
[[noreturn]] void Fortran::runtime::Terminator::Crash(
const char *message, ...) const {
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};
}

bool TestFormatContext::Emit(const char *s, std::size_t len) {
std::string str{s, len};
results.push_back("'"s + str + '\'');
Expand All @@ -67,18 +56,16 @@ bool TestFormatContext::AdvanceRecord(int n) {
return true;
}

bool TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
void TestFormatContext::HandleAbsolutePosition(std::int64_t n) {
results.push_back("T"s + std::to_string(n));
return true;
}

bool TestFormatContext::HandleRelativePosition(std::int64_t n) {
void TestFormatContext::HandleRelativePosition(std::int64_t n) {
if (n < 0) {
results.push_back("TL"s + std::to_string(-n));
} else {
results.push_back(std::to_string(n) + 'X');
}
return true;
}

void TestFormatContext::Report(const DataEdit &edit) {
Expand All @@ -104,7 +91,7 @@ void TestFormatContext::Report(const DataEdit &edit) {

void TestFormatContext::Check(Results &expect) {
if (expect != results) {
std::cerr << "expected:";
Fail() << "expected:";
for (const std::string &s : expect) {
std::cerr << ' ' << s;
}
Expand All @@ -113,7 +100,6 @@ void TestFormatContext::Check(Results &expect) {
std::cerr << ' ' << s;
}
std::cerr << '\n';
++failures;
}
expect.clear();
results.clear();
Expand All @@ -127,14 +113,18 @@ static void Test(int n, const char *format, Results &&expect, int repeat = 1) {
for (int j{0}; j < n; ++j) {
context.Report(control.GetNextDataEdit(context, repeat));
}
control.FinishOutput(context);
control.Finish(context);
if (int iostat{context.GetIoStat()}) {
context.Crash("GetIoStat() == %d", iostat);
}
} catch (const std::string &crash) {
context.results.push_back("Crash:"s + crash);
}
context.Check(expect);
}

int main() {
StartTests();
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"});
Expand All @@ -146,5 +136,5 @@ int main() {
Test(2, "(*('PI=',F9.7,:),'tooFar')",
Results{"'PI='", "F9.7", "'PI='", "F9.7"});
Test(1, "(3F9.7)", Results{"2*F9.7"}, 2);
return failures > 0;
return EndTests();
}
87 changes: 60 additions & 27 deletions flang/test/Runtime/hello.cpp
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
// Basic sanity tests of I/O API; exhaustive testing will be done in Fortran

#include "testing.h"
#include "../../runtime/descriptor.h"
#include "../../runtime/io-api.h"
#include <cstring>
Expand All @@ -8,16 +9,15 @@
using namespace Fortran::runtime;
using namespace Fortran::runtime::io;

static int failures{0};

static void test(const char *format, const char *expect, std::string &&got) {
static bool test(const char *format, const char *expect, std::string &&got) {
std::string want{expect};
want.resize(got.length(), ' ');
if (got != want) {
std::cerr << '\'' << format << "' failed;\n got '" << got
<< "',\nexpected '" << want << "'\n";
++failures;
Fail() << '\'' << format << "' failed;\n got '" << got
<< "',\nexpected '" << want << "'\n";
return false;
}
return true;
}

static void hello() {
Expand All @@ -30,9 +30,8 @@ static void hello() {
IONAME(OutputInteger64)(cookie, 0xfeedface);
IONAME(OutputLogical)(cookie, true);
if (auto status{IONAME(EndIoStatement)(cookie)}) {
std::cerr << "hello: '" << format << "' failed, status "
<< static_cast<int>(status) << '\n';
++failures;
Fail() << "hello: '" << format << "' failed, status "
<< static_cast<int>(status) << '\n';
} else {
test(format, "HELLO, WORLD 678 0xFEEDFACE T",
std::string{buffer, sizeof buffer});
Expand All @@ -46,21 +45,18 @@ static void multiline() {
SubscriptValue extent[]{4};
whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
CFI_attribute_pointer);
// whole.Dump(std::cout);
whole.Dump();
whole.Check();
Descriptor &section{staticDescriptor[1].descriptor()};
SubscriptValue lowers[]{0}, uppers[]{3}, strides[]{1};
section.Establish(whole.type(), whole.ElementBytes(), nullptr, 1, extent,
CFI_attribute_pointer);
// section.Dump(std::cout);
section.Check();
if (auto error{
CFI_section(&section.raw(), &whole.raw(), lowers, uppers, strides)}) {
std::cerr << "multiline: CFI_section failed: " << error << '\n';
++failures;
Fail() << "multiline: CFI_section failed: " << error << '\n';
return;
}
section.Dump(std::cout);
section.Dump();
section.Check();
const char *format{"('?abcde,',T1,'>',T9,A,TL12,A,TR25,'<'//G0,25X,'done')"};
auto cookie{IONAME(BeginInternalArrayFormattedOutput)(
Expand All @@ -69,9 +65,8 @@ static void multiline() {
IONAME(OutputAscii)(cookie, "HELLO", 5);
IONAME(OutputInteger64)(cookie, 789);
if (auto status{IONAME(EndIoStatement)(cookie)}) {
std::cerr << "multiline: '" << format << "' failed, status "
<< static_cast<int>(status) << '\n';
++failures;
Fail() << "multiline: '" << format << "' failed, status "
<< static_cast<int>(status) << '\n';
} else {
test(format,
">HELLO, WORLD <"
Expand All @@ -88,15 +83,41 @@ static void realTest(const char *format, double x, const char *expect) {
buffer, sizeof buffer, format, std::strlen(format))};
IONAME(OutputReal64)(cookie, x);
if (auto status{IONAME(EndIoStatement)(cookie)}) {
std::cerr << '\'' << format << "' failed, status "
<< static_cast<int>(status) << '\n';
++failures;
Fail() << '\'' << format << "' failed, status " << static_cast<int>(status)
<< '\n';
} else {
test(format, expect, std::string{buffer, sizeof buffer});
}
}

static void realInTest(
const char *format, const char *data, std::uint64_t want) {
auto cookie{IONAME(BeginInternalFormattedInput)(
data, std::strlen(data), format, std::strlen(format))};
union {
double x;
std::uint64_t raw;
} u;
u.raw = 0;
IONAME(EnableHandlers)(cookie, true, true, true, true, true);
IONAME(InputReal64)(cookie, u.x);
char iomsg[65];
iomsg[0] = '\0';
iomsg[sizeof iomsg - 1] = '\0';
IONAME(GetIoMsg)(cookie, iomsg, sizeof iomsg - 1);
auto status{IONAME(EndIoStatement)(cookie)};
if (status) {
Fail() << '\'' << format << "' failed reading '" << data << "', status "
<< static_cast<int>(status) << " iomsg '" << iomsg << "'\n";
} else if (u.raw != want) {
Fail() << '\'' << format << "' failed reading '" << data << "', want 0x"
<< std::hex << want << ", got 0x" << u.raw << std::dec << '\n';
}
}

int main() {
StartTests();

hello();
multiline();

Expand Down Expand Up @@ -382,10 +403,22 @@ int main() {
"4040261841248583680000+306;");
realTest("(G0,';')", u.d, ".17976931348623157+309;");

if (failures == 0) {
std::cout << "PASS\n";
} else {
std::cout << "FAIL " << failures << " tests\n";
}
return failures > 0;
realInTest("(F18.0)", " 0", 0x0);
realInTest("(F18.0)", " ", 0x0);
realInTest("(F18.0)", " -0", 0x8000000000000000);
realInTest("(F18.0)", " 1", 0x3ff0000000000000);
realInTest("(F18.0)", " 125.", 0x405f400000000000);
realInTest("(F18.0)", " 12.5", 0x4029000000000000);
realInTest("(F18.0)", " 1.25", 0x3ff4000000000000);
realInTest("(F18.0)", " .125", 0x3fc0000000000000);
realInTest("(F18.0)", " 125", 0x405f400000000000);
realInTest("(F18.1)", " 125", 0x4029000000000000);
realInTest("(F18.2)", " 125", 0x3ff4000000000000);
realInTest("(F18.3)", " 125", 0x3fc0000000000000);
realInTest("(-1P,F18.0)", " 125", 0x4093880000000000); // 1250
realInTest("(1P,F18.0)", " 125", 0x4029000000000000); // 12.5
realInTest("(BZ,F18.0)", " 125 ", 0x4093880000000000); // 1250
realInTest("(DC,F18.0)", " 12,5", 0x4029000000000000);

return EndTests();
}
68 changes: 68 additions & 0 deletions flang/test/Runtime/list-input.cpp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,68 @@
// Basic sanity tests for list-directed input

#include "testing.h"
#include "../../runtime/descriptor.h"
#include "../../runtime/io-api.h"
#include "../../runtime/io-error.h"
#include <algorithm>
#include <cstring>
#include <iostream>

using namespace Fortran::runtime;
using namespace Fortran::runtime::io;

int main() {
StartTests();

char buffer[4][32];
int j{0};
for (const char *p : {"1 2 2*3 ,", ",6,,8,123*",
"2*'abcdefghijklmnopqrstuvwxyzABC", "DEFGHIJKLMNOPQRSTUVWXYZ'"}) {
SetCharacter(buffer[j++], sizeof buffer[0], p);
}
for (; j < 4; ++j) {
SetCharacter(buffer[j], sizeof buffer[0], "");
}

StaticDescriptor<1> staticDescriptor;
Descriptor &whole{staticDescriptor.descriptor()};
SubscriptValue extent[]{4};
whole.Establish(TypeCode{CFI_type_char}, sizeof buffer[0], &buffer, 1, extent,
CFI_attribute_pointer);
whole.Dump();
whole.Check();

try {
auto cookie{IONAME(BeginInternalArrayListInput)(whole)};
std::int64_t n[9]{-1, -2, -3, -4, 5, -6, 7, -8, 9};
std::int64_t want[9]{1, 2, 3, 3, 5, 6, 7, 8, 9};
for (j = 0; j < 9; ++j) {
IONAME(InputInteger)(cookie, n[j]);
}
char asc[2][54]{};
IONAME(InputAscii)(cookie, asc[0], sizeof asc[0] - 1);
IONAME(InputAscii)(cookie, asc[1], sizeof asc[1] - 1);
if (auto status{IONAME(EndIoStatement)(cookie)}) {
Fail() << "list-directed input failed, status "
<< static_cast<int>(status) << '\n';
} else {
for (j = 0; j < 9; ++j) {
if (n[j] != want[j]) {
Fail() << "wanted n[" << j << "]==" << want[j] << ", got " << n[j]
<< '\n';
}
}
for (j = 0; j < 2; ++j) {
if (std::strcmp(asc[j],
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ ") != 0) {
Fail() << "wanted asc[" << j << "]=alphabets, got '" << asc[j]
<< "'\n";
}
}
}
} catch (const std::string &crash) {
Fail() << "crash: " << crash << '\n';
}

return EndTests();
}
43 changes: 43 additions & 0 deletions flang/test/Runtime/testing.cpp
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,43 @@
#include "testing.h"
#include "../../runtime/terminator.h"
#include <cstdarg>
#include <cstdio>
#include <cstring>
#include <iostream>
#include <string>

static int failures{0};

// Override the Fortran runtime's Crash() for testing purposes
[[noreturn]] static void CatchCrash(const char *message, va_list &ap) {
char buffer[1000];
std::vsnprintf(buffer, sizeof buffer, message, ap);
va_end(ap);
throw std::string{buffer};
}

void StartTests() {
Fortran::runtime::Terminator::RegisterCrashHandler(CatchCrash);
}

std::ostream &Fail() {
++failures;
return std::cerr;
}

int EndTests() {
if (failures == 0) {
std::cout << "PASS\n";
} else {
std::cout << "FAIL " << failures << " tests\n";
}
return failures != 0;
}

void SetCharacter(char *to, std::size_t n, const char *from) {
auto len{std::strlen(from)};
std::memcpy(to, from, std::min(len, n));
if (len < n) {
std::memset(to + len, ' ', n - len);
}
}
13 changes: 13 additions & 0 deletions flang/test/Runtime/testing.h
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
#ifndef FORTRAN_TEST_RUNTIME_TESTING_H_
#define FORTRAN_TEST_RUNTIME_TESTING_H_

#include <cstddef>
#include <iosfwd>

void StartTests();
std::ostream &Fail();
int EndTests();

void SetCharacter(char *, std::size_t, const char *);

#endif // FORTRAN_TEST_RUNTIME_TESTING_H_
2 changes: 1 addition & 1 deletion flang/test/Semantics/call15.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ subroutine s(arg1, arg2, arg3)

call inner(arg1) ! OK, assumed rank
call inner(arg2) ! OK, assumed shape
!ERROR: Assumed-type TYPE(*) 'arg3' must be either assumed shape or assumed rank to be associated with TYPE(*) dummy argument 'dummy='
!ERROR: Assumed-type 'arg3' must be either assumed shape or assumed rank to be associated with assumed-type dummy argument 'dummy='
call inner(arg3)

contains
Expand Down