https://gcc.gnu.org/g:7affa61f67813b86206db027b981b165bccb84b7

commit 7affa61f67813b86206db027b981b165bccb84b7
Author: Sandra Loosemore <[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 848555e60706..3be828c960a7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3918,7 +3918,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 356fc5936dc5..bcb54512943f 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -13976,13 +13976,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)
     {
@@ -14023,6 +14028,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 13194be355b6..66709dd0be95 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -9246,7 +9246,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);
     }
@@ -9348,6 +9352,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);
@@ -9527,11 +9532,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);
 }
@@ -9544,11 +9554,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);
 }
@@ -9561,12 +9575,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);
 }

Reply via email to