[flang-commits] [flang] faa1842 - [flang] Front-end and runtime support for CALL EXIT and ABORT

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-09-30T11:01:22-07:00
New Revision: faa1842875f1dcd241c6b0feab7d684eb97fefc4

URL: https://github.com/llvm/llvm-project/commit/faa1842875f1dcd241c6b0feab7d684eb97fefc4
DIFF: https://github.com/llvm/llvm-project/commit/faa1842875f1dcd241c6b0feab7d684eb97fefc4.diff

LOG: [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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 49855b25e8556..3b07cf12719db 100644
--- 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
index 19c7814a646cd..8a2fed9e7290b 100644
--- 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
index f4c3d16f6be48..99329ff795fca 100644
--- 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
index 2a666b5af547d..02779a857d262 100644
--- 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
index d22a253a757f5..ce573095b1cd5 100644
--- 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)(), ""); }