[gcc/devel/omp/gcc-16] OpenMP, Fortran: Handle errors in 'declare mapper' instantiation

https://gcc.gnu.org/g:47219af8e1fbad5496f7fbf674f1f3e106a72955

commit 47219af8e1fbad5496f7fbf674f1f3e106a72955
Author: Julian Brown <[email protected]>
Date:   Mon May 12 16:41:45 2025 +0000

    OpenMP, Fortran: Handle errors in 'declare mapper' instantiation
    
    The patch "OpenMP: Reprocess expanded clauses after 'declare mapper'
    instantiation" added further error-checking to
    gfc_omp_instantiate_mappers, which is called during the translation
    phase of processing, but these errors were effectively ignored for
    further processing of the code.  This patch makes the translation
    phase insert an error_mark_node in these situations instead of
    generating normal tree code.
    
    This patch fixes an ICE in gfortran.dg/gomp/declare-mapper-29.f90
    where it was attempting to gimplify code that had already been
    diagnosed as invalid in the front end.
    
    gcc/fortran/ChangeLog
            * gfortran.h (gfc_omp_instantiate_mappers): Adjust declaration
            to return an error status instead of void.
            * openmp.cc (gfc_gomp_instantiate_mappers): Likewise for the
            the definition.
            * trans-openmp.cc (gfc_trans_omp_target): Check return status of
            call to gfc_omp_instantiate_mappers and insert an error_mark_node
            on failure instead of continuing normal processing of the construct.
            (gfc_trans_omp_target_data): Likewise.
            (gfc_trans_omp_target_enter_data): Likewise.
            (gfc_trans_omp_target_exit_data): Likewise.

Diff:
---
 gcc/fortran/gfortran.h      |  2 +-
 gcc/fortran/openmp.cc       | 10 ++++++++-
 gcc/fortran/trans-openmp.cc | 52 ++++++++++++++++++++++++++++++---------------
 3 files changed, 45 insertions(+), 19 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f0a3b0eb0297..4b4284ab577a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -4015,7 +4015,7 @@ void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_omp_declare (gfc_namespace *);
 void gfc_resolve_omp_udrs (gfc_symtree *);
 void gfc_resolve_omp_udms (gfc_symtree *);
-void gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *,
+bool gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *,
 				  toc_directive = TOC_OPENMP,
 				  int = OMP_LIST_MAP);
 void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 817eda344790..a7a449493be7 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -14555,13 +14555,18 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
   return outlistp;
 }
 
-void
+/* Instantiate mappers for CLAUSES for LIST.  Returns true on success and
+   false if errors were diagnosed.  This function is invoked from the
+   translation phase so callers need to handle passing up the error.  */
+bool
 gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *clauses,
 			     toc_directive cd, int list)
 {
   gfc_omp_namelist *clause = clauses->lists[list];
   gfc_omp_namelist **clausep = &clauses->lists[list];
   bool invoked_mappers = false;
+  int orig_errors, new_errors;
+  gfc_get_errors (NULL, &orig_errors);
 
   for (; clause; clause = *clausep)
     {
@@ -14602,6 +14607,9 @@ gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *c
       resolve_omp_mapper_clauses (code, clauses, gfc_current_ns);
       gfc_current_ns = old_ns;
     }
+
+  gfc_get_errors (NULL, &new_errors);
+  return new_errors == orig_errors;
 }
 
 /* Resolve !$omp declare mapper constructs.  */
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 71fb94c938f2..c517a22e0415 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -10274,7 +10274,11 @@ gfc_trans_omp_target (gfc_code *code)
   if (flag_openmp)
     {
       gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET];
-      gfc_omp_instantiate_mappers (code, target_clauses);
+      if (!gfc_omp_instantiate_mappers (code, target_clauses))
+	{
+	  stmt = error_mark_node;
+	  goto done;
+	}
       omp_clauses = gfc_trans_omp_clauses (&block, target_clauses,
 					   code->loc);
     }
@@ -10376,6 +10380,7 @@ gfc_trans_omp_target (gfc_code *code)
 	OMP_TARGET_COMBINED (stmt) = 1;
       cfun->has_omp_target = true;
     }
+ done:
   gfc_add_expr_to_block (&block, stmt);
   gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
@@ -10555,11 +10560,16 @@ gfc_trans_omp_target_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_data_clauses = code->ext.omp_clauses;
-  gfc_omp_instantiate_mappers (code, target_data_clauses);
-  omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses, code->loc);
-  stmt = gfc_trans_omp_code (code->block->next, true);
-  stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
-		     void_type_node, stmt, omp_clauses);
+  if (gfc_omp_instantiate_mappers (code, target_data_clauses))
+    {
+      omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses,
+					   code->loc);
+      stmt = gfc_trans_omp_code (code->block->next, true);
+      stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
+			 void_type_node, stmt, omp_clauses);
+    }
+  else
+    stmt = error_mark_node;
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }
@@ -10572,11 +10582,15 @@ gfc_trans_omp_target_enter_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses;
-  gfc_omp_instantiate_mappers (code, target_enter_data_clauses);
-  omp_clauses = gfc_trans_omp_clauses (&block, target_enter_data_clauses,
-				       code->loc);
-  stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
-		     omp_clauses);
+  if (gfc_omp_instantiate_mappers (code, target_enter_data_clauses))
+    {
+      omp_clauses = gfc_trans_omp_clauses (&block, target_enter_data_clauses,
+					   code->loc);
+      stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
+			 omp_clauses);
+    }
+  else
+    stmt = error_mark_node;
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }
@@ -10589,12 +10603,16 @@ gfc_trans_omp_target_exit_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses;
-  gfc_omp_instantiate_mappers (code, target_exit_data_clauses,
-			       TOC_OPENMP_EXIT_DATA);
-  omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses,
-				       code->loc, TOC_OPENMP_EXIT_DATA);
-  stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
-		     omp_clauses);
+  if (gfc_omp_instantiate_mappers (code, target_exit_data_clauses,
+				   TOC_OPENMP_EXIT_DATA))
+    {
+      omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses,
+					   code->loc, TOC_OPENMP_EXIT_DATA);
+      stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
+			 omp_clauses);
+    }
+  else
+    stmt = error_mark_node;
   gfc_add_expr_to_block (&block, stmt);
   return gfc_finish_block (&block);
 }