Fortran/OpenMP: Add location data to 'sorry' [PR118740]

	PR fortran/118740

gcc/fortran/ChangeLog:

	* openmp.cc (gfc_match_omp_context_selector, match_omp_metadirective):
	Change sorry to sorry_at and use gfc_current_locus as location.
	* trans-openmp.cc (gfc_trans_omp_clauses): Likewise, but use n->where.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/append_args-2.f90: Update for line change.

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index b1684f841f5bc38e322256e3e674aaf48bfe05d8..e8df9d63fec2bbcd02a60d39e5d96d3e52ec7554 100644 (file)
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6536,7 +6536,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
                    /* FIXME: The "requires" selector was added in OpenMP 5.1.
                       Currently only the now-deprecated syntax
                       from OpenMP 5.0 is supported.  */
-                   sorry ("%<requires%> selector is not supported yet");
+                   sorry_at (gfc_get_location (&gfc_current_locus),
+                             "%<requires%> selector is not supported yet");
                    return MATCH_ERROR;
                  }
                else
@@ -6942,7 +6943,8 @@ match_omp_metadirective (bool begin_p)
       gfc_matching_omp_context_selector = false;
 
       if (is_omp_declarative_stmt (directive))
-       sorry ("declarative directive variants are not supported");
+       sorry_at (gfc_get_location (&gfc_current_locus),
+                 "declarative directive variants are not supported");
 
       if (gfc_error_flag_test ())
        {

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index e29ef85ae398ad8dbc3fecfd12ca7f92a45bb66a..e9103cd3bac3afc3645fc9fbe7c1e1a1a26ef369 100644 (file)
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -3345,7 +3345,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                  if (openacc && n->sym->ts.type == BT_CLASS)
                    {
                      if (n->sym->attr.optional)
-                       sorry ("optional class parameter");
+                       sorry_at (gfc_get_location (&n->where),
+                                 "optional class parameter");
                      tree ptr = gfc_class_data_get (decl);
                      ptr = build_fold_indirect_ref (ptr);
                      OMP_CLAUSE_DECL (node) = ptr;
@@ -3761,7 +3762,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                            gcc_assert (!ref->next);
                        }
                      else
-                       sorry ("unhandled expression type");
+                       sorry_at (gfc_get_location (&n->where),
+                                 "unhandled expression type");
                    }
 
                  tree inner = se.expr;
@@ -4041,7 +4043,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
                    gcc_unreachable ();
                }
              else
-               sorry ("unhandled expression");
+               sorry_at (gfc_get_location (&n->where), "unhandled expression");
 
              finalize_map_clause:
 

diff --git a/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
index a20f610a03dcb6bf02d38de23a0f497eab2aeace..7a68977ed4d0d28d3e6c47a6278405caa7f5957a 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/append_args-2.f90
@@ -40,7 +40,7 @@ contains
   subroutine f5 ()
     !$omp declare variant (f1ox) match(user={condition(flag)}) & ! { dg-error "the 'append_args' clause can only be specified if the 'dispatch' selector of the construct selector set appears in the 'match' clause at .1." }
     !$omp&  append_args ( interop ( target , targetsync) )
-    ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-2 }
+    ! { dg-error "'q' at .1. must be a nonpointer, nonallocatable scalar integer dummy argument of 'omp_interop_kind' kind as it utilized with the 'append_args' clause at .2." "" { target *-*-* } .-1 }
   end subroutine
 
   subroutine f6 (x, y)