[flang-commits] [PATCH] D110741: [flang] Front-end and runtime support for CALL EXIT and ABORT

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: rovka.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
klausler requested review of this revision.

Support the extension intrinsic subroutines EXIT([status]) and ABORT()
in the intrinsic table and runtime support library.  Lowering remains
to be done.


https://reviews.llvm.org/D110741

Files:
  flang/docs/Extensions.md
  flang/include/flang/Runtime/stop.h
  flang/lib/Evaluate/intrinsics.cpp
  flang/runtime/stop.cpp
  flang/unittests/Runtime/RuntimeCrashTest.cpp


Index: flang/unittests/Runtime/RuntimeCrashTest.cpp
===================================================================
--- flang/unittests/Runtime/RuntimeCrashTest.cpp
+++ 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 @@
   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)(), ""); }
Index: flang/runtime/stop.cpp
===================================================================
--- flang/runtime/stop.cpp
+++ flang/runtime/stop.cpp
@@ -124,4 +124,11 @@
   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(); }
 }
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -1027,6 +1027,7 @@
 };
 
 static const IntrinsicInterface intrinsicSubroutine[]{
+    {"abort", {}, {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"cpu_time",
         {{"time", AnyReal, Rank::scalar, Optionality::required,
             common::Intent::Out}},
@@ -1051,6 +1052,8 @@
             {"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},
Index: flang/include/flang/Runtime/stop.h
===================================================================
--- flang/include/flang/Runtime/stop.h
+++ flang/include/flang/Runtime/stop.h
@@ -26,6 +26,10 @@
 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_
Index: flang/docs/Extensions.md
===================================================================
--- flang/docs/Extensions.md
+++ flang/docs/Extensions.md
@@ -167,6 +167,7 @@
   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
 


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D110741.375959.patch
Type: text/x-patch
Size: 3433 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20210929/f6e17ed1/attachment.bin>