https://gcc.gnu.org/g:6f95af4f22b641fbb3509f1436bce811d4e4acad
commit r15-7376-g6f95af4f22b641fbb3509f1436bce811d4e4acad
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.
Diff:
---
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 b1684f841f5b..e8df9d63fec2 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 e29ef85ae398..e9103cd3bac3 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 a20f610a03dc..7a68977ed4d0 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)
