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.

1 files changed, 34 insertions, 0 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index e0a0014..91888f3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5369,6 +5369,38 @@ gfc_trans_omp_depobj (gfc_code *code)
 }
 
 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)
 {
   tree call;
@@ -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: