Skip to content

Commit faa1842

Browse files
committed
[flang] Front-end and runtime support for CALL EXIT and ABORT
Support the extension intrinsic subroutines EXIT([status]) and ABORT() in the intrinsic table and runtime support library. Lowering remains to be done. Differential Revision: https://reviews.llvm.org/D110741
1 parent cb2e651 commit faa1842

File tree

5 files changed

+34
-0
lines changed

5 files changed

+34
-0
lines changed

flang/docs/Extensions.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,7 @@ end
167167
as default INTEGER if IMPLICIT NONE(TYPE) were absent.
168168
* OPEN(ACCESS='APPEND') is interpreted as OPEN(POSITION='APPEND')
169169
to ease porting from Sun Fortran.
170+
* Intrinsic subroutines EXIT([status]) and ABORT()
170171

171172
### Extensions supported when enabled by options
172173

flang/include/flang/Runtime/stop.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,10 @@ void RTNAME(PauseStatementText)(const char *, size_t);
2626
NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
2727
NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
2828

29+
// Extensions
30+
NORETURN void RTNAME(Exit)(int status = EXIT_SUCCESS);
31+
NORETURN void RTNAME(Abort)(NO_ARGUMENTS);
32+
2933
FORTRAN_EXTERN_C_END
3034

3135
#endif // FORTRAN_RUNTIME_STOP_H_

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1032,6 +1032,7 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
10321032
};
10331033

10341034
static const IntrinsicInterface intrinsicSubroutine[]{
1035+
{"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
10351036
{"cpu_time",
10361037
{{"time", AnyReal, Rank::scalar, Optionality::required,
10371038
common::Intent::Out}},
@@ -1056,6 +1057,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
10561057
{"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
10571058
common::Intent::InOut}},
10581059
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
1060+
{"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
1061+
Rank::elemental, IntrinsicClass::impureSubroutine},
10591062
{"get_command",
10601063
{{"command", DefaultChar, Rank::scalar, Optionality::optional,
10611064
common::Intent::Out},

flang/runtime/stop.cpp

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -124,4 +124,11 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
124124
CloseAllExternalUnits("END statement");
125125
std::exit(EXIT_SUCCESS);
126126
}
127+
128+
[[noreturn]] void RTNAME(Exit)(int status) {
129+
CloseAllExternalUnits("CALL EXIT()");
130+
std::exit(status);
131+
}
132+
133+
[[noreturn]] void RTNAME(Abort)() { std::abort(); }
127134
}

flang/unittests/Runtime/RuntimeCrashTest.cpp

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
#include "CrashHandlerFixture.h"
1414
#include "../../runtime/terminator.h"
1515
#include "flang/Runtime/io-api.h"
16+
#include "flang/Runtime/stop.h"
1617
#include <gtest/gtest.h>
1718

1819
using namespace Fortran::runtime;
@@ -155,3 +156,21 @@ TEST(TestIOCrash, OverwriteBufferIntegerTest) {
155156
ASSERT_DEATH(IONAME(OutputInteger64)(cookie, 0xdeadbeef),
156157
"Internal write overran available records");
157158
}
159+
160+
TEST(TestIOCrash, StopTest) {
161+
EXPECT_EXIT(RTNAME(StopStatement)(), testing::ExitedWithCode(EXIT_SUCCESS),
162+
"Fortran STOP");
163+
}
164+
165+
TEST(TestIOCrash, FailImageTest) {
166+
EXPECT_EXIT(
167+
RTNAME(FailImageStatement)(), testing::ExitedWithCode(EXIT_FAILURE), "");
168+
}
169+
170+
TEST(TestIOCrash, ExitTest) {
171+
EXPECT_EXIT(RTNAME(Exit)(), testing::ExitedWithCode(EXIT_SUCCESS), "");
172+
EXPECT_EXIT(
173+
RTNAME(Exit)(EXIT_FAILURE), testing::ExitedWithCode(EXIT_FAILURE), "");
174+
}
175+
176+
TEST(TestIOCrash, AbortTest) { EXPECT_DEATH(RTNAME(Abort)(), ""); }

0 commit comments

Comments
 (0)