summaryrefslogtreecommitdiff
path: root/flang/runtime/io-error.cpp
blob: 56e4b24cbe062a1f532f4fdf0f41d474ae3d632b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
//===-- runtime/io-error.cpp ----------------------------------------------===//
//
// 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 "tools.h"
#include "flang/Runtime/magic-numbers.h"
#include <cerrno>
#include <cstdarg>
#include <cstdio>
#include <cstring>

namespace Fortran::runtime::io {

void IoErrorHandler::SignalError(int iostatOrErrno, const char *msg, ...) {
  // Note that IOMSG= alone without IOSTAT=/END=/EOR=/ERR= does not suffice
  // for error recovery (see F'2018 subclause 12.11).
  switch (iostatOrErrno) {
  case IostatOk:
    return;
  case IostatEnd:
    if (flags_ & (hasIoStat | hasEnd)) {
      if (ioStat_ == IostatOk || ioStat_ < IostatEnd) {
        ioStat_ = IostatEnd;
      }
      return;
    }
    break;
  case IostatEor:
    if (flags_ & (hasIoStat | hasEor)) {
      if (ioStat_ == IostatOk || ioStat_ < IostatEor) {
        ioStat_ = IostatEor; // least priority
      }
      return;
    }
    break;
  default:
    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);
        }
      }
      return;
    }
    break;
  }
  // I/O error not caught!
  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) {
  if (ioStatOrErrno != IostatOk) {
    if (msg) {
      SignalError(ioStatOrErrno, "%.*s", static_cast<int>(length), msg);
    } else {
      SignalError(ioStatOrErrno);
    }
  }
}

void IoErrorHandler::SignalErrno() { SignalError(errno); }

void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }

void IoErrorHandler::SignalEor() { SignalError(IostatEor); }

void IoErrorHandler::SignalPendingError() {
  int error{pendingError_};
  pendingError_ = IostatOk;
  SignalError(error);
}

bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
  const char *msg{ioMsg_.get()};
  if (!msg) {
    msg = IostatErrorString(ioStat_ == IostatOk ? pendingError_ : ioStat_);
  }
  if (msg) {
    ToFortranDefaultCharacter(buffer, bufferLength, msg);
    return true;
  }

  // Following code is taken from llvm/lib/Support/Errno.cpp
  // in LLVM v9.0.1 with inadequate modification for Fortran,
  // since rectified.
  bool ok{false};
#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.
  msg = ::strerror_r(ioStat_, buffer, bufferLength);
#else
  ok = ::strerror_r(ioStat_, buffer, bufferLength) == 0;
#endif
#elif HAVE_DECL_STRERROR_S // "Windows Secure API"
  ok = ::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.
  msg = strerror(ioStat_);
#else
  // Strange that this system doesn't even have strerror
  return false;
#endif
  if (msg) {
    ToFortranDefaultCharacter(buffer, bufferLength, msg);
    return true;
  } else if (ok) {
    std::size_t copied{std::strlen(buffer)};
    if (copied < bufferLength) {
      std::memset(buffer + copied, ' ', bufferLength - copied);
    }
    return true;
  } else {
    return false;
  }
}
} // namespace Fortran::runtime::io