llvm-capstone/flang/runtime/io-error.cpp
peter klausler 43fadefb0e [flang] Implement user-defined derived type runtime I/O
With derived type description tables now available to the
runtime library, it is possible to implement the concept
of "child" I/O statements in the runtime and use them to
convert instances of derived type I/O data transfers into
calls to user-defined subroutines when they have been specified
for a type.  (See Fortran 2018, subclauses 12.6.4.8 & 13.7.6).

 - Support formatted, list-directed, and NAMELIST
   transfers to internal parent units; support these, and unformatted
   transfers, for external parent units.
 - Support nested child defined derived type I/O.
 - Parse DT'foo'(v-list) FORMAT data edit descriptors and passes
   their strings &/or v-list values as arguments to the defined
   formatted I/O routines.
 - Fix problems with this feature encountered in semantics and
   FORMAT valiation during development and end-to-end testing.
 - Convert typeInfo::SpecialBinding from a struct to a class
   after adding a member function.

Differential Revision: https://reviews.llvm.org/D104930
2021-06-28 11:36:19 -07:00

112 lines
3.4 KiB
C++

//===-- runtime/io-error.cpp ------------------------------------*- 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 "config.h"
#include "magic-numbers.h"
#include "tools.h"
#include <cerrno>
#include <cstdarg>
#include <cstdio>
#include <cstring>
namespace Fortran::runtime::io {
void IoErrorHandler::SignalError(int iostatOrErrno, const char *msg, ...) {
if (iostatOrErrno == IostatEnd && (flags_ & hasEnd)) {
if (ioStat_ == IostatOk || ioStat_ < IostatEnd) {
ioStat_ = IostatEnd;
}
} else if (iostatOrErrno == IostatEor && (flags_ & hasEor)) {
if (ioStat_ == IostatOk || ioStat_ < IostatEor) {
ioStat_ = IostatEor; // least priority
}
} else if (iostatOrErrno != IostatOk) {
if (flags_ & (hasIoStat | hasErr)) {
if (ioStat_ <= 0) {
ioStat_ = iostatOrErrno; // priority over END=/EOR=
if (msg && (flags_ & hasIoMsg)) {
char buffer[256];
va_list ap;
va_start(ap, msg);
std::vsnprintf(buffer, sizeof buffer, msg, ap);
ioMsg_ = SaveDefaultCharacter(buffer, std::strlen(buffer) + 1, *this);
va_end(ap);
}
}
} else if (msg) {
va_list ap;
va_start(ap, msg);
CrashArgs(msg, ap);
va_end(ap);
} else if (const char *errstr{IostatErrorString(iostatOrErrno)}) {
Crash(errstr);
} else {
Crash("I/O error (errno=%d): %s", iostatOrErrno,
std::strerror(iostatOrErrno));
}
}
}
void IoErrorHandler::SignalError(int iostatOrErrno) {
SignalError(iostatOrErrno, nullptr);
}
void IoErrorHandler::Forward(
int ioStatOrErrno, const char *msg, std::size_t length) {
SignalError(ioStatOrErrno);
if (ioStat_ != IostatOk && (flags_ & hasIoMsg)) {
ioMsg_ = SaveDefaultCharacter(msg, length, *this);
}
}
void IoErrorHandler::SignalErrno() { SignalError(errno); }
void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }
void IoErrorHandler::SignalEor() { SignalError(IostatEor); }
bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
const char *msg{ioMsg_.get()};
if (!msg) {
msg = IostatErrorString(ioStat_);
}
if (msg) {
ToFortranDefaultCharacter(buffer, bufferLength, msg);
return true;
}
char *newBuf;
// Following code is taken from llvm/lib/Support/Errno.cpp
// in LLVM v9.0.1
#if HAVE_STRERROR_R
// strerror_r is thread-safe.
#if defined(__GLIBC__) && defined(_GNU_SOURCE)
// glibc defines its own incompatible version of strerror_r
// which may not use the buffer supplied.
newBuf = ::strerror_r(ioStat_, buffer, bufferLength);
#else
return ::strerror_r(ioStat_, buffer, bufferLength) == 0;
#endif
#elif HAVE_DECL_STRERROR_S // "Windows Secure API"
return ::strerror_s(buffer, bufferLength, ioStat_) == 0;
#elif HAVE_STRERROR
// Copy the thread un-safe result of strerror into
// the buffer as fast as possible to minimize impact
// of collision of strerror in multiple threads.
newBuf = strerror(ioStat_);
#else
// Strange that this system doesn't even have strerror
return false;
#endif
::strncpy(buffer, newBuf, bufferLength - 1);
buffer[bufferLength - 1] = '\n';
return true;
}
} // namespace Fortran::runtime::io