[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
llvm · Sep 30, 2021 · faa1842 · faa1842
1 parent cb2e651
commit faa1842
Show file tree

Hide file tree

Showing 5 changed files with 34 additions and 0 deletions.
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
@@ -167,6 +167,7 @@ end
   as default INTEGER if IMPLICIT NONE(TYPE) were absent.
 * OPEN(ACCESS='APPEND') is interpreted as OPEN(POSITION='APPEND')
   to ease porting from Sun Fortran.
+* Intrinsic subroutines EXIT([status]) and ABORT()
 
 ### Extensions supported when enabled by options
 

diff --git a/flang/include/flang/Runtime/stop.h b/flang/include/flang/Runtime/stop.h
@@ -26,6 +26,10 @@ void RTNAME(PauseStatementText)(const char *, size_t);
 NORETURN void RTNAME(FailImageStatement)(NO_ARGUMENTS);
 NORETURN void RTNAME(ProgramEndStatement)(NO_ARGUMENTS);
 
+// Extensions
+NORETURN void RTNAME(Exit)(int status = EXIT_SUCCESS);
+NORETURN void RTNAME(Abort)(NO_ARGUMENTS);
+
 FORTRAN_EXTERN_C_END
 
 #endif // FORTRAN_RUNTIME_STOP_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
@@ -1032,6 +1032,7 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
 };
 
 static const IntrinsicInterface intrinsicSubroutine[]{
+    {"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"cpu_time",
         {{"time", AnyReal, Rank::scalar, Optionality::required,
             common::Intent::Out}},
@@ -1056,6 +1057,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"cmdmsg", DefaultChar, Rank::scalar, Optionality::optional,
                 common::Intent::InOut}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"exit", {{"status", DefaultInt, Rank::scalar, Optionality::optional}}, {},
+        Rank::elemental, IntrinsicClass::impureSubroutine},
     {"get_command",
         {{"command", DefaultChar, Rank::scalar, Optionality::optional,
              common::Intent::Out},

diff --git a/flang/runtime/stop.cpp b/flang/runtime/stop.cpp
@@ -124,4 +124,11 @@ void RTNAME(PauseStatementText)(const char *code, std::size_t length) {
   CloseAllExternalUnits("END statement");
   std::exit(EXIT_SUCCESS);
 }
+
+[[noreturn]] void RTNAME(Exit)(int status) {
+  CloseAllExternalUnits("CALL EXIT()");
+  std::exit(status);
+}
+
+[[noreturn]] void RTNAME(Abort)() { std::abort(); }
 }
diff --git a/flang/unittests/Runtime/RuntimeCrashTest.cpp b/flang/unittests/Runtime/RuntimeCrashTest.cpp
@@ -13,6 +13,7 @@
 #include "CrashHandlerFixture.h"
 #include "../../runtime/terminator.h"
 #include "flang/Runtime/io-api.h"
+#include "flang/Runtime/stop.h"
 #include <gtest/gtest.h>
 
 using namespace Fortran::runtime;
@@ -155,3 +156,21 @@ TEST(TestIOCrash, OverwriteBufferIntegerTest) {
   ASSERT_DEATH(IONAME(OutputInteger64)(cookie, 0xdeadbeef),
       "Internal write overran available records");
 }
+
+TEST(TestIOCrash, StopTest) {
+  EXPECT_EXIT(RTNAME(StopStatement)(), testing::ExitedWithCode(EXIT_SUCCESS),
+      "Fortran STOP");
+}
+
+TEST(TestIOCrash, FailImageTest) {
+  EXPECT_EXIT(
+      RTNAME(FailImageStatement)(), testing::ExitedWithCode(EXIT_FAILURE), "");
+}
+
+TEST(TestIOCrash, ExitTest) {
+  EXPECT_EXIT(RTNAME(Exit)(), testing::ExitedWithCode(EXIT_SUCCESS), "");
+  EXPECT_EXIT(
+      RTNAME(Exit)(EXIT_FAILURE), testing::ExitedWithCode(EXIT_FAILURE), "");
+}
+
+TEST(TestIOCrash, AbortTest) { EXPECT_DEATH(RTNAME(Abort)(), ""); }