[flang] Extend runtime API for PAUSE to allow a stop code

Support integer and default character stop codes on PAUSE
statements.  Add length argument to STOP statement with a
character stop code.

Differential revision: https://reviews.llvm.org/D88692
This commit is contained in:
peter klausler 2020-10-01 12:12:46 -07:00
parent a94d943f1a
commit 3261aefc72
2 changed files with 39 additions and 10 deletions

View File

@ -64,26 +64,53 @@ static void CloseAllExternalUnits(const char *why) {
}
[[noreturn]] void RTNAME(StopStatementText)(
const char *code, bool isErrorStop, bool quiet) {
const char *code, std::size_t length, bool isErrorStop, bool quiet) {
CloseAllExternalUnits("STOP statement");
if (!quiet) {
std::fprintf(
stderr, "Fortran %s: %s\n", isErrorStop ? "ERROR STOP" : "STOP", code);
std::fprintf(stderr, "Fortran %s: %.*s\n",
isErrorStop ? "ERROR STOP" : "STOP", static_cast<int>(length), code);
DescribeIEEESignaledExceptions();
}
std::exit(EXIT_FAILURE);
}
void RTNAME(PauseStatement)() {
static bool StartPause() {
if (Fortran::runtime::io::IsATerminal(0)) {
Fortran::runtime::io::IoErrorHandler handler{"PAUSE statement"};
Fortran::runtime::io::ExternalFileUnit::FlushAll(handler);
return true;
}
return false;
}
static void EndPause() {
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
std::exit(EXIT_SUCCESS);
}
}
void RTNAME(PauseStatement)() {
if (StartPause()) {
std::fputs("Fortran PAUSE: hit RETURN to continue:", stderr);
std::fflush(nullptr);
if (std::fgetc(stdin) == EOF) {
CloseAllExternalUnits("PAUSE statement");
std::exit(EXIT_SUCCESS);
}
EndPause();
}
}
void RTNAME(PauseStatementInt)(int code) {
if (StartPause()) {
std::fprintf(stderr, "Fortran PAUSE %d: hit RETURN to continue:", code);
EndPause();
}
}
void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
if (StartPause()) {
std::fprintf(stderr,
"Fortran PAUSE %.*s: hit RETURN to continue:", static_cast<int>(length),
code);
EndPause();
}
}

View File

@ -18,9 +18,11 @@ FORTRAN_EXTERN_C_BEGIN
// Program-initiated image stop
NORETURN void RTNAME(StopStatement)(int code DEFAULT_VALUE(EXIT_SUCCESS),
bool isErrorStop DEFAULT_VALUE(false), bool quiet DEFAULT_VALUE(false));
NORETURN void RTNAME(StopStatementText)(const char *,
NORETURN void RTNAME(StopStatementText)(const char *, size_t,
bool isErrorStop DEFAULT_VALUE(false), bool quiet DEFAULT_VALUE(false));
void RTNAME(PauseStatement)(NO_ARGUMENTS);
void RTNAME(PauseStatementInt)(int);
void RTNAME(PauseStatementText)(const char *, size_t);
NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);