* [committed] openmp: Implement the error directive
@ 2021-08-20 9:45 Jakub Jelinek
2021-08-20 10:00 ` [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive) Tobias Burnus
2021-08-20 13:11 ` [committed] openmp: Implement the error directive Thomas Schwinge
0 siblings, 2 replies; 9+ messages in thread
From: Jakub Jelinek @ 2021-08-20 9:45 UTC (permalink / raw)
To: gcc-patches; +Cc: Tobias Burnus
Hi!
This patch implements the error directive. Depending on clauses it is either
a compile time diagnostics (in that case diagnosed right away) or runtime
diagnostics (libgomp API call that diagnoses at runtime), and either fatal
or warning (error or warning at compile time or fatal error vs. error at
runtime) and either has no message or user supplied message (this kind of
e.g. deprecated attribute). The directive is also stand-alone directive
when at runtime while utility (thus disappears from the IL as if it wasn't
there for parsing like nothing directive) at compile time.
There are some clarifications in the works ATM, so this patch doesn't yet
require that for compile time diagnostics the user message must be a constant
string literal, there are uncertainities on what exactly is valid argument
of message clause (whether just const char * type, convertible to const char *,
qualified/unqualified const char * or char * or what else) and what to do
in templates. Currently even in templates it is diagnosed right away for
compile time diagnostics, if we'll need to substitute it, we'd need to queue
something into the IL, have pt.c handle it and diagnose only later.
Bootstrapped/regtested on x86_64-linux, committed to trunk.
2021-08-20 Jakub Jelinek <jakub@redhat.com>
gcc/
* omp-builtins.def (BUILT_IN_GOMP_WARNING, BUILT_IN_GOMP_ERROR): New
builtins.
gcc/c-family/
* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_ERROR.
* c-pragma.c (omp_pragmas): Add error directive.
* c-omp.c (omp_directives): Uncomment error directive entry.
gcc/c/
* c-parser.c (c_parser_omp_error): New function.
(c_parser_pragma): Handle PRAGMA_OMP_ERROR.
gcc/cp/
* parser.c (cp_parser_handle_statement_omp_attributes): Determine if
PRAGMA_OMP_ERROR directive is C_OMP_DIR_STANDALONE.
(cp_parser_omp_error): New function.
(cp_parser_pragma): Handle PRAGMA_OMP_ERROR.
gcc/fortran/
* types.def (BT_FN_VOID_CONST_PTR_SIZE): New DEF_FUNCTION_TYPE_2.
* f95-lang.c (ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST): Define.
gcc/testsuite/
* c-c++-common/gomp/error-1.c: New test.
* c-c++-common/gomp/error-2.c: New test.
* c-c++-common/gomp/error-3.c: New test.
* g++.dg/gomp/attrs-1.C (bar): Add error directive test.
* g++.dg/gomp/attrs-2.C (bar): Add error directive test.
* g++.dg/gomp/attrs-13.C: New test.
* g++.dg/gomp/error-1.C: New test.
libgomp/
* libgomp.map (GOMP_5.1): Add GOMP_error and GOMP_warning.
* libgomp_g.h (GOMP_warning, GOMP_error): Declare.
* error.c (GOMP_warning, GOMP_error): New functions.
* testsuite/libgomp.c-c++-common/error-1.c: New test.
--- gcc/omp-builtins.def.jj 2021-08-19 12:53:44.693106618 +0200
+++ gcc/omp-builtins.def 2021-08-19 17:46:45.960368837 +0200
@@ -463,3 +463,7 @@ DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ALLOC,
ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_FREE,
"GOMP_free", BT_FN_VOID_PTR_PTRMODE, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_GOMP_WARNING, "GOMP_warning",
+ BT_FN_VOID_CONST_PTR_SIZE, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ERROR, "GOMP_error",
+ BT_FN_VOID_CONST_PTR_SIZE, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST)
--- gcc/c-family/c-pragma.h.jj 2021-08-19 12:53:44.690106660 +0200
+++ gcc/c-family/c-pragma.h 2021-08-19 14:37:58.004167196 +0200
@@ -53,6 +53,7 @@ enum pragma_kind {
PRAGMA_OMP_DECLARE,
PRAGMA_OMP_DEPOBJ,
PRAGMA_OMP_DISTRIBUTE,
+ PRAGMA_OMP_ERROR,
PRAGMA_OMP_END_DECLARE_TARGET,
PRAGMA_OMP_FLUSH,
PRAGMA_OMP_FOR,
--- gcc/c-family/c-pragma.c.jj 2021-08-19 12:53:44.690106660 +0200
+++ gcc/c-family/c-pragma.c 2021-08-19 14:37:58.004167196 +0200
@@ -1326,6 +1326,7 @@ static const struct omp_pragma_def omp_p
{ "cancellation", PRAGMA_OMP_CANCELLATION_POINT },
{ "critical", PRAGMA_OMP_CRITICAL },
{ "depobj", PRAGMA_OMP_DEPOBJ },
+ { "error", PRAGMA_OMP_ERROR },
{ "end", PRAGMA_OMP_END_DECLARE_TARGET },
{ "flush", PRAGMA_OMP_FLUSH },
{ "nothing", PRAGMA_OMP_NOTHING },
--- gcc/c-family/c-omp.c.jj 2021-08-19 12:53:44.690106660 +0200
+++ gcc/c-family/c-omp.c 2021-08-19 14:37:58.004167196 +0200
@@ -2991,8 +2991,8 @@ static const struct c_omp_directive omp_
/* { "end", "metadirective", nullptr, PRAGMA_OMP_END,
C_OMP_DIR_???, ??? }, */
/* error with at(execution) is C_OMP_DIR_STANDALONE. */
- /* { "error", nullptr, nullptr, PRAGMA_OMP_ERROR,
- C_OMP_DIR_UTILITY, false }, */
+ { "error", nullptr, nullptr, PRAGMA_OMP_ERROR,
+ C_OMP_DIR_UTILITY, false },
{ "flush", nullptr, nullptr, PRAGMA_OMP_FLUSH,
C_OMP_DIR_STANDALONE, false },
{ "for", nullptr, nullptr, PRAGMA_OMP_FOR,
--- gcc/c/c-parser.c.jj 2021-08-19 13:19:56.217288105 +0200
+++ gcc/c/c-parser.c 2021-08-19 15:22:10.146195464 +0200
@@ -1588,6 +1588,7 @@ static bool c_parser_omp_target (c_parse
static void c_parser_omp_end_declare_target (c_parser *);
static bool c_parser_omp_declare (c_parser *, enum pragma_context);
static void c_parser_omp_requires (c_parser *);
+static bool c_parser_omp_error (c_parser *, enum pragma_context);
static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
static void c_parser_oacc_routine (c_parser *, enum pragma_context);
@@ -12485,6 +12486,9 @@ c_parser_pragma (c_parser *parser, enum
c_parser_omp_nothing (parser);
return false;
+ case PRAGMA_OMP_ERROR:
+ return c_parser_omp_error (parser, context);
+
case PRAGMA_OMP_ORDERED:
return c_parser_omp_ordered (parser, context, if_p);
@@ -21936,6 +21940,173 @@ c_parser_omp_nothing (c_parser *parser)
c_parser_skip_to_pragma_eol (parser);
}
+/* OpenMP 5.1
+ #pragma omp error clauses[optseq] new-line */
+
+static bool
+c_parser_omp_error (c_parser *parser, enum pragma_context context)
+{
+ int at_compilation = -1;
+ int severity_fatal = -1;
+ tree message = NULL_TREE;
+ bool first = true;
+ bool bad = false;
+ location_t loc = c_parser_peek_token (parser)->location;
+
+ c_parser_consume_pragma (parser);
+
+ while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+ {
+ if (!first
+ && c_parser_next_token_is (parser, CPP_COMMA)
+ && c_parser_peek_2nd_token (parser)->type == CPP_NAME)
+ c_parser_consume_token (parser);
+
+ first = false;
+
+ if (!c_parser_next_token_is (parser, CPP_NAME))
+ break;
+
+ const char *p
+ = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ location_t cloc = c_parser_peek_token (parser)->location;
+ static const char *args[] = {
+ "execution", "compilation", "warning", "fatal"
+ };
+ int *v = NULL;
+ int idx = 0, n = -1;
+ tree m = NULL_TREE;
+
+ if (!strcmp (p, "at"))
+ v = &at_compilation;
+ else if (!strcmp (p, "severity"))
+ {
+ v = &severity_fatal;
+ idx += 2;
+ }
+ else if (strcmp (p, "message"))
+ {
+ error_at (cloc,
+ "expected %<at%>, %<severity%> or %<message%> clause");
+ c_parser_skip_to_pragma_eol (parser, false);
+ return false;
+ }
+
+ c_parser_consume_token (parser);
+
+ matching_parens parens;
+ if (parens.require_open (parser))
+ {
+ if (v == NULL)
+ {
+ location_t expr_loc = c_parser_peek_token (parser)->location;
+ c_expr expr = c_parser_expr_no_commas (parser, NULL);
+ expr = convert_lvalue_to_rvalue (expr_loc, expr, true, true);
+ m = convert (const_string_type_node, expr.value);
+ m = c_fully_fold (m, false, NULL);
+ }
+ else
+ {
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ tree val = c_parser_peek_token (parser)->value;
+ const char *q = IDENTIFIER_POINTER (val);
+
+ if (!strcmp (q, args[idx]))
+ n = 0;
+ else if (!strcmp (q, args[idx + 1]))
+ n = 1;
+ }
+ if (n == -1)
+ {
+ error_at (c_parser_peek_token (parser)->location,
+ "expected %qs or %qs", args[idx], args[idx + 1]);
+ bad = true;
+ switch (c_parser_peek_token (parser)->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ case CPP_CLOSE_PAREN:
+ break;
+ default:
+ if (c_parser_peek_2nd_token (parser)->type
+ == CPP_CLOSE_PAREN)
+ c_parser_consume_token (parser);
+ break;
+ }
+ }
+ else
+ c_parser_consume_token (parser);
+ }
+
+ parens.skip_until_found_close (parser);
+
+ if (v == NULL)
+ {
+ if (message)
+ {
+ error_at (cloc, "too many %qs clauses", p);
+ bad = true;
+ }
+ else
+ message = m;
+ }
+ else if (n != -1)
+ {
+ if (*v != -1)
+ {
+ error_at (cloc, "too many %qs clauses", p);
+ bad = true;
+ }
+ else
+ *v = n;
+ }
+ }
+ else
+ bad = true;
+ }
+ c_parser_skip_to_pragma_eol (parser);
+ if (bad)
+ return true;
+
+ if (at_compilation == -1)
+ at_compilation = 1;
+ if (severity_fatal == -1)
+ severity_fatal = 1;
+ if (!at_compilation)
+ {
+ if (context != pragma_compound)
+ {
+ error_at (loc, "%<#pragma omp error%> with %<at(execution)%> clause "
+ "may only be used in compound statements");
+ return true;
+ }
+ tree fndecl
+ = builtin_decl_explicit (severity_fatal ? BUILT_IN_GOMP_ERROR
+ : BUILT_IN_GOMP_WARNING);
+ if (!message)
+ message = build_zero_cst (const_string_type_node);
+ tree stmt = build_call_expr_loc (loc, fndecl, 2, message,
+ build_all_ones_cst (size_type_node));
+ add_stmt (stmt);
+ return true;
+ }
+ const char *msg = NULL;
+ if (message)
+ {
+ msg = c_getstr (message);
+ if (msg == NULL)
+ msg = _("<message unknown at compile time>");
+ }
+ if (msg)
+ emit_diagnostic (severity_fatal ? DK_ERROR : DK_WARNING, loc, 0,
+ "%<pragma omp error%> encountered: %s", msg);
+ else
+ emit_diagnostic (severity_fatal ? DK_ERROR : DK_WARNING, loc, 0,
+ "%<pragma omp error%> encountered");
+ return false;
+}
+
/* Main entry point to parsing most OpenMP pragmas. */
static void
--- gcc/cp/parser.c.jj 2021-08-19 13:40:26.387178416 +0200
+++ gcc/cp/parser.c 2021-08-19 17:47:20.769883975 +0200
@@ -11760,10 +11760,30 @@ cp_parser_handle_statement_omp_attribute
"depend") == 0)
kind = C_OMP_DIR_STANDALONE;
}
- /* else if (dir->id == PRAGMA_OMP_ERROR)
+ else if (dir->id == PRAGMA_OMP_ERROR)
{
- error with at(execution) clause is C_OMP_DIR_STANDALONE.
- } */
+ /* error with at(execution) clause is C_OMP_DIR_STANDALONE. */
+ int paren_depth = 0;
+ for (int i = 1; first + i < last; i++)
+ if (first[i].type == CPP_OPEN_PAREN)
+ paren_depth++;
+ else if (first[i].type == CPP_CLOSE_PAREN)
+ paren_depth--;
+ else if (paren_depth == 0
+ && first + i + 2 < last
+ && first[i].type == CPP_NAME
+ && first[i + 1].type == CPP_OPEN_PAREN
+ && first[i + 2].type == CPP_NAME
+ && !strcmp (IDENTIFIER_POINTER (first[i].u.value),
+ "at")
+ && !strcmp (IDENTIFIER_POINTER (first[i
+ + 2].u.value),
+ "execution"))
+ {
+ kind = C_OMP_DIR_STANDALONE;
+ break;
+ }
+ }
cp_omp_attribute_data v = { DEFPARSE_TOKENS (d), dir, kind };
vec.safe_push (v);
if (flag_openmp || dir->simd)
@@ -45590,6 +45610,184 @@ cp_parser_omp_nothing (cp_parser *parser
}
+/* OpenMP 5.1
+ #pragma omp error clauses[optseq] new-line */
+
+static bool
+cp_parser_omp_error (cp_parser *parser, cp_token *pragma_tok,
+ enum pragma_context context)
+{
+ int at_compilation = -1;
+ int severity_fatal = -1;
+ tree message = NULL_TREE;
+ bool first = true;
+ bool bad = false;
+ location_t loc = pragma_tok->location;
+
+ while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
+ {
+ /* For now only in C++ attributes, do it always for OpenMP 5.1. */
+ if ((!first || parser->lexer->in_omp_attribute_pragma)
+ && cp_lexer_next_token_is (parser->lexer, CPP_COMMA)
+ && cp_lexer_nth_token_is (parser->lexer, 2, CPP_NAME))
+ cp_lexer_consume_token (parser->lexer);
+
+ first = false;
+
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME))
+ break;
+
+ const char *p
+ = IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
+ location_t cloc = cp_lexer_peek_token (parser->lexer)->location;
+ static const char *args[] = {
+ "execution", "compilation", "warning", "fatal"
+ };
+ int *v = NULL;
+ int idx = 0, n = -1;
+ tree m = NULL_TREE;
+
+ if (!strcmp (p, "at"))
+ v = &at_compilation;
+ else if (!strcmp (p, "severity"))
+ {
+ v = &severity_fatal;
+ idx += 2;
+ }
+ else if (strcmp (p, "message"))
+ {
+ error_at (cloc,
+ "expected %<at%>, %<severity%> or %<message%> clause");
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ return false;
+ }
+
+ cp_lexer_consume_token (parser->lexer);
+
+ matching_parens parens;
+ if (parens.require_open (parser))
+ {
+ if (v == NULL)
+ {
+ m = cp_parser_assignment_expression (parser);
+ if (type_dependent_expression_p (m))
+ m = build1 (IMPLICIT_CONV_EXPR, const_string_type_node, m);
+ else
+ m = perform_implicit_conversion_flags (const_string_type_node, m,
+ tf_warning_or_error,
+ LOOKUP_NORMAL);
+ }
+ else
+ {
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ tree val = cp_lexer_peek_token (parser->lexer)->u.value;
+ const char *q = IDENTIFIER_POINTER (val);
+
+ if (!strcmp (q, args[idx]))
+ n = 0;
+ else if (!strcmp (q, args[idx + 1]))
+ n = 1;
+ }
+ if (n == -1)
+ {
+ error_at (cp_lexer_peek_token (parser->lexer)->location,
+ "expected %qs or %qs", args[idx], args[idx + 1]);
+ bad = true;
+ switch (cp_lexer_peek_token (parser->lexer)->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ case CPP_CLOSE_PAREN:
+ break;
+ default:
+ if (cp_lexer_nth_token_is (parser->lexer, 2,
+ CPP_CLOSE_PAREN))
+ cp_lexer_consume_token (parser->lexer);
+ break;
+ }
+ }
+ else
+ cp_lexer_consume_token (parser->lexer);
+ }
+
+ if (!parens.require_close (parser))
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/
+ true);
+
+ if (v == NULL)
+ {
+ if (message)
+ {
+ error_at (cloc, "too many %qs clauses", p);
+ bad = true;
+ }
+ else
+ message = m;
+ }
+ else if (n != -1)
+ {
+ if (*v != -1)
+ {
+ error_at (cloc, "too many %qs clauses", p);
+ bad = true;
+ }
+ else
+ *v = n;
+ }
+ }
+ else
+ bad = true;
+ }
+ cp_parser_require_pragma_eol (parser, pragma_tok);
+ if (bad)
+ return true;
+
+ if (at_compilation == -1)
+ at_compilation = 1;
+ if (severity_fatal == -1)
+ severity_fatal = 1;
+ if (!at_compilation)
+ {
+ if (context != pragma_compound)
+ {
+ error_at (loc, "%<#pragma omp error%> with %<at(execution)%> clause "
+ "may only be used in compound statements");
+ return true;
+ }
+ tree fndecl
+ = builtin_decl_explicit (severity_fatal ? BUILT_IN_GOMP_ERROR
+ : BUILT_IN_GOMP_WARNING);
+ if (!message)
+ message = build_zero_cst (const_string_type_node);
+ tree stmt = build_call_expr_loc (loc, fndecl, 2, message,
+ build_all_ones_cst (size_type_node));
+ add_stmt (stmt);
+ return true;
+ }
+
+ if (in_discarded_stmt)
+ return false;
+
+ const char *msg = NULL;
+ if (message)
+ {
+ msg = c_getstr (fold_for_warn (message));
+ if (msg == NULL)
+ msg = _("<message unknown at compile time>");
+ }
+ if (msg)
+ emit_diagnostic (severity_fatal ? DK_ERROR : DK_WARNING, loc, 0,
+ "%<pragma omp error%> encountered: %s", msg);
+ else
+ emit_diagnostic (severity_fatal ? DK_ERROR : DK_WARNING, loc, 0,
+ "%<pragma omp error%> encountered");
+ return false;
+}
+
/* OpenMP 4.5:
#pragma omp taskloop taskloop-clause[optseq] new-line
for-loop
@@ -46703,6 +46901,9 @@ cp_parser_pragma (cp_parser *parser, enu
cp_parser_omp_nothing (parser, pragma_tok);
return false;
+ case PRAGMA_OMP_ERROR:
+ return cp_parser_omp_error (parser, pragma_tok, context);
+
case PRAGMA_OMP_ORDERED:
if (context != pragma_stmt && context != pragma_compound)
goto bad_stmt;
--- gcc/fortran/types.def.jj 2021-08-17 09:24:58.778051205 +0200
+++ gcc/fortran/types.def 2021-08-19 17:47:10.548026356 +0200
@@ -120,6 +120,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_INT_BOOL
DEF_FUNCTION_TYPE_2 (BT_FN_VOID_UINT_UINT, BT_VOID, BT_UINT, BT_UINT)
DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTRMODE,
BT_VOID, BT_PTR, BT_PTRMODE)
+DEF_FUNCTION_TYPE_2 (BT_FN_VOID_CONST_PTR_SIZE, BT_VOID, BT_CONST_PTR, BT_SIZE)
DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR)
--- gcc/fortran/f95-lang.c.jj 2021-08-19 12:53:44.693106618 +0200
+++ gcc/fortran/f95-lang.c 2021-08-19 14:37:58.004167196 +0200
@@ -535,7 +535,7 @@ gfc_builtin_function (tree decl)
return decl;
}
-/* So far we need just these 8 attribute types. */
+/* So far we need just these 10 attribute types. */
#define ATTR_NULL 0
#define ATTR_LEAF_LIST (ECF_LEAF)
#define ATTR_NOTHROW_LEAF_LIST (ECF_NOTHROW | ECF_LEAF)
@@ -546,6 +546,9 @@ gfc_builtin_function (tree decl)
#define ATTR_CONST_NOTHROW_LIST (ECF_NOTHROW | ECF_CONST)
#define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST \
(ECF_NOTHROW)
+#define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \
+ (ECF_COLD | ECF_NORETURN | \
+ ECF_NOTHROW | ECF_LEAF)
static void
gfc_define_builtin (const char *name, tree type, enum built_in_function code,
--- gcc/testsuite/c-c++-common/gomp/error-1.c.jj 2021-08-19 14:37:58.000167251 +0200
+++ gcc/testsuite/c-c++-common/gomp/error-1.c 2021-08-19 14:37:57.999167265 +0200
@@ -0,0 +1,45 @@
+#pragma omp error /* { dg-error "'pragma omp error' encountered" } */
+#pragma omp error at(compilation) /* { dg-error "'pragma omp error' encountered" } */
+#pragma omp error severity(fatal) /* { dg-error "'pragma omp error' encountered" } */
+#pragma omp error message("my msg") /* { dg-error "'pragma omp error' encountered: my msg" } */
+#pragma omp error severity(warning)message("another message")at(compilation) /* { dg-warning "'pragma omp error' encountered: another message" } */
+
+struct S {
+ #pragma omp error /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error at(compilation) /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error severity(fatal) /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error message("42") /* { dg-error "'pragma omp error' encountered: 42" } */
+ #pragma omp error severity(warning), message("foo"), at(compilation) /* { dg-warning "'pragma omp error' encountered: foo" } */
+ int s;
+};
+
+int
+foo (int i, int x)
+{
+ #pragma omp error /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error at(compilation) /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error severity(fatal) /* { dg-error "'pragma omp error' encountered" } */
+ #pragma omp error message("42 / 1") /* { dg-error "'pragma omp error' encountered: 42 / 1" } */
+ #pragma omp error severity(warning) message("bar") at(compilation) /* { dg-warning "'pragma omp error' encountered: bar" } */
+ if (x)
+ #pragma omp error /* { dg-error "'pragma omp error' encountered" } */
+ i++;
+ if (x)
+ ;
+ else
+ #pragma omp error at(compilation) /* { dg-error "'pragma omp error' encountered" } */
+ i++;
+ switch (0)
+ #pragma omp error severity(fatal) /* { dg-error "'pragma omp error' encountered" } */
+ {
+ default:
+ break;
+ }
+ while (0)
+ #pragma omp error message("42 - 1") /* { dg-error "'pragma omp error' encountered: 42 - 1" } */
+ i++;
+ lab:
+ #pragma omp error severity(warning) message("bar") at(compilation) /* { dg-warning "'pragma omp error' encountered: bar" } */
+ i++;
+ return i;
+}
--- gcc/testsuite/c-c++-common/gomp/error-2.c.jj 2021-08-19 14:37:58.000167251 +0200
+++ gcc/testsuite/c-c++-common/gomp/error-2.c 2021-08-19 14:37:58.000167251 +0200
@@ -0,0 +1,24 @@
+void
+foo (int x, const char *msg1, const char *msg2)
+{
+ if (x == 0)
+ {
+ #pragma omp error at(execution)
+ }
+ else if (x == 1)
+ {
+ #pragma omp error severity (warning), at (execution)
+ }
+ else if (x == 2)
+ {
+ #pragma omp error at ( execution ) severity (fatal) message ("baz")
+ }
+ else if (x == 3)
+ {
+ #pragma omp error severity(warning) message (msg1) at(execution)
+ }
+ else
+ {
+ #pragma omp error message (msg2), at(execution), severity(fatal)
+ }
+}
--- gcc/testsuite/c-c++-common/gomp/error-3.c.jj 2021-08-19 14:37:58.000167251 +0200
+++ gcc/testsuite/c-c++-common/gomp/error-3.c 2021-08-19 17:41:51.712467429 +0200
@@ -0,0 +1,70 @@
+#pragma omp error asdf /* { dg-error "expected 'at', 'severity' or 'message' clause" } */
+#pragma omp error at /* { dg-error "expected '\\\(' before end of line" } */
+#pragma omp error at( /* { dg-error "expected 'execution' or 'compilation'" } */
+ /* { dg-error "expected '\\\)' before end of line" "" { target *-*-* } .-1 } */
+#pragma omp error at(runtime) /* { dg-error "expected 'execution' or 'compilation'" } */
+#pragma omp error at(+ /* { dg-error "expected 'execution' or 'compilation'" } */
+ /* { dg-error "expected '\\\)' before '\\\+' token" "" { target *-*-* } .-1 } */
+#pragma omp error at(compilation /* { dg-error "expected '\\\)' before end of line" } */
+ /* { dg-error "'pragma omp error' encountered" "" { target *-*-* } .-1 } */
+#pragma omp error severity /* { dg-error "expected '\\\(' before end of line" } */
+#pragma omp error severity( /* { dg-error "expected 'warning' or 'fatal'" } */
+ /* { dg-error "expected '\\\)' before end of line" "" { target *-*-* } .-1 } */
+#pragma omp error severity(error) /* { dg-error "expected 'warning' or 'fatal'" } */
+#pragma omp error severity(- /* { dg-error "expected 'warning' or 'fatal'" } */
+ /* { dg-error "expected '\\\)' before '-' token" "" { target *-*-* } .-1 } */
+#pragma omp error severity(fatal /* { dg-error "expected '\\\)' before end of line" } */
+ /* { dg-error "'pragma omp error' encountered" "" { target *-*-* } .-1 } */
+#pragma omp error message /* { dg-error "expected '\\\(' before end of line" } */
+#pragma omp error message( /* { dg-error "expected expression before end of line" "" { target c } } */
+ /* { dg-error "expected primary-expression before end of line" "" { target c++ } .-1 } */
+ /* { dg-error "expected '\\\)' before end of line" "" { target c++ } .-2 } */
+ /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" "" { target *-*-* } .-3 } */
+#pragma omp error message(0 /* { dg-error "expected '\\\)' before end of line" } */
+ /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" "" { target *-*-* } .-1 } */
+#pragma omp error message("foo" /* { dg-error "expected '\\\)' before end of line" } */
+ /* { dg-error "'pragma omp error' encountered: foo" "" { target *-*-* } .-1 } */
+#pragma omp error message(1) /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" } */
+ /* { dg-error "invalid conversion from 'int' to 'const char\\*'" "" { target c++ } .-1 } */
+#pragma omp error message(1.2) /* { dg-error "cannot convert to a pointer type" "" { target c } } */
+ /* { dg-error "could not convert" "" { target c++ } .-1 } */
+ /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" "" { target *-*-* } .-2 } */
+#pragma omp error message(L"bar") /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" } */
+ /* { dg-error "could not convert" "" { target c++ } .-1 } */
+#pragma omp error message("foo"),at(compilation),severity(fatal), /* { dg-error "expected end of line before ',' token" } */
+ /* { dg-error "'pragma omp error' encountered: foo" "" { target *-*-* } .-1 } */
+#pragma omp error message("foo"),at(compilation),severity(fatal),asdf /* { dg-error "expected 'at', 'severity' or 'message' clause" } */
+#pragma omp error at(compilation) at(compilation) /* { dg-error "too many 'at' clauses" } */
+#pragma omp error severity(fatal) severity(warning) /* { dg-error "too many 'severity' clauses" } */
+#pragma omp error message("foo") message("foo") /* { dg-error "too many 'message' clauses" } */
+#pragma omp error at(execution) /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+
+struct S
+{
+ #pragma omp error at(execution) message("foo")/* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ int s;
+};
+
+int
+foo (int i, int x, const char *msg)
+{
+ #pragma omp error message(msg) /* { dg-error "'pragma omp error' encountered: <message unknown at compile time>" } */
+ if (x)
+ #pragma omp error at(execution) /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ i++;
+ if (x)
+ ;
+ else
+ #pragma omp error at(execution) severity(warning) /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ i++;
+ switch (0)
+ #pragma omp error severity(fatal) at(execution) /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ ;
+ while (0)
+ #pragma omp error at(execution)message("42 - 1") /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ i++;
+ lab:
+ #pragma omp error severity(warning) message("bar") at(execution) /* { dg-error "'#pragma omp error' with 'at\\\(execution\\\)' clause may only be used in compound statements" } */
+ i++;
+ return i;
+}
--- gcc/testsuite/g++.dg/gomp/attrs-1.C.jj 2021-08-19 11:42:27.417421677 +0200
+++ gcc/testsuite/g++.dg/gomp/attrs-1.C 2021-08-19 17:05:23.953934117 +0200
@@ -109,9 +109,11 @@ baz (int d, int m, int i1, int i2, int p
void
bar (int d, int m, int i1, int i2, int i3, int p, int *idp, int s,
- int nte, int tl, int nth, int g, int nta, int fi, int pp, int *q, int *dd, int ntm)
+ int nte, int tl, int nth, int g, int nta, int fi, int pp, int *q, int *dd, int ntm,
+ const char *msg)
{
[[omp::directive (nothing)]];
+ [[omp::directive (error at (execution) severity (warning) message (msg))]];
[[omp::directive (for simd
private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) nowait
safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) allocate (f))]]
--- gcc/testsuite/g++.dg/gomp/attrs-2.C.jj 2021-08-19 11:42:27.421421621 +0200
+++ gcc/testsuite/g++.dg/gomp/attrs-2.C 2021-08-19 17:05:06.757173496 +0200
@@ -109,9 +109,11 @@ baz (int d, int m, int i1, int i2, int p
void
bar (int d, int m, int i1, int i2, int i3, int p, int *idp, int s,
- int nte, int tl, int nth, int g, int nta, int fi, int pp, int *q, int *dd, int ntm)
+ int nte, int tl, int nth, int g, int nta, int fi, int pp, int *q, int *dd, int ntm,
+ const char *msg)
{
[[omp::directive (nothing)]];
+ [[omp::directive (error, at (execution), severity (warning), message (msg))]];
[[omp::directive (for simd,
private (p),firstprivate (f),lastprivate (l),linear (ll:1),reduction(+:r),schedule(static, 4),collapse(1),nowait,
safelen(8),simdlen(4),aligned(q: 32),nontemporal(ntm),if(i1),order(concurrent),allocate (f))]]
--- gcc/testsuite/g++.dg/gomp/attrs-13.C.jj 2021-08-19 17:09:01.228909636 +0200
+++ gcc/testsuite/g++.dg/gomp/attrs-13.C 2021-08-19 17:57:29.933397757 +0200
@@ -0,0 +1,34 @@
+// { dg-do compile { target c++11 } }
+
+[[omp::directive(error)]]; // { dg-error "'pragma omp error' encountered" }
+[[omp::directive(error, at(compilation))]]; // { dg-error "'pragma omp error' encountered" }
+[[omp::directive(error severity(fatal))]]; // { dg-error "'pragma omp error' encountered" }
+[[omp::directive(error, message("my msg"))]]; // { dg-error "'pragma omp error' encountered: my msg" }
+[[omp::directive(error severity(warning)message("another message")at(compilation))]]; // { dg-warning "'pragma omp error' encountered: another message" }
+
+int
+foo (int i, int x)
+{
+ [[omp::directive(error)]]; // { dg-error "'pragma omp error' encountered" }
+ [[omp::directive(error, at(compilation))]]; // { dg-error "'pragma omp error' encountered" }
+ [[omp::directive(error severity(fatal))]]; // { dg-error "'pragma omp error' encountered" }
+ [[omp::directive(error, message("42 / 1"))]]; // { dg-error "'pragma omp error' encountered: 42 / 1" }
+ [[omp::directive(error severity(warning) message("bar") at(compilation))]]; // { dg-warning "'pragma omp error' encountered: bar" }
+ if (x)
+ [[omp::directive(error)]]; // { dg-error "'pragma omp error' encountered" }
+ i++;
+ if (x)
+ ;
+ else
+ [[omp::directive(error at(compilation))]]; // { dg-error "'pragma omp error' encountered" }
+ i++;
+ switch (0)
+ [[omp::directive(error, severity(fatal))]]; // { dg-error "'pragma omp error' encountered" }
+ while (0)
+ [[omp::directive(error, message("42 - 1"))]]; // { dg-error "'pragma omp error' encountered: 42 - 1" }
+ i++;
+ lab:
+ [[omp::directive(error, severity(warning) message("bar"), at(compilation))]]; // { dg-warning "'pragma omp error' encountered: bar" }
+ i++;
+ return i;
+}
--- gcc/testsuite/g++.dg/gomp/error-1.C.jj 2021-08-19 17:18:58.231599327 +0200
+++ gcc/testsuite/g++.dg/gomp/error-1.C 2021-08-19 17:56:41.478073032 +0200
@@ -0,0 +1,42 @@
+// { dg-do compile { target c++17 } }
+
+void
+foo ()
+{
+ if constexpr (false)
+ {
+ #pragma omp error // { dg-bogus "'pragma omp error' encountered" }
+ }
+ else
+ {
+ #pragma omp error at(compilation) severity(warning) message("foo") // { dg-warning "'pragma omp error' encountered: foo" }
+ }
+ if constexpr (true)
+ {
+ #pragma omp error message("bar") // { dg-error "'pragma omp error' encountered: bar" }
+ }
+ else
+ {
+ #pragma omp error message("baz") // { dg-bogus "'pragma omp error' encountered" }
+ }
+}
+
+template <typename T>
+bool
+bar (T x)
+{
+ #pragma omp error at(execution) message (x)
+ return false;
+}
+
+bool a = bar ("foo");
+
+template <typename T>
+bool
+baz (T x)
+{
+ #pragma omp error at(execution) message (x) // { dg-error "could not convert" }
+ return false;
+}
+
+bool b = baz (L"foo");
--- libgomp/libgomp.map.jj 2021-08-19 12:53:44.693106618 +0200
+++ libgomp/libgomp.map 2021-08-19 14:37:58.004167196 +0200
@@ -382,7 +382,9 @@ GOMP_5.0.1 {
GOMP_5.1 {
global:
+ GOMP_error;
GOMP_scope_start;
+ GOMP_warning;
} GOMP_5.0.1;
OACC_2.0 {
--- libgomp/libgomp_g.h.jj 2021-08-19 12:53:44.693106618 +0200
+++ libgomp/libgomp_g.h 2021-08-19 14:58:44.728786591 +0200
@@ -366,6 +366,11 @@ extern void GOMP_teams_reg (void (*) (vo
extern void *GOMP_alloc (size_t, size_t, uintptr_t);
extern void GOMP_free (void *, uintptr_t);
+/* error.c */
+
+extern void GOMP_warning (const char *, size_t);
+extern void GOMP_error (const char *, size_t);
+
/* oacc-async.c */
extern void GOACC_wait (int, int, ...);
--- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
+++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
@@ -89,3 +89,34 @@ gomp_fatal (const char *fmt, ...)
gomp_vfatal (fmt, list);
va_end (list);
}
+
+void
+GOMP_warning (const char *msg, size_t msglen)
+{
+ if (msg && msglen == (size_t) -1)
+ gomp_error ("error directive encountered: %s", msg);
+ else if (msg)
+ {
+ fputs ("\nlibgomp: error directive encountered: ", stderr);
+ fwrite (msg, 1, msglen, stderr);
+ fputc ('\n', stderr);
+ }
+ else
+ gomp_error ("error directive encountered");
+}
+
+void
+GOMP_error (const char *msg, size_t msglen)
+{
+ if (msg && msglen == (size_t) -1)
+ gomp_fatal ("fatal error: error directive encountered: %s", msg);
+ else if (msg)
+ {
+ fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
+ fwrite (msg, 1, msglen, stderr);
+ fputc ('\n', stderr);
+ exit (EXIT_FAILURE);
+ }
+ else
+ gomp_fatal ("fatal error: error directive encountered");
+}
--- libgomp/testsuite/libgomp.c-c++-common/error-1.c.jj 2021-08-19 15:26:12.576816311 +0200
+++ libgomp/testsuite/libgomp.c-c++-common/error-1.c 2021-08-19 17:59:10.389997780 +0200
@@ -0,0 +1,49 @@
+/* { dg-shouldfail "error directive" } */
+
+#ifdef __cplusplus
+extern "C"
+#endif
+void abort ();
+
+int
+foo (int i, int x)
+{
+ if (x)
+ #pragma omp error severity(warning) /* { dg-warning "'pragma omp error' encountered" } */
+ i++;
+ if (!x)
+ ;
+ else
+ #pragma omp error severity(warning) /* { dg-warning "'pragma omp error' encountered" } */
+ i += 2;
+ switch (0)
+ #pragma omp error severity(warning) /* { dg-warning "'pragma omp error' encountered" } */
+ {
+ default:
+ break;
+ }
+ while (0)
+ #pragma omp error message("42 - 1") severity (warning) /* { dg-warning "'pragma omp error' encountered: 42 - 1" } */
+ i += 4;
+ lab:
+ #pragma omp error severity(warning) message("bar") at(compilation) /* { dg-warning "'pragma omp error' encountered: bar" } */
+ i += 8;
+ return i;
+}
+
+int
+main ()
+{
+ if (foo (5, 0) != 13 || foo (6, 1) != 17)
+ abort ();
+ #pragma omp error at (execution) severity (warning)
+ const char *msg = "my message" + 2;
+ #pragma omp error at (execution) severity (warning) message (msg + 1)
+ #pragma omp error at (execution) severity (fatal) message (msg - 2)
+ #pragma omp error at (execution) severity (warning) message ("foobar")
+ return 0;
+}
+
+/* { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" } */
+/* { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" } */
+/* { dg-output "libgomp: fatal error: error directive encountered: my message" } */
Jakub
^ permalink raw reply [flat|nested] 9+ messages in thread
* [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive)
2021-08-20 9:45 [committed] openmp: Implement the error directive Jakub Jelinek
@ 2021-08-20 10:00 ` Tobias Burnus
2021-08-20 10:08 ` Jakub Jelinek
2021-08-20 13:11 ` [committed] openmp: Implement the error directive Thomas Schwinge
1 sibling, 1 reply; 9+ messages in thread
From: Tobias Burnus @ 2021-08-20 10:00 UTC (permalink / raw)
To: Jakub Jelinek, gcc-patches, fortran; +Cc: Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 1235 bytes --]
Hi Jakub, hi all,
On 20.08.21 11:45, Jakub Jelinek wrote:
> This patch implements the error directive. Depending on clauses it is either
> a compile time diagnostics (in that case diagnosed right away) or runtime
> diagnostics (libgomp API call that diagnoses at runtime),
The attached patch does likewise for Fortran. Compared to yesterday, _()
was replaced by G_().
> There are some clarifications in the works ATM, so this patch doesn't yet
> require that for compile time diagnostics the user message must be a constant
> string literal,[...]
For Fortran, it does require a constant character expression; I think we
did converge on this. With at(execution), it is regarded as execution
expression - otherwise, as it belongs to 'untility' and can be placed
everywhere (ST_NONE).
There is on-going discussion/wordsmithing regarding the PURE restriction
with 'at(compilation)' – currently, it is rejected in pure procedures.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: omp-error-fortran.diff --]
[-- Type: text/x-patch, Size: 32191 bytes --]
Fortran: Add OpenMP's error directive
Fortran part to the C/C++ implementation of
commit r12-3040-g0d973c0a0d90a0a302e7eda1a4d9709be3c5b102
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity'
and 'message' clauses.
(show_omp_node, show_code_node): Handle EXEC_OMP_ERROR.
* gfortran.h (gfc_statement): Add ST_OMP_ERROR.
(gfc_omp_severity_type, gfc_omp_at_type): New.
(gfc_omp_clauses): Add 'at', 'severity' and 'message' clause;
use more bitfields + ENUM_BITFIELD.
(gfc_exec_op): Add EXEC_OMP_ERROR.
* match.h (gfc_match_omp_error): New.
* openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE).
(gfc_match_omp_clauses): Handle new clauses.
(OMP_ERROR_CLAUSES, gfc_match_omp_error): New.
(resolve_omp_clauses): Resolve new clauses.
(omp_code_to_statement, gfc_resolve_omp_directive): Handle
EXEC_OMP_ERROR.
* parse.c (decode_omp_directive, next_statement,
gfc_ascii_statement): Handle 'omp error'.
* resolve.c (gfc_resolve_blocks): Likewise.
* st.c (gfc_free_statement): Likewise.
* trans-openmp.c (gfc_trans_omp_error): Likewise.
(gfc_trans_omp_directive): Likewise.
* trans.c (trans_code): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/error-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/error-1.f90: New test.
* gfortran.dg/gomp/error-2.f90: New test.
* gfortran.dg/gomp/error-3.f90: New test.
gcc/fortran/dump-parse-tree.c | 27 +++++-
gcc/fortran/gfortran.h | 58 ++++++++----
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 124 +++++++++++++++++++++++++-
gcc/fortran/parse.c | 10 ++-
gcc/fortran/resolve.c | 2 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 34 +++++++
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/gomp/error-1.f90 | 51 +++++++++++
gcc/testsuite/gfortran.dg/gomp/error-2.f90 | 15 ++++
gcc/testsuite/gfortran.dg/gomp/error-3.f90 | 88 ++++++++++++++++++
libgomp/testsuite/libgomp.fortran/error-1.f90 | 78 ++++++++++++++++
13 files changed, 465 insertions(+), 25 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 92d9f9e054d..c75a0a9d095 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1908,6 +1908,26 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
fputc (' ', dumpfile);
fputs (memorder, dumpfile);
}
+ if (omp_clauses->at != OMP_AT_UNSET)
+ {
+ if (omp_clauses->at != OMP_AT_COMPILATION)
+ fputs (" AT (COMPILATION)", dumpfile);
+ else
+ fputs (" AT (EXECUTION)", dumpfile);
+ }
+ if (omp_clauses->severity != OMP_SEVERITY_UNSET)
+ {
+ if (omp_clauses->severity != OMP_SEVERITY_FATAL)
+ fputs (" SEVERITY (FATAL)", dumpfile);
+ else
+ fputs (" SEVERITY (WARNING)", dumpfile);
+ }
+ if (omp_clauses->message)
+ {
+ fputs (" ERROR (", dumpfile);
+ show_expr (omp_clauses->message);
+ fputc (')', dumpfile);
+ }
}
/* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -1950,8 +1970,9 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
case EXEC_OMP_DO: name = "DO"; break;
case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
- case EXEC_OMP_LOOP: name = "LOOP"; break;
+ case EXEC_OMP_ERROR: name = "ERROR"; break;
case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+ case EXEC_OMP_LOOP: name = "LOOP"; break;
case EXEC_OMP_MASKED: name = "MASKED"; break;
case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break;
case EXEC_OMP_MASKED_TASKLOOP_SIMD: name = "MASKED TASKLOOP SIMD"; break;
@@ -2045,6 +2066,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_LOOP:
case EXEC_OMP_ORDERED:
case EXEC_OMP_MASKED:
@@ -2135,7 +2157,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
- || c->op == EXEC_OMP_DEPOBJ
+ || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3268,6 +3290,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_FLUSH:
case EXEC_OMP_LOOP:
case EXEC_OMP_MASKED:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a7d82ae38c2..4b26cb430d4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -281,7 +281,8 @@ enum gfc_statement
ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
- ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, ST_NONE
+ ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
+ ST_OMP_ERROR, ST_NONE
};
/* Types of interfaces that we can have. Assignment interfaces are
@@ -776,6 +777,20 @@ enum gfc_omp_device_type
OMP_DEVICE_TYPE_ANY
};
+enum gfc_omp_severity_type
+{
+ OMP_SEVERITY_UNSET,
+ OMP_SEVERITY_WARNING,
+ OMP_SEVERITY_FATAL
+};
+
+enum gfc_omp_at_type
+{
+ OMP_AT_UNSET,
+ OMP_AT_COMPILATION,
+ OMP_AT_EXECUTION
+};
+
/* Structure and list of supported extension attributes. */
typedef enum
{
@@ -1446,26 +1461,11 @@ enum gfc_omp_bind_type
typedef struct gfc_omp_clauses
{
+ gfc_omp_namelist *lists[OMP_LIST_NUM];
struct gfc_expr *if_expr;
struct gfc_expr *final_expr;
struct gfc_expr *num_threads;
- gfc_omp_namelist *lists[OMP_LIST_NUM];
- enum gfc_omp_sched_kind sched_kind;
- enum gfc_omp_device_type device_type;
struct gfc_expr *chunk_size;
- enum gfc_omp_default_sharing default_sharing;
- enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
- int collapse, orderedc;
- bool nowait, ordered, untied, mergeable;
- bool inbranch, notinbranch, nogroup;
- bool sched_simd, sched_monotonic, sched_nonmonotonic;
- bool simd, threads, depend_source, destroy, order_concurrent, capture;
- enum gfc_omp_atomic_op atomic_op;
- enum gfc_omp_memorder memorder;
- enum gfc_omp_cancel_kind cancel;
- enum gfc_omp_proc_bind_kind proc_bind;
- enum gfc_omp_depend_op depobj_update;
- enum gfc_omp_bind_type bind;
struct gfc_expr *safelen_expr;
struct gfc_expr *simdlen_expr;
struct gfc_expr *num_teams;
@@ -1479,9 +1479,28 @@ typedef struct gfc_omp_clauses
struct gfc_expr *detach;
struct gfc_expr *depobj;
struct gfc_expr *if_exprs[OMP_IF_LAST];
- enum gfc_omp_sched_kind dist_sched_kind;
struct gfc_expr *dist_chunk_size;
+ struct gfc_expr *message;
const char *critical_name;
+ enum gfc_omp_default_sharing default_sharing;
+ enum gfc_omp_atomic_op atomic_op;
+ enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
+ int collapse, orderedc;
+ unsigned nowait:1, ordered:1, untied:1, mergeable:1;
+ unsigned inbranch:1, notinbranch:1, nogroup:1;
+ unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
+ unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
+ unsigned capture:1;
+ ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
+ ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
+ ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
+ ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
+ ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
+ ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:3;
+ ENUM_BITFIELD (gfc_omp_bind_type) bind:2;
+ ENUM_BITFIELD (gfc_omp_at_type) at:2;
+ ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
+ ENUM_BITFIELD (gfc_omp_sched_kind) dist_sched_kind:3;
/* OpenACC. */
struct gfc_expr *async_expr;
@@ -2768,7 +2787,8 @@ enum gfc_exec_op
EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
- EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE
+ EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
+ EXEC_OMP_ERROR
};
typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 5127b4b8ea3..92fd127a57f 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -168,6 +168,7 @@ match gfc_match_omp_distribute_simd (void);
match gfc_match_omp_do (void);
match gfc_match_omp_do_simd (void);
match gfc_match_omp_loop (void);
+match gfc_match_omp_error (void);
match gfc_match_omp_flush (void);
match gfc_match_omp_masked (void);
match gfc_match_omp_masked_taskloop (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index fd219dc9c4d..2380866cc3b 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
#include "constructor.h"
#include "diagnostic.h"
#include "gomp-constants.h"
+#include "target-memory.h" /* For gfc_encode_character. */
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -848,6 +849,9 @@ enum omp_mask1
OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */
OMP_CLAUSE_BIND, /* OpenMP 5.0. */
OMP_CLAUSE_FILTER, /* OpenMP 5.1. */
+ OMP_CLAUSE_AT, /* OpenMP 5.1. */
+ OMP_CLAUSE_MESSAGE, /* OpenMP 5.1. */
+ OMP_CLAUSE_SEVERITY, /* OpenMP 5.1. */
OMP_CLAUSE_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -1293,6 +1297,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
bool openacc = false)
{
+ bool error = false;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
/* Determine whether we're dealing with an OpenACC directive that permits
@@ -1392,6 +1397,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
continue;
}
+ if ((mask & OMP_CLAUSE_AT)
+ && c->at == OMP_AT_UNSET
+ && gfc_match ("at ( ") == MATCH_YES)
+ {
+ if (gfc_match ("compilation )") == MATCH_YES)
+ c->at = OMP_AT_COMPILATION;
+ else if (gfc_match ("execution )") == MATCH_YES)
+ c->at = OMP_AT_EXECUTION;
+ else
+ {
+ gfc_error ("Expected COMPILATION or EXECUTION in AT clause "
+ "at %C");
+ goto error;
+ }
+ continue;
+ }
if ((mask & OMP_CLAUSE_ASYNC)
&& !c->async
&& gfc_match ("async") == MATCH_YES)
@@ -1616,7 +1637,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else
gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for "
"category %s", pcategory);
- goto end;
+ goto error;
}
}
c->defaultmap[category] = behavior;
@@ -2074,6 +2095,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
c->mergeable = needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_MESSAGE)
+ && !c->message
+ && gfc_match ("message ( %e )", &c->message) == MATCH_YES)
+ continue;
break;
case 'n':
if ((mask & OMP_CLAUSE_NO_CREATE)
@@ -2402,6 +2427,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
c->simd = needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_SEVERITY)
+ && c->severity == OMP_SEVERITY_UNSET
+ && gfc_match ("severity ( ") == MATCH_YES)
+ {
+ if (gfc_match ("fatal )") == MATCH_YES)
+ c->severity = OMP_SEVERITY_FATAL;
+ else if (gfc_match ("warning )") == MATCH_YES)
+ c->severity = OMP_SEVERITY_WARNING;
+ else
+ {
+ gfc_error ("Expected FATAL or WARNING in SEVERITY clause "
+ "at %C");
+ goto error;
+ }
+ continue;
+ }
break;
case 't':
if ((mask & OMP_CLAUSE_TASK_REDUCTION)
@@ -2553,7 +2594,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
end:
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (error || gfc_match_omp_eos () != MATCH_YES)
{
if (!gfc_error_flag_test ())
gfc_error ("Failed to match clause at %C");
@@ -2563,6 +2604,10 @@ end:
*cp = c;
return MATCH_YES;
+
+error:
+ error = true;
+ goto end;
}
@@ -3208,6 +3253,9 @@ cleanup:
| OMP_CLAUSE_MEMORDER)
#define OMP_MASKED_CLAUSES \
(omp_mask (OMP_CLAUSE_FILTER))
+#define OMP_ERROR_CLAUSES \
+ (omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY)
+
static match
@@ -3431,6 +3479,66 @@ gfc_match_omp_target_parallel_loop (void)
}
+match
+gfc_match_omp_error (void)
+{
+ locus loc = gfc_current_locus;
+ match m = match_omp (EXEC_OMP_ERROR, OMP_ERROR_CLAUSES);
+ if (m != MATCH_YES)
+ return m;
+
+ gfc_omp_clauses *c = new_st.ext.omp_clauses;
+ if (c->severity == OMP_SEVERITY_UNSET)
+ c->severity = OMP_SEVERITY_FATAL;
+ if (new_st.ext.omp_clauses->at == OMP_AT_EXECUTION)
+ return MATCH_YES;
+ if (c->message
+ && (!gfc_resolve_expr (c->message)
+ || c->message->ts.type != BT_CHARACTER
+ || c->message->ts.kind != gfc_default_character_kind
+ || c->message->rank != 0))
+ {
+ gfc_error ("MESSAGE clause at %L requires a scalar default-kind "
+ "CHARACTER expression",
+ &new_st.ext.omp_clauses->message->where);
+ return MATCH_ERROR;
+ }
+ if (c->message && !gfc_is_constant_expr (c->message))
+ {
+ gfc_error ("Constant character expression required in MESSAGE clause "
+ "at %L", &new_st.ext.omp_clauses->message->where);
+ return MATCH_ERROR;
+ }
+ if (c->message)
+ {
+ const char *msg = G_("$OMP ERROR encountered at %L: %s");
+ gcc_assert (c->message->expr_type == EXPR_CONSTANT);
+ gfc_charlen_t slen = c->message->value.character.length;
+ int i = gfc_validate_kind (BT_CHARACTER, gfc_default_character_kind,
+ false);
+ size_t size = slen * gfc_character_kinds[i].bit_size / 8;
+ unsigned char *s = XCNEWVAR (unsigned char, size + 1);
+ gfc_encode_character (gfc_default_character_kind, slen,
+ c->message->value.character.string,
+ (unsigned char *) s, size);
+ s[size] = '\0';
+ if (c->severity == OMP_SEVERITY_WARNING)
+ gfc_warning_now (0, msg, &loc, s);
+ else
+ gfc_error_now (msg, &loc, s);
+ free (s);
+ }
+ else
+ {
+ const char *msg = G_("$OMP ERROR encountered at %L");
+ if (c->severity == OMP_SEVERITY_WARNING)
+ gfc_warning_now (0, msg, &loc);
+ else
+ gfc_error_now (msg, &loc);
+ }
+ return MATCH_YES;
+}
+
match
gfc_match_omp_flush (void)
{
@@ -6463,6 +6571,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
gfc_error ("SOURCE dependence type only allowed "
"on ORDERED directive at %L", &code->loc);
+ if (omp_clauses->message)
+ {
+ gfc_expr *expr = omp_clauses->message;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.kind != gfc_default_character_kind
+ || expr->ts.type != BT_CHARACTER || expr->rank != 0)
+ gfc_error ("MESSAGE clause at %L requires a scalar default-kind "
+ "CHARACTER expression", &expr->where);
+ }
if (!openacc
&& code
&& omp_clauses->lists[OMP_LIST_MAP] == NULL
@@ -7461,6 +7578,8 @@ omp_code_to_statement (gfc_code *code)
return ST_OMP_CANCEL;
case EXEC_OMP_CANCELLATION_POINT:
return ST_OMP_CANCELLATION_POINT;
+ case EXEC_OMP_ERROR:
+ return ST_OMP_ERROR;
case EXEC_OMP_FLUSH:
return ST_OMP_FLUSH;
case EXEC_OMP_DISTRIBUTE:
@@ -7971,6 +8090,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
resolve_omp_do (code);
break;
case EXEC_OMP_CANCEL:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_MASKED:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_PARALLEL:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d004732677c..d37a0b5a697 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -908,6 +908,7 @@ decode_omp_directive (void)
matcho ("do", gfc_match_omp_do, ST_OMP_DO);
break;
case 'e':
+ matcho ("error", gfc_match_omp_error, ST_OMP_ERROR);
matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC);
matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL);
matchs ("end distribute parallel do simd", gfc_match_omp_eos_error,
@@ -1183,6 +1184,9 @@ decode_omp_directive (void)
prog_unit->omp_target_seen = true;
break;
}
+ case ST_OMP_ERROR:
+ if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION)
+ return ST_NONE;
default:
break;
}
@@ -1654,7 +1658,7 @@ next_statement (void)
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
- case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
+ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
@@ -1716,7 +1720,6 @@ next_statement (void)
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
-
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@@ -2544,6 +2547,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_WORKSHARE:
p = "!$OMP END WORKSHARE";
break;
+ case ST_OMP_ERROR:
+ p = "!$OMP ERROR";
+ break;
case ST_OMP_FLUSH:
p = "!$OMP FLUSH";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 117062b48d8..5b9ba43780e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10817,6 +10817,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_LOOP:
case EXEC_OMP_MASKED:
case EXEC_OMP_MASKED_TASKLOOP:
@@ -12254,6 +12255,7 @@ start:
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_LOOP:
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 7d87709d387..6bf730c9062 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -225,6 +225,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_LOOP:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_MASKED_TASKLOOP:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index e0a001420e6..91888f31cb3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5368,6 +5368,38 @@ gfc_trans_omp_depobj (gfc_code *code)
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_error (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_se se;
+ tree len, message;
+ bool fatal = code->ext.omp_clauses->severity == OMP_SEVERITY_FATAL;
+ tree fndecl = builtin_decl_explicit (fatal ? BUILT_IN_GOMP_ERROR
+ : BUILT_IN_GOMP_WARNING);
+ gfc_start_block (&block);
+ gfc_init_se (&se, NULL );
+ if (!code->ext.omp_clauses->message)
+ {
+ message = null_pointer_node;
+ len = build_int_cst (size_type_node, 0);
+ }
+ else
+ {
+ gfc_conv_expr (&se, code->ext.omp_clauses->message);
+ message = se.expr;
+ if (!POINTER_TYPE_P (TREE_TYPE (message)))
+ /* To ensure an ARRAY_TYPE is not passed as such. */
+ message = gfc_build_addr_expr (NULL, message);
+ len = se.string_length;
+ }
+ gfc_add_block_to_block (&block, &se.pre);
+ gfc_add_expr_to_block (&block, build_call_expr_loc (input_location, fndecl,
+ 2, message, len));
+ gfc_add_block_to_block (&block, &se.post);
+ return gfc_finish_block (&block);
+}
+
static tree
gfc_trans_omp_flush (gfc_code *code)
{
@@ -7096,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_distribute (code, NULL);
case EXEC_OMP_DO_SIMD:
return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
+ case EXEC_OMP_ERROR:
+ return gfc_trans_omp_error (code);
case EXEC_OMP_FLUSH:
return gfc_trans_omp_flush (code);
case EXEC_OMP_MASKED:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 80b724d0839..eb5682a7cda 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2155,6 +2155,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_LOOP:
+ case EXEC_OMP_ERROR:
case EXEC_OMP_FLUSH:
case EXEC_OMP_MASKED:
case EXEC_OMP_MASKED_TASKLOOP:
diff --git a/gcc/testsuite/gfortran.dg/gomp/error-1.f90 b/gcc/testsuite/gfortran.dg/gomp/error-1.f90
new file mode 100644
index 00000000000..0ee0b4bfbcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/error-1.f90
@@ -0,0 +1,51 @@
+! { dg-additional-options "-ffree-line-length-none" }
+module m
+!$omp error ! { dg-error ".OMP ERROR encountered at .1." }
+!$omp error at(compilation) ! { dg-error ".OMP ERROR encountered at .1." }
+!$omp error severity(fatal) ! { dg-error ".OMP ERROR encountered at .1." }
+!$omp error message("my msg") ! { dg-error ".OMP ERROR encountered at .1.: my msg" }
+!$omp error severity(warning)message("another message")at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: another message" }
+
+type S
+ !$omp error ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error at(compilation) ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error severity(fatal) ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error message("42") ! { dg-error ".OMP ERROR encountered at .1.: 42" }
+ !$omp error severity(warning), message("foo"), at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: foo" }
+ integer s
+end type S
+end module m
+
+integer function foo (i, x)
+ integer :: i
+ logical :: x
+ !$omp error ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error at(compilation) ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error severity(fatal) ! { dg-error ".OMP ERROR encountered at .1." }
+ !$omp error message("42 / 1") ! { dg-error ".OMP ERROR encountered at .1.: 42 / 1" }
+ !$omp error severity(warning) message("bar") at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: bar" }
+ if (x) then
+ !$omp error ! { dg-error ".OMP ERROR encountered at .1." }
+ i = i + 1
+ end if
+ if (x) then
+ ;
+ else
+ !$omp error at(compilation) ! { dg-error ".OMP ERROR encountered at .1." }
+ i = i + 1
+ end if
+ select case (.false.)
+ !$omp error severity(fatal) ! { dg-error ".OMP ERROR encountered at .1." }
+ case default
+ !
+ end select
+ do while (.false.)
+ !$omp error message("42 - 1") ! { dg-error ".OMP ERROR encountered at .1.: 42 - 1" }
+ i = i + 1
+ end do
+ lab:
+ !$omp error severity(warning) message("bar") at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: bar" }
+ i++;
+ foo = i
+ return
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/error-2.f90 b/gcc/testsuite/gfortran.dg/gomp/error-2.f90
new file mode 100644
index 00000000000..718e82cead9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/error-2.f90
@@ -0,0 +1,15 @@
+subroutine foo (x, msg1, msg2)
+ integer x
+ character(len=*) :: msg1, msg2
+ if (x == 0) then
+ !$omp error at(execution)
+ else if (x == 1) then
+ !$omp error severity (warning), at (execution)
+ else if (x == 2) then
+ !$omp error at ( execution ) severity (fatal) message ("baz")
+ else if (x == 3) then
+ !$omp error severity(warning) message (msg1) at(execution)
+ else
+ !$omp error message (msg2), at(execution), severity(fatal)
+ end if
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/error-3.f90 b/gcc/testsuite/gfortran.dg/gomp/error-3.f90
new file mode 100644
index 00000000000..67948cdc52a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/error-3.f90
@@ -0,0 +1,88 @@
+module m
+!$omp error asdf ! { dg-error "Failed to match clause" }
+!$omp error at ! { dg-error "Failed to match clause" }
+!$omp error at( ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
+!$omp error at(runtime) ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
+!$omp error at(+ ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
+!$omp error at(compilation ! { dg-error "Expected COMPILATION or EXECUTION in AT clause at" }
+!$omp error severity ! { dg-error "Failed to match clause" }
+!$omp error severity( ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
+!$omp error severity(error) ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
+!$omp error severity(- ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
+!$omp error severity(fatal ! { dg-error "Expected FATAL or WARNING in SEVERITY clause at" }
+!$omp error message ! { dg-error "Failed to match clause" }
+!$omp error message( ! { dg-error "Invalid character in name" }
+!$omp error message(0 ! { dg-error "Failed to match clause" }
+!$omp error message("foo" ! { dg-error "Failed to match clause" }
+
+!$omp error at(compilation) at(compilation) ! { dg-error "Failed to match clause at" }
+!$omp error severity(fatal) severity(warning) ! { dg-error "Failed to match clause at" }
+!$omp error message("foo") message("foo") ! { dg-error "Failed to match clause at" }
+!$omp error message("foo"),at(compilation),severity(fatal),asdf ! { dg-error "Failed to match clause" }
+
+!$omp error at(execution) ! { dg-error "Unexpected !.OMP ERROR statement in MODULE" }
+
+end module
+
+module m2
+character(len=10) :: msg
+!$omp error message(1) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error message(1.2) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error message(4_"foo") ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error message(["bar","bar"]) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error message(msg) ! { dg-error "Constant character expression required in MESSAGE clause" }
+
+type S
+ !$omp error at(execution) message("foo")! { dg-error "Unexpected !.OMP ERROR statement at" }
+ integer s
+end type
+end module
+
+subroutine bar
+character(len=10) :: msg
+!$omp error at(execution) message(1) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error at(execution) message(1.2) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error at(execution) message(4_"foo") ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error at(execution) message(["bar","bar"]) ! { dg-error "MESSAGE clause at .1. requires a scalar default-kind CHARACTER expression" }
+!$omp error at(execution) message(msg) ! OK
+
+end
+
+integer function foo (i, x, msg)
+ integer :: i
+ logical :: x
+ character(len=*) :: msg
+ !$omp error message(msg) ! { dg-error "Constant character expression required in MESSAGE clause" }
+ if (x) then
+ !$omp error at(execution) ! OK
+ end if
+ i = i + 1
+ if (x) then
+ ;
+ else
+ !$omp error at(execution) severity(warning) ! OK
+ end if
+ i = i + 1
+ select case (.false.)
+ !$omp error severity(fatal) at(execution) ! { dg-error "Expected a CASE or END SELECT statement following SELECT CASE" }
+ end select
+ do while (.false.)
+ !$omp error at(execution)message("42 - 1") ! OK
+ i = i + 1
+ end do
+99 continue
+ !$omp error severity(warning) message("bar") at(execution) ! OK
+ i = i + 1
+ foo = i
+end
+
+
+subroutine foobar
+ if (.true.) & ! { dg-error "Syntax error in IF-clause after" }
+ !$omp error at(execution)
+
+ continue
+
+ if (.true.) & ! { dg-error "Syntax error in IF-clause after" }
+ !$omp error ! { dg-error ".OMP ERROR encountered at" }
+end
diff --git a/libgomp/testsuite/libgomp.fortran/error-1.f90 b/libgomp/testsuite/libgomp.fortran/error-1.f90
new file mode 100644
index 00000000000..92c246cfcaf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/error-1.f90
@@ -0,0 +1,78 @@
+! { dg-shouldfail "error directive" }
+
+module m
+ implicit none (external, type)
+contains
+integer function foo (i, x)
+ integer, value :: i, x
+ if (x /= 0) then
+ !$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
+ i = i + 1
+ end if
+ if (x /= 0) then
+ ! ...
+ else
+ !$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
+ i = i + 2
+ end if
+ select case(0)
+ !$omp error severity(warning) ! { dg-warning ".OMP ERROR encountered at .1." }
+ case default
+ !
+ end select
+ do while (.false.)
+ !$omp error message("42 - 1") severity (warning) ! { dg-warning ".OMP ERROR encountered at .1.: 42 - 1" }
+ i = i + 4
+ end do
+99 continue
+ !$omp error severity(warning) message("bar") at(compilation) ! { dg-warning ".OMP ERROR encountered at .1.: bar" }
+ i = i + 8
+ foo = i
+end function
+end module
+
+program main
+ use m
+ implicit none (external, type)
+ character(len=13) :: msg
+ character(len=:), allocatable :: msg2, msg3
+
+ msg = "my message"
+ if (foo (5, 0) /= 15 .or. foo (7, 1) /= 16) &
+ stop 1
+ msg2 = "Paris"
+ msg3 = "To thine own self be true"
+ call bar ("Polonius", "Laertes", msg2, msg3)
+ msg2 = "Hello World"
+ !$omp error at (execution) severity (warning)
+ !$omp error at (execution) severity (warning) message(trim(msg(4:)))
+ !$omp error at (execution) severity (warning) message ("Farewell")
+ !$omp error at (execution) severity (warning) message (msg2)
+ !$omp error at (execution) severity (warning) message (msg(4:6))
+ !$omp error at (execution) severity (fatal) message (msg)
+ ! unreachable due to 'fatal'---------^
+ !$omp error at (execution) severity (warning) message ("foobar")
+contains
+ subroutine bar(x, y, a, b)
+ character(len=*) :: x, y
+ character(len=:), allocatable :: a, b
+ optional :: y, b
+ intent(in) :: x, y, a, b
+ !$omp error at (execution) severity (warning) message (x)
+ !$omp error at (execution) severity (warning) message (y)
+ !$omp error at (execution) severity (warning) message (a)
+ !$omp error at (execution) severity (warning) message (b)
+ end subroutine
+end
+
+! { dg-output "(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: Polonius(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: Laertes(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: Paris(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: To thine own self be true(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: Farewell(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: Hello World(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: mes(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: fatal error: error directive encountered: my message (\n|\r|\n\r)" }
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive)
2021-08-20 10:00 ` [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive) Tobias Burnus
@ 2021-08-20 10:08 ` Jakub Jelinek
0 siblings, 0 replies; 9+ messages in thread
From: Jakub Jelinek @ 2021-08-20 10:08 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Fri, Aug 20, 2021 at 12:00:10PM +0200, Tobias Burnus wrote:
> gcc/fortran/ChangeLog:
>
> * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity'
> and 'message' clauses.
> (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR.
> * gfortran.h (gfc_statement): Add ST_OMP_ERROR.
> (gfc_omp_severity_type, gfc_omp_at_type): New.
> (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause;
> use more bitfields + ENUM_BITFIELD.
> (gfc_exec_op): Add EXEC_OMP_ERROR.
> * match.h (gfc_match_omp_error): New.
> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE).
> (gfc_match_omp_clauses): Handle new clauses.
> (OMP_ERROR_CLAUSES, gfc_match_omp_error): New.
> (resolve_omp_clauses): Resolve new clauses.
> (omp_code_to_statement, gfc_resolve_omp_directive): Handle
> EXEC_OMP_ERROR.
> * parse.c (decode_omp_directive, next_statement,
> gfc_ascii_statement): Handle 'omp error'.
> * resolve.c (gfc_resolve_blocks): Likewise.
> * st.c (gfc_free_statement): Likewise.
> * trans-openmp.c (gfc_trans_omp_error): Likewise.
> (gfc_trans_omp_directive): Likewise.
> * trans.c (trans_code): Likewise.
>
> libgomp/ChangeLog:
>
> * testsuite/libgomp.fortran/error-1.f90: New test.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/gomp/error-1.f90: New test.
> * gfortran.dg/gomp/error-2.f90: New test.
> * gfortran.dg/gomp/error-3.f90: New test.
LGTM, thanks.
Jakub
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 9:45 [committed] openmp: Implement the error directive Jakub Jelinek
2021-08-20 10:00 ` [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive) Tobias Burnus
@ 2021-08-20 13:11 ` Thomas Schwinge
2021-08-20 13:16 ` Thomas Schwinge
2021-08-20 13:21 ` Jakub Jelinek
1 sibling, 2 replies; 9+ messages in thread
From: Thomas Schwinge @ 2021-08-20 13:11 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, Tobias Burnus
Hi!
On 2021-08-20T11:45:29+0200, Jakub Jelinek via Gcc-patches <gcc-patches@gcc.gnu.org> wrote:
> --- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
> +++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
> +void
> +GOMP_warning (const char *msg, size_t msglen)
> +{
> + if (msg && msglen == (size_t) -1)
> + gomp_error ("error directive encountered: %s", msg);
> + else if (msg)
> + {
> + fputs ("\nlibgomp: error directive encountered: ", stderr);
> + fwrite (msg, 1, msglen, stderr);
> + fputc ('\n', stderr);
> + }
> + else
> + gomp_error ("error directive encountered");
> +}
> +
> +void
> +GOMP_error (const char *msg, size_t msglen)
> +{
> + if (msg && msglen == (size_t) -1)
> + gomp_fatal ("fatal error: error directive encountered: %s", msg);
> + else if (msg)
> + {
> + fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
> + fwrite (msg, 1, msglen, stderr);
> + fputc ('\n', stderr);
> + exit (EXIT_FAILURE);
> + }
> + else
> + gomp_fatal ("fatal error: error directive encountered");
> +}
At least for nvptx offloading, and at least given the newlib sources I'm
using, the 'fputs'/'fwrite' calls here drag in 'isatty', which isn't
provided by my nvptx newlib at present, so we get, for example:
[...]
FAIL: libgomp.c/../libgomp.c-c++-common/declare_target-1.c (test for excess errors)
Excess errors:
unresolved symbol isatty
mkoffload: fatal error: [...]/build-gcc/./gcc/x86_64-pc-linux-gnu-accel-nvptx-none-gcc returned 1 exit status
[...]
..., and many more.
Now, there are many ways of addressing this... The most simple one:
conditionalize these 'GOMP_warning'/'GOMP_error' definitions on
'#ifndef LIBGOMP_OFFLOADED_ONLY' is not possible here, because it's
permissible to use the 'error' directive also inside 'target' regions, as
far as I can tell?
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 13:11 ` [committed] openmp: Implement the error directive Thomas Schwinge
@ 2021-08-20 13:16 ` Thomas Schwinge
2021-08-20 13:21 ` Jakub Jelinek
1 sibling, 0 replies; 9+ messages in thread
From: Thomas Schwinge @ 2021-08-20 13:16 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, Tobias Burnus
Hi!
On 2021-08-20T15:11:45+0200, I wrote:
> On 2021-08-20T11:45:29+0200, Jakub Jelinek via Gcc-patches <gcc-patches@gcc.gnu.org> wrote:
>> --- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
>> +++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
>
>> +void
>> +GOMP_warning (const char *msg, size_t msglen)
>> +{
>> + if (msg && msglen == (size_t) -1)
>> + gomp_error ("error directive encountered: %s", msg);
>> + else if (msg)
>> + {
>> + fputs ("\nlibgomp: error directive encountered: ", stderr);
>> + fwrite (msg, 1, msglen, stderr);
>> + fputc ('\n', stderr);
>> + }
>> + else
>> + gomp_error ("error directive encountered");
>> +}
>> +
>> +void
>> +GOMP_error (const char *msg, size_t msglen)
>> +{
>> + if (msg && msglen == (size_t) -1)
>> + gomp_fatal ("fatal error: error directive encountered: %s", msg);
>> + else if (msg)
>> + {
>> + fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
>> + fwrite (msg, 1, msglen, stderr);
>> + fputc ('\n', stderr);
>> + exit (EXIT_FAILURE);
>> + }
>> + else
>> + gomp_fatal ("fatal error: error directive encountered");
>> +}
>
> At least for nvptx offloading, and at least given the newlib sources I'm
> using, the 'fputs'/'fwrite' calls here drag in 'isatty', which isn't
> provided by my nvptx newlib at present, so we get, for example:
>
> [...]
> FAIL: libgomp.c/../libgomp.c-c++-common/declare_target-1.c (test for excess errors)
> Excess errors:
> unresolved symbol isatty
> mkoffload: fatal error: [...]/build-gcc/./gcc/x86_64-pc-linux-gnu-accel-nvptx-none-gcc returned 1 exit status
> [...]
>
> ..., and many more.
>
> Now, there are many ways of addressing this... The most simple one:
> conditionalize these 'GOMP_warning'/'GOMP_error' definitions on
> '#ifndef LIBGOMP_OFFLOADED_ONLY' is not possible here, because it's
> permissible to use the 'error' directive also inside 'target' regions, as
> far as I can tell?
Ah, I just re-discovered 'libgomp/config/nvptx/error.c' -- I'll cook
something up.
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 13:11 ` [committed] openmp: Implement the error directive Thomas Schwinge
2021-08-20 13:16 ` Thomas Schwinge
@ 2021-08-20 13:21 ` Jakub Jelinek
2021-08-20 13:54 ` Thomas Schwinge
1 sibling, 1 reply; 9+ messages in thread
From: Jakub Jelinek @ 2021-08-20 13:21 UTC (permalink / raw)
To: Thomas Schwinge; +Cc: gcc-patches, Tobias Burnus
On Fri, Aug 20, 2021 at 03:11:45PM +0200, Thomas Schwinge wrote:
> > --- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
> > +++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
>
> > +void
> > +GOMP_warning (const char *msg, size_t msglen)
> > +{
> > + if (msg && msglen == (size_t) -1)
> > + gomp_error ("error directive encountered: %s", msg);
> > + else if (msg)
> > + {
> > + fputs ("\nlibgomp: error directive encountered: ", stderr);
> > + fwrite (msg, 1, msglen, stderr);
> > + fputc ('\n', stderr);
> > + }
> > + else
> > + gomp_error ("error directive encountered");
> > +}
> > +
> > +void
> > +GOMP_error (const char *msg, size_t msglen)
> > +{
> > + if (msg && msglen == (size_t) -1)
> > + gomp_fatal ("fatal error: error directive encountered: %s", msg);
> > + else if (msg)
> > + {
> > + fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
> > + fwrite (msg, 1, msglen, stderr);
> > + fputc ('\n', stderr);
> > + exit (EXIT_FAILURE);
> > + }
> > + else
> > + gomp_fatal ("fatal error: error directive encountered");
> > +}
>
> At least for nvptx offloading, and at least given the newlib sources I'm
> using, the 'fputs'/'fwrite' calls here drag in 'isatty', which isn't
> provided by my nvptx newlib at present, so we get, for example:
fputs/fputc/vfprintf/exit/stderr have been in use by error.c already before,
so this must be the fwrite call.
The above is for Fortran which doesn't have zero terminated strings.
Initially I wanted to use instead ... encountered: %.*s", (int) msglen, stderr);
which doesn't handle > 2GB messages, but with offloading who cares, nobody
sane would be trying to print > 2GB messages from offloading regions.
The question is if it should be achieved through copy of error.c in
config/nvptx/, or just include_next there with say fwrite redefined as a
macro that does fprintf ("%.*s", (int) msglen, msg, file)?
> Now, there are many ways of addressing this... The most simple one:
> conditionalize these 'GOMP_warning'/'GOMP_error' definitions on
> '#ifndef LIBGOMP_OFFLOADED_ONLY' is not possible here, because it's
> permissible to use the 'error' directive also inside 'target' regions, as
> far as I can tell?
!$omp error at(execution) message('whatever')
can be used in offloading regions.
Jakub
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 13:21 ` Jakub Jelinek
@ 2021-08-20 13:54 ` Thomas Schwinge
2021-08-20 22:21 ` Thomas Schwinge
0 siblings, 1 reply; 9+ messages in thread
From: Thomas Schwinge @ 2021-08-20 13:54 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 3364 bytes --]
Hi Jakub!
On 2021-08-20T15:21:12+0200, Jakub Jelinek <jakub@redhat.com> wrote:
> On Fri, Aug 20, 2021 at 03:11:45PM +0200, Thomas Schwinge wrote:
>> > --- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
>> > +++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
>>
>> > +void
>> > +GOMP_warning (const char *msg, size_t msglen)
>> > +{
>> > + if (msg && msglen == (size_t) -1)
>> > + gomp_error ("error directive encountered: %s", msg);
>> > + else if (msg)
>> > + {
>> > + fputs ("\nlibgomp: error directive encountered: ", stderr);
>> > + fwrite (msg, 1, msglen, stderr);
>> > + fputc ('\n', stderr);
>> > + }
>> > + else
>> > + gomp_error ("error directive encountered");
>> > +}
>> > +
>> > +void
>> > +GOMP_error (const char *msg, size_t msglen)
>> > +{
>> > + if (msg && msglen == (size_t) -1)
>> > + gomp_fatal ("fatal error: error directive encountered: %s", msg);
>> > + else if (msg)
>> > + {
>> > + fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
>> > + fwrite (msg, 1, msglen, stderr);
>> > + fputc ('\n', stderr);
>> > + exit (EXIT_FAILURE);
>> > + }
>> > + else
>> > + gomp_fatal ("fatal error: error directive encountered");
>> > +}
>>
>> At least for nvptx offloading, and at least given the newlib sources I'm
>> using, the 'fputs'/'fwrite' calls here drag in 'isatty', which isn't
>> provided by my nvptx newlib at present, so we get, for example:
>
> fputs/fputc/vfprintf/exit/stderr have been in use by error.c already before,
> so this must be the fwrite call.
ACK.
> The above is for Fortran which doesn't have zero terminated strings.
> Initially I wanted to use instead ... encountered: %.*s", (int) msglen, stderr);
> which doesn't handle > 2GB messages, but with offloading who cares, nobody
> sane would be trying to print > 2GB messages from offloading regions.
(... likewise from the host...) ;-)
> The question is if it should be achieved through copy of error.c in
> config/nvptx/, or just include_next there with say fwrite redefined as a
> macro that does fprintf ("%.*s", (int) msglen, msg, file)?
(Right, that was also my plan.)
| Ah, I just re-discovered 'libgomp/config/nvptx/error.c' -- I'll cook
| something up.
So, guess what this newlib 'printf ("%.*s", [...]);' prints?
Yes: literal '%.*s'... Next try: a 'fputc' loop?
See attached "[WIP] Make the OpenMP 'error' directive work for nvptx
offloading".
>> Now, there are many ways of addressing this... The most simple one:
>> conditionalize these 'GOMP_warning'/'GOMP_error' definitions on
>> '#ifndef LIBGOMP_OFFLOADED_ONLY' is not possible here, because it's
>> permissible to use the 'error' directive also inside 'target' regions, as
>> far as I can tell?
>
> !$omp error at(execution) message('whatever')
> can be used in offloading regions.
Yes, generally works, but at least for Fortran, 'severity (fatal)' seems
to cause a hang, so another thing to be looked into...
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-WIP-Make-the-OpenMP-error-directive-work-for-nvptx-o.patch --]
[-- Type: text/x-diff, Size: 4770 bytes --]
From d524726ff5f319658ef317afaf0077f43b8eccf8 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 20 Aug 2021 15:12:56 +0200
Subject: [PATCH] [WIP] Make the OpenMP 'error' directive work for nvptx
offloading
The 'fputs'/'fwrite' calls in 'libgomp/error.c:GOMP_warning',
'libgomp/error.c:GOMP_error' drag in 'isatty', which isn't provided by my nvptx
newlib build at present, so we get, for example:
[...]
FAIL: libgomp.c/../libgomp.c-c++-common/declare_target-1.c (test for excess errors)
Excess errors:
unresolved symbol isatty
mkoffload: fatal error: [...]/build-gcc/./gcc/x86_64-pc-linux-gnu-accel-nvptx-none-gcc returned 1 exit status
[...]
..., and many more.
Fix up for recent commit 0d973c0a0d90a0a302e7eda1a4d9709be3c5b102
"openmp: Implement the error directive".
---
libgomp/config/nvptx/error.c | 2 ++
libgomp/error.c | 6 ++++++
libgomp/testsuite/libgomp.c-c++-common/error-1.c | 5 +++++
libgomp/testsuite/libgomp.fortran/error-1.f90 | 6 ++++++
4 files changed, 19 insertions(+)
diff --git a/libgomp/config/nvptx/error.c b/libgomp/config/nvptx/error.c
index dfa75da354f..40c907e0c9e 100644
--- a/libgomp/config/nvptx/error.c
+++ b/libgomp/config/nvptx/error.c
@@ -34,9 +34,11 @@
#undef vfprintf
#undef fputs
#undef fputc
+#undef fwrite
#define vfprintf(stream, fmt, list) vprintf (fmt, list)
#define fputs(s, stream) printf ("%s", s)
#define fputc(c, stream) printf ("%c", c)
+#define fwrite(ptr, size, nmemb, stream) printf ("%.*s", (int) (size * nmemb), ptr)
#include "../../error.c"
diff --git a/libgomp/error.c b/libgomp/error.c
index 9b69a4b33fe..35fc823abf9 100644
--- a/libgomp/error.c
+++ b/libgomp/error.c
@@ -90,6 +90,12 @@ gomp_fatal (const char *fmt, ...)
va_end (list);
}
+//TODO just for testing
+#if 0
+#undef fwrite
+#define fwrite(ptr, size, nmemb, stream) fprintf (stream, "%.*s", (int) (size * nmemb), ptr)
+#endif
+
void
GOMP_warning (const char *msg, size_t msglen)
{
diff --git a/libgomp/testsuite/libgomp.c-c++-common/error-1.c b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
index 5f454c1adaa..dd3e8b135dd 100644
--- a/libgomp/testsuite/libgomp.c-c++-common/error-1.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
@@ -39,11 +39,16 @@ main ()
#pragma omp error at (execution) severity (warning)
const char *msg = "my message" + 2;
#pragma omp error at (execution) severity (warning) message (msg + 1)
+ #pragma omp target
+ {
+ #pragma omp error at (execution) severity (warning) message ("hello from a distance")
+ }
#pragma omp error at (execution) severity (fatal) message (msg - 2)
#pragma omp error at (execution) severity (warning) message ("foobar")
return 0;
}
/* { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" } */
+/* { dg-output "libgomp: error directive encountered: hello from a distance(\n|\r|\n\r)(\n|\r|\n\r)" } */
/* { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" } */
/* { dg-output "libgomp: fatal error: error directive encountered: my message" } */
diff --git a/libgomp/testsuite/libgomp.fortran/error-1.f90 b/libgomp/testsuite/libgomp.fortran/error-1.f90
index 92c246cfcaf..496512aa6a7 100644
--- a/libgomp/testsuite/libgomp.fortran/error-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/error-1.f90
@@ -47,9 +47,14 @@ program main
!$omp error at (execution) severity (warning)
!$omp error at (execution) severity (warning) message(trim(msg(4:)))
!$omp error at (execution) severity (warning) message ("Farewell")
+ !$omp target
+ !$omp error at (execution) severity (warning) message ("ffrom a distanceee"(2:16))
+ !$omp end target
!$omp error at (execution) severity (warning) message (msg2)
!$omp error at (execution) severity (warning) message (msg(4:6))
+ !TODO $omp target
!$omp error at (execution) severity (fatal) message (msg)
+ !TODO $omp end target
! unreachable due to 'fatal'---------^
!$omp error at (execution) severity (warning) message ("foobar")
contains
@@ -73,6 +78,7 @@ end
! { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: Farewell(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: from a distance(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: Hello World(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: mes(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: fatal error: error directive encountered: my message (\n|\r|\n\r)" }
--
2.25.1
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 13:54 ` Thomas Schwinge
@ 2021-08-20 22:21 ` Thomas Schwinge
2021-08-21 5:44 ` Jakub Jelinek
0 siblings, 1 reply; 9+ messages in thread
From: Thomas Schwinge @ 2021-08-20 22:21 UTC (permalink / raw)
To: Jakub Jelinek, gcc-patches, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 4588 bytes --]
Hi!
On 2021-08-20T15:54:34+0200, I wrote:
> On 2021-08-20T15:21:12+0200, Jakub Jelinek <jakub@redhat.com> wrote:
>> On Fri, Aug 20, 2021 at 03:11:45PM +0200, Thomas Schwinge wrote:
>>> > --- libgomp/error.c.jj 2021-08-19 12:53:44.693106618 +0200
>>> > +++ libgomp/error.c 2021-08-19 17:58:55.633203432 +0200
>>>
>>> > +void
>>> > +GOMP_warning (const char *msg, size_t msglen)
>>> > +{
>>> > + if (msg && msglen == (size_t) -1)
>>> > + gomp_error ("error directive encountered: %s", msg);
>>> > + else if (msg)
>>> > + {
>>> > + fputs ("\nlibgomp: error directive encountered: ", stderr);
>>> > + fwrite (msg, 1, msglen, stderr);
>>> > + fputc ('\n', stderr);
>>> > + }
>>> > + else
>>> > + gomp_error ("error directive encountered");
>>> > +}
>>> > +
>>> > +void
>>> > +GOMP_error (const char *msg, size_t msglen)
>>> > +{
>>> > + if (msg && msglen == (size_t) -1)
>>> > + gomp_fatal ("fatal error: error directive encountered: %s", msg);
>>> > + else if (msg)
>>> > + {
>>> > + fputs ("\nlibgomp: fatal error: error directive encountered: ", stderr);
>>> > + fwrite (msg, 1, msglen, stderr);
>>> > + fputc ('\n', stderr);
>>> > + exit (EXIT_FAILURE);
>>> > + }
>>> > + else
>>> > + gomp_fatal ("fatal error: error directive encountered");
>>> > +}
>>>
>>> At least for nvptx offloading, and at least given the newlib sources I'm
>>> using, the 'fputs'/'fwrite' calls here drag in 'isatty', which isn't
>>> provided by my nvptx newlib at present, so we get, for example:
>>
>> fputs/fputc/vfprintf/exit/stderr have been in use by error.c already before,
>> so this must be the fwrite call.
>
> ACK.
>
>> The above is for Fortran which doesn't have zero terminated strings.
>> Initially I wanted to use instead ... encountered: %.*s", (int) msglen, stderr);
>> which doesn't handle > 2GB messages, but with offloading who cares, nobody
>> sane would be trying to print > 2GB messages from offloading regions.
>
> (... likewise from the host...) ;-)
>
>> The question is if it should be achieved through copy of error.c in
>> config/nvptx/, or just include_next there with say fwrite redefined as a
>> macro that does fprintf ("%.*s", (int) msglen, msg, file)?
>
> (Right, that was also my plan.)
>
> | Ah, I just re-discovered 'libgomp/config/nvptx/error.c' -- I'll cook
> | something up.
>
> So, guess what this newlib 'printf ("%.*s", [...]);' prints?
> Yes: literal '%.*s'... Next try: a 'fputc' loop?
Did that; "works". But actually, I think that's good enough for the
intended purpose: there's not much point in optimizing the OpenMP 'error'
directive as long as we still have more than enough real
correctness/performance tasks to be worked on.
Tobias suggested using 'fputc_unlocked', "avoiding repreated locks and
locking for a single stderr char is also pointless", but it's not clear
to me if that's safe to do given that a ton of threads may be hammering
on this in parallel; it's not clear to me if there isn't any
newlib-internal state that needs to be accessed in a serialized way (even
if no actual 'FILE *stream' is involved here)?
>>> permissible to use the 'error' directive also inside 'target' regions, as
>>> far as I can tell?
>>
>> !$omp error at(execution) message('whatever')
>> can be used in offloading regions.
(Also should add test cases for OpenMP 'error' with 'at (execution)' from
deep inside parallelized loop nests, etc., offloaded and non-offloaded?)
> Yes, generally works, but at least for Fortran, 'severity (fatal)' seems
> to cause a hang, so another thing to be looked into...
We thus additionally acquired in 'libgomp/config/nvptx/error.c':
+/* The 'exit (EXIT_FAILURE);' of an Fortran (only, huh?) OpenMP 'error'
+ directive with 'severity (fatal)' causes a hang, so 'abort' instead of
+ 'exit'. */
+#undef exit
+#define exit(status) abort ()
... which is another thing to be resolved incrementally. (Plus adding
corresponding test cases for OpenMP 'error' with 'at (execution)' and
'severity (fatal)' inside OpenMP 'target'.)
Is the attached "Make the OpenMP 'error' directive work for nvptx
offloading" OK to push for now?
Grüße
Thomas
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Make-the-OpenMP-error-directive-work-for-nvptx-offlo.patch --]
[-- Type: text/x-diff, Size: 5511 bytes --]
From 0762945a17c3ff1a0268edc76f87c0063714a0fc Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 20 Aug 2021 15:12:56 +0200
Subject: [PATCH] Make the OpenMP 'error' directive work for nvptx offloading
... and add a minimum amount of offloading testing.
(Leaving aside that 'fwrite' to 'stderr' probably wouldn't work anyway) the
'fwrite' calls in 'libgomp/error.c:GOMP_warning', 'libgomp/error.c:GOMP_error'
drag in 'isatty', which isn't provided by my nvptx newlib build at present, so
we get, for example:
[...]
FAIL: libgomp.c/../libgomp.c-c++-common/declare_target-1.c (test for excess errors)
Excess errors:
unresolved symbol isatty
mkoffload: fatal error: [...]/build-gcc/./gcc/x86_64-pc-linux-gnu-accel-nvptx-none-gcc returned 1 exit status
[...]
..., and many more.
Fix up for recent commit 0d973c0a0d90a0a302e7eda1a4d9709be3c5b102
"openmp: Implement the error directive".
---
libgomp/config/nvptx/error.c | 32 +++++++++++++++++--
.../testsuite/libgomp.c-c++-common/error-1.c | 10 ++++++
libgomp/testsuite/libgomp.fortran/error-1.f90 | 9 ++++++
3 files changed, 48 insertions(+), 3 deletions(-)
diff --git a/libgomp/config/nvptx/error.c b/libgomp/config/nvptx/error.c
index dfa75da354f..c55791e34b4 100644
--- a/libgomp/config/nvptx/error.c
+++ b/libgomp/config/nvptx/error.c
@@ -31,12 +31,38 @@
#include <stdio.h>
#include <stdlib.h>
-#undef vfprintf
-#undef fputs
-#undef fputc
+/* No 'FILE *stream's, just basic 'vprintf' etc. */
+
+#undef vfprintf
#define vfprintf(stream, fmt, list) vprintf (fmt, list)
+
+#undef fputs
#define fputs(s, stream) printf ("%s", s)
+
+#undef fputc
#define fputc(c, stream) printf ("%c", c)
+#undef fwrite
+#if 0
+# define fwrite(ptr, size, nmemb, stream) \
+ printf ("%.*s", (int) (size * nmemb), (int) (size * nmemb), ptr)
+/* ... prints literal '%.*s'. */
+#else
+# define fwrite(ptr, size, nmemb, stream) \
+ do { \
+ /* Yuck! */ \
+ for (size_t i = 0; i < size * nmemb; ++i) \
+ printf ("%c", ptr[i]); \
+ } while (0)
+#endif
+
+
+/* The 'exit (EXIT_FAILURE);' of an Fortran (only, huh?) OpenMP 'error'
+ directive with 'severity (fatal)' causes a hang, so 'abort' instead of
+ 'exit'. */
+#undef exit
+#define exit(status) abort ()
+
+
#include "../../error.c"
diff --git a/libgomp/testsuite/libgomp.c-c++-common/error-1.c b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
index 5f454c1adaa..04c0519bf63 100644
--- a/libgomp/testsuite/libgomp.c-c++-common/error-1.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
@@ -34,11 +34,20 @@ foo (int i, int x)
int
main ()
{
+ /* Initialize offloading early, so that any output this may produce doesn't
+ disturb the 'dg-output' scanning below. */
+ #pragma omp target
+ ;
+
if (foo (5, 0) != 13 || foo (6, 1) != 17)
abort ();
#pragma omp error at (execution) severity (warning)
const char *msg = "my message" + 2;
#pragma omp error at (execution) severity (warning) message (msg + 1)
+ #pragma omp target
+ {
+ #pragma omp error at (execution) severity (warning) message ("hello from a distance")
+ }
#pragma omp error at (execution) severity (fatal) message (msg - 2)
#pragma omp error at (execution) severity (warning) message ("foobar")
return 0;
@@ -46,4 +55,5 @@ main ()
/* { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" } */
/* { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" } */
+/* { dg-output "libgomp: error directive encountered: hello from a distance(\n|\r|\n\r)(\n|\r|\n\r)" } */
/* { dg-output "libgomp: fatal error: error directive encountered: my message" } */
diff --git a/libgomp/testsuite/libgomp.fortran/error-1.f90 b/libgomp/testsuite/libgomp.fortran/error-1.f90
index 92c246cfcaf..7c497fd002e 100644
--- a/libgomp/testsuite/libgomp.fortran/error-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/error-1.f90
@@ -37,6 +37,11 @@ program main
character(len=13) :: msg
character(len=:), allocatable :: msg2, msg3
+ ! Initialize offloading early, so that any output this may produce doesn't
+ ! disturb the 'dg-output' scanning below.
+ !$omp target
+ !$omp end target
+
msg = "my message"
if (foo (5, 0) /= 15 .or. foo (7, 1) /= 16) &
stop 1
@@ -47,6 +52,9 @@ program main
!$omp error at (execution) severity (warning)
!$omp error at (execution) severity (warning) message(trim(msg(4:)))
!$omp error at (execution) severity (warning) message ("Farewell")
+ !$omp target
+ !$omp error at (execution) severity (warning) message ("ffrom a distanceee"(2:16))
+ !$omp end target
!$omp error at (execution) severity (warning) message (msg2)
!$omp error at (execution) severity (warning) message (msg(4:6))
!$omp error at (execution) severity (fatal) message (msg)
@@ -73,6 +81,7 @@ end
! { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: Farewell(\n|\r|\n\r)(\n|\r|\n\r)" }
+! { dg-output "libgomp: error directive encountered: from a distance(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: Hello World(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: error directive encountered: mes(\n|\r|\n\r)(\n|\r|\n\r)" }
! { dg-output "libgomp: fatal error: error directive encountered: my message (\n|\r|\n\r)" }
--
2.25.1
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [committed] openmp: Implement the error directive
2021-08-20 22:21 ` Thomas Schwinge
@ 2021-08-21 5:44 ` Jakub Jelinek
0 siblings, 0 replies; 9+ messages in thread
From: Jakub Jelinek @ 2021-08-21 5:44 UTC (permalink / raw)
To: Thomas Schwinge; +Cc: gcc-patches, Tobias Burnus
On Sat, Aug 21, 2021 at 12:21:41AM +0200, Thomas Schwinge wrote:
> Fix up for recent commit 0d973c0a0d90a0a302e7eda1a4d9709be3c5b102
> "openmp: Implement the error directive".
> ---
> libgomp/config/nvptx/error.c | 32 +++++++++++++++++--
> .../testsuite/libgomp.c-c++-common/error-1.c | 10 ++++++
> libgomp/testsuite/libgomp.fortran/error-1.f90 | 9 ++++++
> 3 files changed, 48 insertions(+), 3 deletions(-)
As we only use it with size equal to literal 1, I guess it is ok that way,
otherwise it would be nice to at least precompute size * nmemb just once
instead of every iteration.
Ok.
> diff --git a/libgomp/config/nvptx/error.c b/libgomp/config/nvptx/error.c
> index dfa75da354f..c55791e34b4 100644
> --- a/libgomp/config/nvptx/error.c
> +++ b/libgomp/config/nvptx/error.c
> @@ -31,12 +31,38 @@
> #include <stdio.h>
> #include <stdlib.h>
>
> -#undef vfprintf
> -#undef fputs
> -#undef fputc
>
> +/* No 'FILE *stream's, just basic 'vprintf' etc. */
> +
> +#undef vfprintf
> #define vfprintf(stream, fmt, list) vprintf (fmt, list)
> +
> +#undef fputs
> #define fputs(s, stream) printf ("%s", s)
> +
> +#undef fputc
> #define fputc(c, stream) printf ("%c", c)
>
> +#undef fwrite
> +#if 0
> +# define fwrite(ptr, size, nmemb, stream) \
> + printf ("%.*s", (int) (size * nmemb), (int) (size * nmemb), ptr)
> +/* ... prints literal '%.*s'. */
> +#else
> +# define fwrite(ptr, size, nmemb, stream) \
> + do { \
> + /* Yuck! */ \
> + for (size_t i = 0; i < size * nmemb; ++i) \
> + printf ("%c", ptr[i]); \
> + } while (0)
> +#endif
> +
> +
> +/* The 'exit (EXIT_FAILURE);' of an Fortran (only, huh?) OpenMP 'error'
> + directive with 'severity (fatal)' causes a hang, so 'abort' instead of
> + 'exit'. */
> +#undef exit
> +#define exit(status) abort ()
> +
> +
> #include "../../error.c"
> diff --git a/libgomp/testsuite/libgomp.c-c++-common/error-1.c b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
> index 5f454c1adaa..04c0519bf63 100644
> --- a/libgomp/testsuite/libgomp.c-c++-common/error-1.c
> +++ b/libgomp/testsuite/libgomp.c-c++-common/error-1.c
> @@ -34,11 +34,20 @@ foo (int i, int x)
> int
> main ()
> {
> + /* Initialize offloading early, so that any output this may produce doesn't
> + disturb the 'dg-output' scanning below. */
> + #pragma omp target
> + ;
> +
> if (foo (5, 0) != 13 || foo (6, 1) != 17)
> abort ();
> #pragma omp error at (execution) severity (warning)
> const char *msg = "my message" + 2;
> #pragma omp error at (execution) severity (warning) message (msg + 1)
> + #pragma omp target
> + {
> + #pragma omp error at (execution) severity (warning) message ("hello from a distance")
> + }
> #pragma omp error at (execution) severity (fatal) message (msg - 2)
> #pragma omp error at (execution) severity (warning) message ("foobar")
> return 0;
> @@ -46,4 +55,5 @@ main ()
>
> /* { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" } */
> /* { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" } */
> +/* { dg-output "libgomp: error directive encountered: hello from a distance(\n|\r|\n\r)(\n|\r|\n\r)" } */
> /* { dg-output "libgomp: fatal error: error directive encountered: my message" } */
> diff --git a/libgomp/testsuite/libgomp.fortran/error-1.f90 b/libgomp/testsuite/libgomp.fortran/error-1.f90
> index 92c246cfcaf..7c497fd002e 100644
> --- a/libgomp/testsuite/libgomp.fortran/error-1.f90
> +++ b/libgomp/testsuite/libgomp.fortran/error-1.f90
> @@ -37,6 +37,11 @@ program main
> character(len=13) :: msg
> character(len=:), allocatable :: msg2, msg3
>
> + ! Initialize offloading early, so that any output this may produce doesn't
> + ! disturb the 'dg-output' scanning below.
> + !$omp target
> + !$omp end target
> +
> msg = "my message"
> if (foo (5, 0) /= 15 .or. foo (7, 1) /= 16) &
> stop 1
> @@ -47,6 +52,9 @@ program main
> !$omp error at (execution) severity (warning)
> !$omp error at (execution) severity (warning) message(trim(msg(4:)))
> !$omp error at (execution) severity (warning) message ("Farewell")
> + !$omp target
> + !$omp error at (execution) severity (warning) message ("ffrom a distanceee"(2:16))
> + !$omp end target
> !$omp error at (execution) severity (warning) message (msg2)
> !$omp error at (execution) severity (warning) message (msg(4:6))
> !$omp error at (execution) severity (fatal) message (msg)
> @@ -73,6 +81,7 @@ end
> ! { dg-output "libgomp: error directive encountered(\n|\r|\n\r)(\n|\r|\n\r)" }
> ! { dg-output "libgomp: error directive encountered: message(\n|\r|\n\r)(\n|\r|\n\r)" }
> ! { dg-output "libgomp: error directive encountered: Farewell(\n|\r|\n\r)(\n|\r|\n\r)" }
> +! { dg-output "libgomp: error directive encountered: from a distance(\n|\r|\n\r)(\n|\r|\n\r)" }
> ! { dg-output "libgomp: error directive encountered: Hello World(\n|\r|\n\r)(\n|\r|\n\r)" }
> ! { dg-output "libgomp: error directive encountered: mes(\n|\r|\n\r)(\n|\r|\n\r)" }
> ! { dg-output "libgomp: fatal error: error directive encountered: my message (\n|\r|\n\r)" }
Jakub
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2021-08-21 5:45 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-20 9:45 [committed] openmp: Implement the error directive Jakub Jelinek
2021-08-20 10:00 ` [Patch] Fortran: Add OpenMP's error directive (was: [committed] openmp: Implement the error directive) Tobias Burnus
2021-08-20 10:08 ` Jakub Jelinek
2021-08-20 13:11 ` [committed] openmp: Implement the error directive Thomas Schwinge
2021-08-20 13:16 ` Thomas Schwinge
2021-08-20 13:21 ` Jakub Jelinek
2021-08-20 13:54 ` Thomas Schwinge
2021-08-20 22:21 ` Thomas Schwinge
2021-08-21 5:44 ` Jakub Jelinek
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).