[flang/flang-rt] Implement PERROR intrinsic form GNU Extension

[JDPailleux]

Add the implementation of the PERROR(STRING) intrinsic from the GNU Extension to prints on the stderr a newline-terminated error message corresponding to the last system error prefixed by STRING.
(https://gcc.gnu.org/onlinedocs/gfortran/PERROR.html)

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-fir-hlfir

Author: Jean-Didier PAILLEUX (JDPailleux)

Changes

Add the implementation of the PERROR(STRING) intrinsic from the GNU Extension to prints on the stderr a newline-terminated error message corresponding to the last system error prefixed by STRING.
(https://gcc.gnu.org/onlinedocs/gfortran/PERROR.html)

---

Full diff: https://github.com/llvm/llvm-project/pull/132406.diff

4 Files Affected:

• (modified) flang-rt/lib/runtime/extensions.cpp (+4)
• (modified) flang/docs/Intrinsics.md (+12)
• (modified) flang/include/flang/Runtime/extensions.h (+3)
• (added) flang/test/Lower/Intrinsics/perror.f90 (+14)

diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp
index 75195c33a6c21..c2d47a13d52dd 100644
--- a/flang-rt/lib/runtime/extensions.cpp
+++ b/flang-rt/lib/runtime/extensions.cpp
@@ -17,6 +17,7 @@
 #include "flang/Runtime/entry-names.h"
 #include "flang/Runtime/io-api.h"
 #include <chrono>
+#include <cstdio>
 #include <cstring>
 #include <ctime>
 #include <signal.h>
@@ -262,5 +263,8 @@ int RTNAME(Chdir)(const char *name) {
 
 int FORTRAN_PROCEDURE_NAME(ierrno)() { return errno; }
 
+// PERROR(STRING)
+void FORTRAN_PROCEDURE_NAME(perror)(const char *str) { perror(str); }
+
 } // namespace Fortran::runtime
 } // extern "C"
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5b671d1b2c740..2b5c3bc2fd089 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1106,3 +1106,15 @@ end program chdir_func
 - **Standard:** GNU extension
 - **Class:** function
 - **Syntax:** `RESULT = IERRNO()`
+
+### Non-Standard Intrinsics: PERROR
+
+#### Description
+`PERROR(STRING)` prints (on the C stderr stream) a newline-terminated error message corresponding to the last system error.
+This is prefixed by `STRING`, a colon and a space.
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** subroutine
+- **Syntax:** `CALL PERROR(STRING)`
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 133194dea87cf..b218b9b97ce10 100644
--- a/flang/include/flang/Runtime/extensions.h
+++ b/flang/include/flang/Runtime/extensions.h
@@ -75,5 +75,8 @@ int RTNAME(Chdir)(const char *name);
 // GNU extension function IERRNO()
 int FORTRAN_PROCEDURE_NAME(ierrno)();
 
+// GNU extension subroutine PERROR(STRING)
+void FORTRAN_PROCEDURE_NAME(perror)(const char *str);
+
 } // extern "C"
 #endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/test/Lower/Intrinsics/perror.f90 b/flang/test/Lower/Intrinsics/perror.f90
new file mode 100644
index 0000000000000..e42c109f6491c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/perror.f90
@@ -0,0 +1,14 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck --check-prefixes=CHECK %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck --check-prefixes=CHECK %s
+
+! CHECK-LABEL: func @_QPtest_perror(
+subroutine test_perror()
+  character(len=10) :: string
+  call perror(string)
+  ! CHECK: %[[C10:.*]] = arith.constant 10 : index
+  ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "string", uniq_name = "_QFtest_perrorEstring"}
+  ! CHECK: %[[VAL_1:.*]] = fir.declare %[[VAL_0]] typeparams %[[C10]] {uniq_name = "_QFtest_perrorEstring"} : (!fir.ref<!fir.char<1,10>>, index) -> !fir.ref<!fir.char<1,10>>
+  ! CHECK: %[[VAL_2:.*]] = fir.emboxchar %[[VAL_1]], %[[C10]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+  ! CHECK: fir.call @_QPperror(%[[VAL_2]]) fastmath<contract> : (!fir.boxchar<1>) -> () 
+  ! CHECK: return
+end subroutine test_perror

[tblah]

Thanks for adding this intrinsic

[tblah]

Thanks for the update. LGTM.

nit: please could you add a test where the box_addr is not canonicalized away? I think using a string as a subroutine argument where the length is not known at compile time should work.

[JDPailleux]

@tblah Thanks ! Test added for a string as a subroutine argument where the length is not known.

[tblah]

Thanks for the update. The new comment is a nit, feel free to merge without further approval once it is done.

[tblah]

Ahh sorry I didn't notice this before, please could you use -emit-hlfir and regenerate the test checks?

We test lowering to HLFIR separately from conversion from HLFIR to FIR so that each lit test is only checking one thing at a time. It makes it easier to see how the code changes added here are reflected in the pipeline if we aren't looking at a version that already had several complex passes run on it.

[klausler]

This code assumes that the Fortran character value is NUL-terminated, and ignores its length. The GNU documentation for PERROR does not require NUL termination.