[flang-commits] [flang] a2d74bf - [flang][OpenMP] Implement the error directive (#206175)

via flang-commits flang-commits at lists.llvm.org
Fri Jul 24 07:43:10 PDT 2026


Author: Caroline Newcombe
Date: 2026-07-24T10:43:05-04:00
New Revision: a2d74bfe386695ee1a17ba3b60367fb79c3bfdfe

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

LOG: [flang][OpenMP] Implement the error directive (#206175)

## [flang][OpenMP] Implement the `error` directive

### Summary

Implements the OpenMP `error` directive (OpenMP 5.1, 2.5.4) in Flang.
The directive prints a message and, with `severity(fatal)`, stops.
Handling depends on the `at` clause:

- **`at(compilation)`** (the default): handled in semantics. Emits a
compile-time warning or error and produces no IR.
- **`at(execution)`**: lowered to a new `omp.error` op, which becomes a
call to `__kmpc_error`.

Before this patch the directive was unimplemented and hit a `not yet
implemented: OmpErrorDirective` error during lowering.

Fixes #204240.

### Details

Changes go through the compiler pipeline.

**Flang semantics**
- `Enter(OmpErrorDirective)` emits the compile-time diagnostic for the
`at(compilation)` form, using the directive's severity and the `MESSAGE`
text when present.
- `Enter(OmpClause::Message)` checks that the `MESSAGE` expression is a
scalar, default-kind `CHARACTER`, which is required to pass it to the
runtime as a `const char*`.

**Flang lowering**
- `genErrorDirective` lowers the `at(execution)` form only.
- A constant message is stored in the `message` attribute. A
non-constant message is copied to a null-terminated buffer
(`genNullTerminatedString`) and passed as the `message_expr` operand,
because `__kmpc_error` expects a NUL-terminated string.

**New `omp.error` op (MLIR OpenMP dialect)**
- Adds a `ClauseSeverity` enum (`warning = 1`, `fatal = 2`, matching the
`__kmpc_error` argument) and `ClauseSeverityAttr`.
- `omp.error` takes a required `severity` attribute and an optional
message, given either as:
  - `message` — a constant string attribute, or
  - `message_expr` — a pointer to a null-terminated string.
- A verifier rejects providing both `message` and `message_expr`.

**MLIR → LLVM IR translation**
- Translates `omp.error` to `__kmpc_error(ident_t *, i32 severity, ptr
message)`.

**OMPIRBuilder**
- Adds `OpenMPIRBuilder::createError(...)`, which builds the call, maps
`fatal`→`2` and `warning`→`1`, and passes a null pointer when there is
no message.

### Tests

- **Parser** (`error-unparse.f90`): unparse and parse-tree output.
`at(compilation) severity(fatal)` cases that would stop compilation were
moved to `at(execution)`.
- **Semantics** (`Semantics/OpenMP/error.f90`): compilation
warning/error/default-severity cases, plus the new `MESSAGE` type, rank,
and kind errors.
- **Lowering** (`Lower/OpenMP/error.f90`): constant message, no message,
empty message, runtime `message_expr`, and `at(compilation)` cases that
must not produce `omp.error`. The old `Lower/OpenMP/Todo/error.f90` test
is removed.
- **MLIR** (`ops.mlir`, `invalid.mlir`): round-trip of each `omp.error`
form and the both-messages verifier error.
- **LLVM IR** (`openmp-llvm.mlir`): `__kmpc_error` calls for warning and
fatal, constant and runtime messages, and the null-message cases.

Assisted-by: Github Copilot

Added: 
    flang/test/Lower/OpenMP/error.f90

Modified: 
    flang/include/flang/Semantics/openmp-utils.h
    flang/lib/Lower/OpenMP/OpenMP.cpp
    flang/lib/Semantics/check-omp-structure.cpp
    flang/lib/Semantics/check-omp-structure.h
    flang/lib/Semantics/openmp-utils.cpp
    flang/test/Parser/OpenMP/error-unparse.f90
    flang/test/Semantics/OpenMP/error.f90
    llvm/include/llvm/Frontend/OpenMP/OMPIRBuilder.h
    llvm/lib/Frontend/OpenMP/OMPIRBuilder.cpp
    mlir/include/mlir/Dialect/OpenMP/OpenMPEnums.td
    mlir/include/mlir/Dialect/OpenMP/OpenMPOps.td
    mlir/lib/Dialect/OpenMP/IR/OpenMPDialect.cpp
    mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
    mlir/test/Dialect/OpenMP/invalid.mlir
    mlir/test/Dialect/OpenMP/ops.mlir
    mlir/test/Target/LLVMIR/openmp-llvm.mlir

Removed: 
    flang/test/Lower/OpenMP/Todo/error.f90


################################################################################
diff  --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 496cad0b3bd57..031926d4a7cc2 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -298,6 +298,21 @@ bool HasDataEnvironment(llvm::omp::Directive dir);
 
 bool IsFullUnroll(const parser::OmpDirectiveSpecification &spec);
 
+/// The AT, SEVERITY, and MESSAGE clause values of an `!$omp error` directive.
+/// `at` and `severity` default to AT(compilation)/SEVERITY(fatal) when absent;
+/// `message` is null when there is no MESSAGE clause.
+struct OmpErrorArgs {
+  parser::OmpAtClause::ActionTime at{
+      parser::OmpAtClause::ActionTime::Compilation};
+  parser::OmpSeverityClause::SevLevel severity{
+      parser::OmpSeverityClause::SevLevel::Fatal};
+  const parser::Expr *message{nullptr};
+};
+
+/// Scan the clause list of an `!$omp error` directive for its AT, SEVERITY, and
+/// MESSAGE clause values.
+OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir);
+
 inline bool IsDoConcurrentLegal(unsigned version) {
   // DO CONCURRENT is allowed (as an alternative to a Canonical Loop Nest)
   // in OpenMP 6.0+.

diff  --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 996599212f5b9..9807023935784 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -34,6 +34,7 @@
 #include "flang/Lower/Support/ReductionProcessor.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
@@ -6604,6 +6605,98 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
                 queue.begin(), critName);
 }
 
+// Copy the character value `str` into fresh stack memory with an appended NUL
+// and return a pointer to its first character. Fortran characters are not
+// NUL-terminated, so the terminator is needed for C runtime entry points (such
+// as `__kmpc_error`) that expect a NUL-terminated string.
+static mlir::Value genNullTerminatedString(fir::FirOpBuilder &builder,
+                                           mlir::Location loc,
+                                           const fir::ExtendedValue &str) {
+  fir::factory::CharacterExprHelper helper(builder, loc);
+  const mlir::Value addr = fir::getBase(str);
+  const mlir::Value len = fir::getLen(str);
+  const auto charTy =
+      mlir::cast<fir::CharacterType>(fir::unwrapRefType(addr.getType()));
+  mlir::MLIRContext *ctx = builder.getContext();
+  const mlir::Type idxTy = builder.getIndexType();
+  const mlir::Value idxLen = builder.createConvert(loc, idxTy, len);
+  const mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+  const mlir::Value lenPlusOne =
+      mlir::arith::AddIOp::create(builder, loc, idxLen, one);
+
+  // Allocate `len + 1` characters and copy the message into them, leaving room
+  // for the terminating NUL.
+  const fir::CharBoxValue temp = helper.createCharacterTemp(charTy, lenPlusOne);
+  helper.createCopy(temp, fir::CharBoxValue{addr, len}, len);
+
+  // Address the buffer as an array of single characters so the terminating NUL
+  // can be stored at index `len`.
+  const auto singleTy = fir::CharacterType::get(
+      ctx, charTy.getFKind(), fir::CharacterType::singleton());
+  const mlir::Type singleRefTy = builder.getRefType(singleTy);
+  const mlir::Type seqRefTy = builder.getRefType(fir::SequenceType::get(
+      {fir::SequenceType::getUnknownExtent()}, singleTy));
+  const mlir::Value seq =
+      builder.createConvert(loc, seqRefTy, temp.getBuffer());
+  const mlir::Value nulAddr =
+      fir::CoordinateOp::create(builder, loc, singleRefTy, seq, idxLen);
+  const mlir::Value zero =
+      builder.createIntegerConstant(loc, builder.getI8Type(), 0);
+  const mlir::Value nul =
+      helper.createSingletonFromCode(zero, charTy.getFKind());
+  fir::StoreOp::create(builder, loc, nul, nulAddr);
+
+  // Pass a pointer to the first character of the buffer.
+  return builder.createConvert(loc, singleRefTy, temp.getBuffer());
+}
+
+// Lower an `!$omp error` directive. The `at(compilation)` form is handled
+// entirely in semantics, so only the `at(execution)` form reaches lowering,
+// where it becomes an `omp.error` operation.
+static void genErrorDirective(lower::AbstractConverter &converter,
+                              semantics::SemanticsContext &semaCtx,
+                              const parser::OmpErrorDirective &errDir) {
+  const semantics::omp::OmpErrorArgs args{
+      semantics::omp::GetErrorDirectiveArgs(errDir)};
+
+  if (args.at != parser::OmpAtClause::ActionTime::Execution ||
+      semaCtx.langOptions().OpenMPSimd)
+    return;
+
+  std::optional<std::string> message;
+  MaybeExpr messageExpr;
+  if (args.message) {
+    if (auto expr = semantics::omp::GetEvaluateExpr(*args.message)) {
+      if (auto val = evaluate::GetScalarConstantValue<evaluate::Ascii>(*expr))
+        message = *val;
+      else
+        messageExpr = expr;
+    }
+  }
+
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  const mlir::Location loc = converter.getCurrentLocation();
+  const mlir::omp::ClauseSeverity sev =
+      args.severity == parser::OmpSeverityClause::SevLevel::Warning
+          ? mlir::omp::ClauseSeverity::warning
+          : mlir::omp::ClauseSeverity::fatal;
+
+  // A compile-time-constant message is stored directly on the operation as an
+  // attribute. A non-constant message is lowered to a null-terminated string in
+  // memory and passed as the `message_expr` operand.
+  mlir::StringAttr msgAttr;
+  mlir::Value msgExprVal;
+  if (message) {
+    msgAttr = builder.getStringAttr(*message);
+  } else if (messageExpr) {
+    lower::StatementContext stmtCtx;
+    fir::ExtendedValue str = converter.genExprAddr(loc, *messageExpr, stmtCtx);
+    msgExprVal = genNullTerminatedString(builder, loc, str);
+  }
+
+  mlir::omp::ErrorOp::create(builder, loc, sev, msgAttr, msgExprVal);
+}
+
 static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
                    semantics::SemanticsContext &semaCtx,
                    lower::pft::Evaluation &eval,
@@ -6612,10 +6705,8 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
                     [&](const parser::OmpNothingDirective &) {
                       // nothing-directive is a no-op (OpenMP 5.2 [8.4])
                     },
-                    [&](const parser::OmpErrorDirective &) {
-                      if (!semaCtx.langOptions().OpenMPSimd)
-                        TODO(converter.getCurrentLocation(),
-                             "OmpErrorDirective");
+                    [&](const parser::OmpErrorDirective &errDir) {
+                      genErrorDirective(converter, semaCtx, errDir);
                     },
                 },
                 dir.u);

diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 0547baaa4ecba..f77382c9045fc 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2725,6 +2725,30 @@ void OmpStructureChecker::Enter(const parser::OpenMPDispatchConstruct &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpErrorDirective &x) {
+  const OmpErrorArgs args{GetErrorDirectiveArgs(x)};
+
+  // The AT(execution) form (non-default) is handled at run time.
+  if (args.at != parser::OmpAtClause::ActionTime::Compilation) {
+    return;
+  }
+
+  std::optional<std::string> message;
+  if (args.message) {
+    if (auto expr{GetEvaluateExpr(*args.message)}) {
+      if (auto val{evaluate::GetScalarConstantValue<evaluate::Ascii>(*expr)}) {
+        message = *val;
+      }
+    }
+  }
+
+  if (args.severity == parser::OmpSeverityClause::SevLevel::Warning) {
+    context_.Say(x.v.source, "%s"_warn_en_US, message.value_or("WARNING"));
+  } else {
+    context_.Say(x.v.source, "%s"_err_en_US, message.value_or("ERROR"));
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
   if (GetDirectiveNest(DeclarativeNest) > 0) {
     if (x.v.v == parser::OmpAtClause::ActionTime::Execution) {
@@ -2734,6 +2758,24 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
   }
 }
 
+void OmpStructureChecker::Enter(const parser::OmpClause::Message &x) {
+  if (const auto expr{GetEvaluateExpr(x.v.v)}) {
+    const std::optional<evaluate::DynamicType> type{expr->GetType()};
+    if (!type || type->category() != evaluate::TypeCategory::Character) {
+      context_.Say(GetContext().clauseSource,
+          "The MESSAGE clause expression must be of type CHARACTER"_err_en_US);
+    } else if (expr->Rank() != 0) {
+      context_.Say(GetContext().clauseSource,
+          "The MESSAGE clause expression must be scalar"_err_en_US);
+    } else if (type->kind() !=
+        context_.defaultKinds().GetDefaultKind(
+            evaluate::TypeCategory::Character)) {
+      context_.Say(GetContext().clauseSource,
+          "The MESSAGE clause expression must be of default character kind"_err_en_US);
+    }
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
   const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
   const parser::OmpDirectiveName &dirName{beginSpec.DirName()};

diff  --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 0f21bbd19189e..22106020bcc3b 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -145,6 +145,8 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void Enter(const parser::OmpDirectiveSpecification &);
   void Leave(const parser::OmpDirectiveSpecification &);
 
+  void Enter(const parser::OmpErrorDirective &);
+
   void Enter(const parser::OmpMetadirectiveDirective &);
   void Leave(const parser::OmpMetadirectiveDirective &);
 
@@ -202,6 +204,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
   void Enter(const parser::OmpClause::Linear &x);
   void Enter(const parser::OmpClause::Looprange &x);
   void Enter(const parser::OmpClause::Map &x);
+  void Enter(const parser::OmpClause::Message &x);
   void Enter(const parser::OmpClause::NumTeams &x);
   void Enter(const parser::OmpClause::NumThreads &x);
   void Enter(const parser::OmpClause::OmpxBare &x);

diff  --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 27d23a9ffde30..731d98f1103a5 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -920,6 +920,22 @@ bool IsFullUnroll(const parser::OmpDirectiveSpecification &spec) {
   return false;
 }
 
+OmpErrorArgs GetErrorDirectiveArgs(const parser::OmpErrorDirective &errDir) {
+  OmpErrorArgs args;
+  for (const parser::OmpClause &clause : errDir.v.Clauses().v) {
+    if (const auto *at{std::get_if<parser::OmpClause::At>(&clause.u)}) {
+      args.at = at->v.v;
+    } else if (const auto *sev{
+                   std::get_if<parser::OmpClause::Severity>(&clause.u)}) {
+      args.severity = sev->v.v;
+    } else if (const auto *msg{
+                   std::get_if<parser::OmpClause::Message>(&clause.u)}) {
+      args.message = &msg->v.v;
+    }
+  }
+  return args;
+}
+
 static bool IsTransformableLoop(const parser::OmpDirectiveSpecification &spec) {
   return !IsFullUnroll(spec) && IsLoopTransforming(spec.DirId());
 }

diff  --git a/flang/test/Lower/OpenMP/Todo/error.f90 b/flang/test/Lower/OpenMP/Todo/error.f90
deleted file mode 100644
index c8338278a4267..0000000000000
--- a/flang/test/Lower/OpenMP/Todo/error.f90
+++ /dev/null
@@ -1,7 +0,0 @@
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
-
-! CHECK: not yet implemented: OmpErrorDirective
-program p
-  integer, allocatable :: x
-  !$omp error at(compilation) severity(warning) message("an error")
-end program p

diff  --git a/flang/test/Lower/OpenMP/error.f90 b/flang/test/Lower/OpenMP/error.f90
new file mode 100644
index 0000000000000..fbca3ec4f45e2
--- /dev/null
+++ b/flang/test/Lower/OpenMP/error.f90
@@ -0,0 +1,47 @@
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s
+
+! Lowering of `!$omp error at(execution)` to the `omp.error` operation. The
+! `at(compilation)` form is handled entirely in semantics and produces no IR.
+! Severity is `warning` or `fatal` (default `fatal`); the message is an optional
+! constant string that is omitted when absent. A non-constant message is lowered
+! to a null-terminated runtime string and passed as an operand.
+
+! CHECK-LABEL: func.func @_QQmain()
+program p
+  ! CHECK: omp.error severity(warning) message("a warning")
+  !$omp error at(execution) severity(warning) message("a warning")
+
+  ! CHECK: omp.error severity(fatal) message("fatal error")
+  !$omp error at(execution) severity(fatal) message("fatal error")
+
+  ! No MESSAGE clause; severity defaults to `fatal`.
+  ! CHECK: omp.error severity(fatal)
+  !$omp error at(execution)
+
+  ! An explicit empty MESSAGE string is lowered to an empty constant `message`
+  ! attribute (distinct from an absent clause) at the HLFIR level.
+  ! CHECK: omp.error severity(warning) message("")
+  !$omp error at(execution) severity(warning) message("")
+end program p
+
+! A non-constant MESSAGE is only known at run time, so it is lowered to a
+! null-terminated copy in memory and passed as the `message_expr` operand
+! instead of as a constant attribute.
+! CHECK-LABEL: func.func @_QPf_runtime_message
+subroutine f_runtime_message
+  character(len=16) :: msg
+  msg = "runtime warning"
+  ! CHECK: omp.error severity(warning) message_expr(%{{.*}} : !fir.ref<!fir.char<1>>)
+  !$omp error at(execution) severity(warning) message(msg)
+end subroutine f_runtime_message
+
+! The `at(compilation)` form (and the implicit default, which is also
+! compilation) is resolved entirely in semantics and must not lower to an
+! `omp.error` operation. `severity(warning)` keeps these as non-fatal
+! diagnostics so compilation still succeeds.
+! CHECK-LABEL: func.func @_QPf_compilation
+subroutine f_compilation
+  ! CHECK-NOT: omp.error
+  !$omp error severity(warning) message("implicit compilation")
+  !$omp error at(compilation) severity(warning) message("explicit compilation")
+end subroutine f_compilation

diff  --git a/flang/test/Parser/OpenMP/error-unparse.f90 b/flang/test/Parser/OpenMP/error-unparse.f90
index 0902d109fd233..5689de8374297 100644
--- a/flang/test/Parser/OpenMP/error-unparse.f90
+++ b/flang/test/Parser/OpenMP/error-unparse.f90
@@ -1,27 +1,37 @@
-! RUN: %flang_fc1  -fopenmp-version=51 -fopenmp -fdebug-unparse %s 2>&1 | FileCheck %s
-! RUN: %flang_fc1  -fopenmp-version=51 -fopenmp -fdebug-dump-parse-tree %s 2>&1 | FileCheck %s --check-prefix="PARSE-TREE"
+! RUN: %flang_fc1  -fopenmp-version=51 -fopenmp -fdebug-unparse-no-sema %s 2>&1 | FileCheck %s
+! RUN: %flang_fc1  -fopenmp-version=51 -fopenmp -fdebug-dump-parse-tree-no-sema %s 2>&1 | FileCheck %s --check-prefix="PARSE-TREE"
+
+! Compilation-time diagnostics are covered by Semantics/OpenMP/error.f90.
 program main
   character(*), parameter :: message = "This is an error"
   !CHECK: !$OMP ERROR AT(COMPILATION) SEVERITY(WARNING) MESSAGE("some message here")
-  !PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpUtilityDirective -> OmpErrorDirective
+  !PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpUtilityDirective -> OmpErrorDirective -> OmpDirectiveSpecification
+  !PARSE-TREE: OmpDirectiveName -> llvm::omp::Directive = error
   !PARSE-TREE: OmpClauseList -> OmpClause -> At -> OmpAtClause -> ActionTime = Compilation
   !PARSE-TREE: OmpClause -> Severity -> OmpSeverityClause -> SevLevel = Warning
-  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr = '"some message here"'
-  !PARSE-TREE:  LiteralConstant -> CharLiteralConstant
+  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr -> LiteralConstant -> CharLiteralConstant
   !PARSE-TREE:  string = 'some message here'
   !$omp error at(compilation) severity(warning) message("some message here")
-  !CHECK: !$OMP ERROR AT(COMPILATION) SEVERITY(FATAL) MESSAGE("This is an error")
-  !PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpUtilityDirective -> OmpErrorDirective
+  !CHECK: !$OMP ERROR AT(COMPILATION) SEVERITY(FATAL) MESSAGE(message)
+  !PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpUtilityDirective -> OmpErrorDirective -> OmpDirectiveSpecification
+  !PARSE-TREE: OmpDirectiveName -> llvm::omp::Directive = error
   !PARSE-TREE: OmpClauseList -> OmpClause -> At -> OmpAtClause -> ActionTime = Compilation
   !PARSE-TREE: OmpClause -> Severity -> OmpSeverityClause -> SevLevel = Fatal
-  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr = '"This is an error"'
-  !PARSE-TREE:  Designator -> DataRef -> Name = 'message'
+  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr -> Designator -> DataRef -> Name = 'message'
   !$omp error at(compilation) severity(fatal) message(message)
-  !CHECK: !$OMP ERROR AT(EXECUTION) SEVERITY(FATAL) MESSAGE("This is an error")
-  !PARSE-TREE: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpUtilityDirective -> OmpErrorDirective
+  !CHECK: !$OMP ERROR AT(EXECUTION) SEVERITY(FATAL) MESSAGE(message)
+  !PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpUtilityDirective -> OmpErrorDirective -> OmpDirectiveSpecification
+  !PARSE-TREE: OmpDirectiveName -> llvm::omp::Directive = error
   !PARSE-TREE: OmpClauseList -> OmpClause -> At -> OmpAtClause -> ActionTime = Execution
   !PARSE-TREE: OmpClause -> Severity -> OmpSeverityClause -> SevLevel = Fatal
-  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr = '"This is an error"'
-  !PARSE-TREE:  Designator ->  DataRef -> Name = 'message'
+  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr -> Designator -> DataRef -> Name = 'message'
   !$omp error at(EXECUTION) severity(fatal) message(message)
+  !CHECK: !$OMP ERROR AT(EXECUTION) SEVERITY(WARNING) MESSAGE("a warning")
+  !PARSE-TREE: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpUtilityDirective -> OmpErrorDirective -> OmpDirectiveSpecification
+  !PARSE-TREE: OmpDirectiveName -> llvm::omp::Directive = error
+  !PARSE-TREE: OmpClauseList -> OmpClause -> At -> OmpAtClause -> ActionTime = Execution
+  !PARSE-TREE: OmpClause -> Severity -> OmpSeverityClause -> SevLevel = Warning
+  !PARSE-TREE:  OmpClause -> Message -> OmpMessageClause -> Expr -> LiteralConstant -> CharLiteralConstant
+  !PARSE-TREE:  string = 'a warning'
+  !$omp error at(execution) severity(warning) message("a warning")
 end program main

diff  --git a/flang/test/Semantics/OpenMP/error.f90 b/flang/test/Semantics/OpenMP/error.f90
index 067417a8cda3b..97eaa48d9899e 100644
--- a/flang/test/Semantics/OpenMP/error.f90
+++ b/flang/test/Semantics/OpenMP/error.f90
@@ -6,3 +6,46 @@ subroutine f00(x)
   integer :: x
 end
 
+subroutine f01
+!ERROR: an error
+  !$omp error at(compilation) severity(fatal) message("an error")
+end
+
+subroutine f02
+!WARNING: a warning
+  !$omp error at(compilation) severity(warning) message("a warning")
+end
+
+subroutine f03
+!ERROR: ERROR
+  !$omp error
+end
+
+subroutine f04
+!ERROR: ERROR
+  !$omp error at(compilation) severity(fatal)
+end
+
+subroutine f05
+!WARNING: WARNING
+  !$omp error at(compilation) severity(warning)
+end
+
+subroutine f06(n)
+  integer :: n
+!ERROR: The MESSAGE clause expression must be of type CHARACTER
+  !$omp error at(execution) severity(warning) message(n)
+end
+
+subroutine f07(c)
+  character(len=8) :: c(4)
+!ERROR: The MESSAGE clause expression must be scalar
+  !$omp error at(execution) severity(warning) message(c)
+end
+
+subroutine f08
+  character(kind=4, len=8) :: c
+!ERROR: The MESSAGE clause expression must be of default character kind
+  !$omp error at(execution) severity(warning) message(c)
+end
+

diff  --git a/llvm/include/llvm/Frontend/OpenMP/OMPIRBuilder.h b/llvm/include/llvm/Frontend/OpenMP/OMPIRBuilder.h
index fee8c712998b5..05307414c94d0 100644
--- a/llvm/include/llvm/Frontend/OpenMP/OMPIRBuilder.h
+++ b/llvm/include/llvm/Frontend/OpenMP/OMPIRBuilder.h
@@ -1497,6 +1497,18 @@ class OpenMPIRBuilder {
   /// \param Loc The location where the flush directive was encountered
   LLVM_ABI void createFlush(const LocationDescription &Loc);
 
+  /// Generate a call to the runtime to emit the diagnostic of an OpenMP
+  /// `error` directive with `at(execution)`.
+  ///
+  /// \param Loc The location where the error directive was encountered; it is
+  ///        used to build the `ident_t` passed to the runtime.
+  /// \param IsFatal Selects `severity(fatal)` (true) or `severity(warning)`
+  ///        (false).
+  /// \param Message The message string (an `i8*`) to display, or null when no
+  ///        `message` clause is present.
+  LLVM_ABI void createError(const LocationDescription &Loc, bool IsFatal,
+                            Value *Message);
+
   /// Generator for '#omp taskyield'
   ///
   /// \param Loc The location where the taskyield directive was encountered.

diff  --git a/llvm/lib/Frontend/OpenMP/OMPIRBuilder.cpp b/llvm/lib/Frontend/OpenMP/OMPIRBuilder.cpp
index 57e199bdff09a..fc3812502fb2e 100644
--- a/llvm/lib/Frontend/OpenMP/OMPIRBuilder.cpp
+++ b/llvm/lib/Frontend/OpenMP/OMPIRBuilder.cpp
@@ -2184,6 +2184,25 @@ void OpenMPIRBuilder::createFlush(const LocationDescription &Loc) {
   emitFlush(Loc);
 }
 
+void OpenMPIRBuilder::createError(const LocationDescription &Loc, bool IsFatal,
+                                  Value *Message) {
+  if (!updateToLocation(Loc))
+    return;
+
+  // Build call void __kmpc_error(ident_t *loc, int severity,
+  //                              const char *message)
+  uint32_t SrcLocStrSize;
+  Constant *SrcLocStr = getOrCreateSrcLocStr(Loc, SrcLocStrSize);
+  Value *Ident = getOrCreateIdent(SrcLocStr, SrcLocStrSize);
+  // Severity: 1 = warning, 2 = fatal.
+  Value *Severity = ConstantInt::get(Int32, IsFatal ? 2 : 1);
+  Value *MessageArg = Message ? Message : ConstantPointerNull::get(Int8Ptr);
+  Value *Args[] = {Ident, Severity, MessageArg};
+
+  createRuntimeFunctionCall(getOrCreateRuntimeFunctionPtr(OMPRTL___kmpc_error),
+                            Args);
+}
+
 void OpenMPIRBuilder::emitTaskyieldImpl(const LocationDescription &Loc) {
   // Build call __kmpc_omp_taskyield(loc, thread_id, 0);
   uint32_t SrcLocStrSize;

diff  --git a/mlir/include/mlir/Dialect/OpenMP/OpenMPEnums.td b/mlir/include/mlir/Dialect/OpenMP/OpenMPEnums.td
index e373d1a52a3fc..c642792f67019 100644
--- a/mlir/include/mlir/Dialect/OpenMP/OpenMPEnums.td
+++ b/mlir/include/mlir/Dialect/OpenMP/OpenMPEnums.td
@@ -77,6 +77,26 @@ def ClauseDependAttr : OpenMP_EnumAttr<ClauseDepend, "clause_depend"> {
   let assemblyFormat = "`(` $value `)`";
 }
 
+//===----------------------------------------------------------------------===//
+// severity enum.
+//===----------------------------------------------------------------------===//
+
+// The values match the `severity` argument expected by the `__kmpc_error`
+// runtime entry point (1 = warning, 2 = fatal).
+def ClauseSeverityWarning : I32EnumAttrCase<"warning", 1>;
+def ClauseSeverityFatal : I32EnumAttrCase<"fatal", 2>;
+
+def ClauseSeverity : OpenMP_I32EnumAttr<
+    "ClauseSeverity",
+    "severity clause", [
+      ClauseSeverityWarning,
+      ClauseSeverityFatal
+    ]>;
+
+def ClauseSeverityAttr : OpenMP_EnumAttr<ClauseSeverity, "clause_severity"> {
+  let assemblyFormat = "`(` $value `)`";
+}
+
 //===----------------------------------------------------------------------===//
 // clause_requires enum.
 //===----------------------------------------------------------------------===//

diff  --git a/mlir/include/mlir/Dialect/OpenMP/OpenMPOps.td b/mlir/include/mlir/Dialect/OpenMP/OpenMPOps.td
index 0a5736f46b088..70597b85902c5 100644
--- a/mlir/include/mlir/Dialect/OpenMP/OpenMPOps.td
+++ b/mlir/include/mlir/Dialect/OpenMP/OpenMPOps.td
@@ -1775,6 +1775,37 @@ def BarrierOp : OpenMP_Op<"barrier"> {
   let assemblyFormat = "attr-dict";
 }
 
+//===----------------------------------------------------------------------===//
+// [5.1] 2.5.4 error directive
+//===----------------------------------------------------------------------===//
+
+def ErrorOp : OpenMP_Op<"error"> {
+  let summary = "error directive";
+  let description = [{
+    The error directive instructs the compiler or runtime to display a message
+    and, when the severity is `fatal`, to terminate execution. The
+    `at(compilation)` form is handled entirely by the frontend; this operation
+    represents only the `at(execution)` form, which lowers to a call to the
+    `__kmpc_error` runtime entry point.
+
+    The `severity` attribute selects `warning` or `fatal` behavior. The message
+    to display is optional and may be provided as a compile-time-constant
+    string in the `message` attribute, or a pointer to a null-terminated string.
+  }];
+
+  let arguments = (ins ClauseSeverityAttr:$severity,
+                       OptionalAttr<StrAttr>:$message,
+                       Optional<OpenMP_PointerLikeType>:$message_expr);
+
+  let assemblyFormat = [{
+    `severity` `(` custom<ClauseAttr>($severity) `)`
+    ( `message` `(` $message^ `)` )?
+    ( `message_expr` `(` $message_expr^ `:` type($message_expr) `)` )? attr-dict
+  }];
+
+  let hasVerifier = 1;
+}
+
 //===----------------------------------------------------------------------===//
 // [5.1] 2.19.9 ordered Construct
 //===----------------------------------------------------------------------===//

diff  --git a/mlir/lib/Dialect/OpenMP/IR/OpenMPDialect.cpp b/mlir/lib/Dialect/OpenMP/IR/OpenMPDialect.cpp
index 67bc2bdf35619..95ccb53bce3d4 100644
--- a/mlir/lib/Dialect/OpenMP/IR/OpenMPDialect.cpp
+++ b/mlir/lib/Dialect/OpenMP/IR/OpenMPDialect.cpp
@@ -4618,6 +4618,18 @@ LogicalResult CriticalOp::verifySymbolUses(SymbolTableCollection &symbolTable) {
   return success();
 }
 
+//===----------------------------------------------------------------------===//
+// Spec 5.1: Error directive (2.5.4)
+//===----------------------------------------------------------------------===//
+
+LogicalResult ErrorOp::verify() {
+  if (getMessage() && getMessageExpr())
+    return emitOpError() << "the message must be provided either as a constant "
+                            "`message` attribute or as a `message_expr` "
+                            "operand, but not both";
+  return success();
+}
+
 //===----------------------------------------------------------------------===//
 // Ordered construct
 //===----------------------------------------------------------------------===//

diff  --git a/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp b/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
index 1c38fd27daae1..97993a80926eb 100644
--- a/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
+++ b/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
@@ -9828,6 +9828,21 @@ LogicalResult OpenMPDialectLLVMIRTranslationInterface::convertOperation(
             ompBuilder->createFlush(builder);
             return success();
           })
+          .Case([&](omp::ErrorOp op) {
+            if (failed(checkImplementationStatus(*op)))
+              return failure();
+
+            llvm::Value *message = nullptr;
+            if (mlir::Value messageExpr = op.getMessageExpr())
+              message = moduleTranslation.lookupValue(messageExpr);
+            else if (std::optional<StringRef> msg = op.getMessage();
+                     msg && !msg->empty())
+              message = builder.CreateGlobalString(*msg);
+            ompBuilder->createError(
+                llvm::OpenMPIRBuilder::LocationDescription(builder),
+                op.getSeverity() == omp::ClauseSeverity::fatal, message);
+            return success();
+          })
           .Case([&](omp::ParallelOp op) {
             return convertOmpParallel(op, builder, moduleTranslation);
           })

diff  --git a/mlir/test/Dialect/OpenMP/invalid.mlir b/mlir/test/Dialect/OpenMP/invalid.mlir
index cf7be4eb638cc..a568bffe3cf99 100644
--- a/mlir/test/Dialect/OpenMP/invalid.mlir
+++ b/mlir/test/Dialect/OpenMP/invalid.mlir
@@ -4913,3 +4913,10 @@ func.func @omp_unroll_partial_factor_negative(%cli : !omp.cli) -> () {
   omp.unroll_partial(%cli) {unroll_factor = -1 : i64}
   return
 }
+
+// -----
+func.func @omp_error_message_and_message_expr(%msg : !llvm.ptr) -> () {
+  // expected-error @below {{the message must be provided either as a constant `message` attribute or as a `message_expr` operand, but not both}}
+  omp.error severity(warning) message("a warning") message_expr(%msg : !llvm.ptr)
+  return
+}

diff  --git a/mlir/test/Dialect/OpenMP/ops.mlir b/mlir/test/Dialect/OpenMP/ops.mlir
index d08ca5664efe4..ea25a0a75f646 100644
--- a/mlir/test/Dialect/OpenMP/ops.mlir
+++ b/mlir/test/Dialect/OpenMP/ops.mlir
@@ -60,6 +60,31 @@ func.func @omp_flush(%arg0 : memref<i32>) -> () {
   return
 }
 
+// CHECK-LABEL: func @omp_error
+func.func @omp_error(%msg : !llvm.ptr) -> () {
+  // Warning severity with a message.
+  // CHECK: omp.error severity(warning) message("a warning")
+  omp.error severity(warning) message("a warning")
+
+  // Fatal severity with a message.
+  // CHECK: omp.error severity(fatal) message("fatal error")
+  omp.error severity(fatal) message("fatal error")
+
+  // Fatal severity without a message.
+  // CHECK: omp.error severity(fatal)
+  omp.error severity(fatal)
+
+  // Warning severity without a message.
+  // CHECK: omp.error severity(warning)
+  omp.error severity(warning)
+
+  // Warning severity with a runtime message operand.
+  // CHECK: omp.error severity(warning) message_expr(%{{.*}} : !llvm.ptr)
+  omp.error severity(warning) message_expr(%msg : !llvm.ptr)
+
+  return
+}
+
 func.func @omp_terminator() -> () {
   // CHECK: omp.terminator
   omp.terminator

diff  --git a/mlir/test/Target/LLVMIR/openmp-llvm.mlir b/mlir/test/Target/LLVMIR/openmp-llvm.mlir
index db38c8da30777..d26557d57d0dd 100644
--- a/mlir/test/Target/LLVMIR/openmp-llvm.mlir
+++ b/mlir/test/Target/LLVMIR/openmp-llvm.mlir
@@ -41,6 +41,30 @@ llvm.func @test_flush_construct(%arg0: !llvm.ptr) {
   llvm.return
 }
 
+// CHECK-LABEL: define void @test_error_construct
+llvm.func @test_error_construct(%msg : !llvm.ptr) {
+  // Severity is 1 for `warning` and 2 for `fatal`; the message is a pointer to
+  // a constant string, or a null pointer when absent.
+  // CHECK: call void @__kmpc_error(ptr @{{[0-9]+}}, i32 1, ptr @{{.*}})
+  omp.error severity(warning) message("a warning")
+
+  // CHECK: call void @__kmpc_error(ptr @{{[0-9]+}}, i32 2, ptr @{{.*}})
+  omp.error severity(fatal) message("fatal error")
+
+  // A runtime message is passed through as the supplied pointer operand.
+  // CHECK: call void @__kmpc_error(ptr @{{[0-9]+}}, i32 1, ptr %{{.*}})
+  omp.error severity(warning) message_expr(%msg : !llvm.ptr)
+
+  // CHECK: call void @__kmpc_error(ptr @{{[0-9]+}}, i32 2, ptr null)
+  omp.error severity(fatal)
+
+  // CHECK: call void @__kmpc_error(ptr @{{[0-9]+}}, i32 1, ptr null)
+  omp.error severity(warning)
+
+  // CHECK-NEXT:    ret void
+  llvm.return
+}
+
 // CHECK-LABEL: define void @test_omp_parallel_1()
 llvm.func @test_omp_parallel_1() -> () {
   // CHECK: call void{{.*}}@__kmpc_fork_call{{.*}}@[[OMP_OUTLINED_FN_1:.*]])


        


More information about the flang-commits mailing list