[flang] [llvm] [flang/flang-rt] Implement PERROR intrinsic form GNU Extension (PR #132406)
Jean-Didier PAILLEUX via llvm-commits
llvm-commits at lists.llvm.org
Mon Mar 31 02:17:14 PDT 2025
https://github.com/JDPailleux updated https://github.com/llvm/llvm-project/pull/132406
>From 6c98e3205a90b97a05305b1bde381d739ceb5594 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Thu, 20 Mar 2025 11:33:18 +0100
Subject: [PATCH] [flang/flang-rt] Implement PERROR intrinsic form GNU
Extension
---
flang-rt/lib/runtime/extensions.cpp | 4 +++
flang/docs/Intrinsics.md | 12 ++++++++
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../flang/Optimizer/Builder/Runtime/Command.h | 5 ++++
flang/include/flang/Runtime/extensions.h | 3 ++
flang/lib/Evaluate/intrinsics.cpp | 2 ++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 15 ++++++++++
.../lib/Optimizer/Builder/Runtime/Command.cpp | 11 +++++++
flang/test/Lower/Intrinsics/perror.f90 | 30 +++++++++++++++++++
9 files changed, 83 insertions(+)
create mode 100644 flang/test/Lower/Intrinsics/perror.f90
diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp
index 7e9e512778a75..618e184e28519 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>
@@ -268,5 +269,8 @@ void FORTRAN_PROCEDURE_NAME(qsort)(int *array, int *len, int *isize,
qsort(array, *len, *isize, compar);
}
+// PERROR(STRING)
+void RTNAME(Perror)(const char *str) { perror(str); }
+
} // namespace Fortran::runtime
} // extern "C"
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index eb09d550504d0..1ac20d7caf82f 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1137,3 +1137,15 @@ by `ISIZE`.
- **Standard:** lib3f (section 3f of old man pages).
- **Class:** subroutine
- **Syntax:** `CALL QSORT(ARRAY, LEN, ISIZE, COMPAR)`
+
+### 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/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 589a936f8b8c7..a0e2125ffd240 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -371,6 +371,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genPack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genParity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ void genPerror(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genPopcnt(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 0d60a367d9998..cea21f7bff63a 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -58,5 +58,10 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value c);
+/// Generate a call to the Perror runtime function which implements
+/// the PERROR GNU intrinsic.
+void genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value string);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h
index 133194dea87cf..e626f7b847bec 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 RTNAME(Perror)(const char *str);
+
} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index fe691e85ee011..28ea6183971e8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1555,6 +1555,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
+ {"perror", {{"string", DefaultChar, Rank::scalar}}, {}, Rank::elemental,
+ IntrinsicClass::impureSubroutine},
{"mvbits",
{{"from", SameIntOrUnsigned}, {"frompos", AnyInt}, {"len", AnyInt},
{"to", SameIntOrUnsigned, Rank::elemental, Optionality::required,
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index f57ed41fd785d..1c064e5b58049 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -749,6 +749,10 @@ static constexpr IntrinsicHandler handlers[]{
&I::genParity,
{{{"mask", asBox}, {"dim", asValue}}},
/*isElemental=*/false},
+ {"perror",
+ &I::genPerror,
+ {{{"string", asBox}}},
+ /*isElemental*/ false},
{"popcnt", &I::genPopcnt},
{"poppar", &I::genPoppar},
{"present",
@@ -7085,6 +7089,17 @@ IntrinsicLibrary::genParity(mlir::Type resultType,
return readAndAddCleanUp(resultMutableBox, resultType, "PARITY");
}
+// PERROR
+void IntrinsicLibrary::genPerror(llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+
+ fir::ExtendedValue str = args[0];
+ const auto *box = str.getBoxOf<fir::BoxValue>();
+ mlir::Value addr =
+ builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), fir::getBase(*box));
+ fir::runtime::genPerror(builder, loc, addr);
+}
+
// POPCNT
mlir::Value IntrinsicLibrary::genPopcnt(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 8320d89493b33..0c7b6e454789c 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -10,6 +10,7 @@
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
#include "flang/Runtime/command.h"
+#include "flang/Runtime/extensions.h"
using namespace Fortran::runtime;
@@ -101,3 +102,13 @@ mlir::Value fir::runtime::genGetCwd(fir::FirOpBuilder &builder,
builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
+
+void fir::runtime::genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value string) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(Perror)>(loc, builder);
+ mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, string);
+ builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
diff --git a/flang/test/Lower/Intrinsics/perror.f90 b/flang/test/Lower/Intrinsics/perror.f90
new file mode 100644
index 0000000000000..c44e834b11f7f
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/perror.f90
@@ -0,0 +1,30 @@
+! 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
+ character(len=1) :: one
+ ! CHECK: %[[C6:.*]] = arith.constant 6 : index
+ ! CHECK: %[[C10:.*]] = arith.constant 10 : index
+ ! CHECK: %[[C1:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.char<1> {bindc_name = "one", uniq_name = "_QFtest_perrorEone"}
+ ! CHECK: %[[VAL_1:.*]] = fir.declare %[[VAL_0]] typeparams %[[C1]] {uniq_name = "_QFtest_perrorEone"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "string", uniq_name = "_QFtest_perrorEstring"}
+ ! CHECK: %[[VAL_3:.*]] = fir.declare %[[VAL_2]] typeparams %[[C10]] {uniq_name = "_QFtest_perrorEstring"} : (!fir.ref<!fir.char<1,10>>, index) -> !fir.ref<!fir.char<1,10>>
+
+ call perror(string)
+ ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAPerror(%[[VAL_4]]) fastmath<contract> : (!fir.ref<i8>) -> ()
+
+ call perror("prefix")
+ ! CHECK: %[[VAL_5:.*]] = fir.address_of(@{{.*}}) : !fir.ref<!fir.char<1,6>>
+ ! CHECK: %[[VAL_6:.*]] = fir.declare %[[VAL_5]] typeparams %[[C6]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = {{.*}}} : (!fir.ref<!fir.char<1,6>>, index) -> !fir.ref<!fir.char<1,6>>
+ ! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.char<1,6>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAPerror(%[[VAL_7]]) fastmath<contract> : (!fir.ref<i8>) -> ()
+
+ call perror(one)
+ ! CHECK: %[[VAL_8:.*]] = fir.convert %1 : (!fir.ref<!fir.char<1>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @_FortranAPerror(%[[VAL_8]]) fastmath<contract> : (!fir.ref<i8>) -> ()
+
+end subroutine test_perror
More information about the llvm-commits
mailing list