For an example output, see
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=113067#c2
Fixed in commit r15-7376-g6f95af4f22b641 which also fixes the testsuite
issue (off by one) of my previous commit for PR118745, ups!
Tobias
commit 6f95af4f22b641fbb3509f1436bce811d4e4acad
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Wed Feb 5 14:03:47 2025 +0100
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.
---
gcc/fortran/openmp.cc | 6 ++++--
gcc/fortran/trans-openmp.cc | 8 +++++---
gcc/testsuite/gfortran.dg/gomp/append_args-2.f90 | 2 +-
3 files changed, 10 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index b1684f841f5..e8df9d63fec 100644
--- 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 e29ef85ae39..e9103cd3bac 100644
--- 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 a20f610a03d..7a68977ed4d 100644
--- 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)
