https://gcc.gnu.org/g:a25cc26884663244c3b936af785854abee8949dd
commit r15-6383-ga25cc26884663244c3b936af785854abee8949dd
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed Dec 18 12:43:39 2024 +0100
Fortran: Fix caf_stop_numeric and reporting exceptions from caf [PR57598]
Caf_stop_numeric always exited with code 0, which is wrong. It shall
behave like regular stop. Add reporting exceptions to caf's stop
handlers. For this the existing library routine had to be exported.
libgfortran/ChangeLog:
PR fortran/57598
* caf/single.c (_gfortran_caf_stop_numeric): Report exceptions
on stop. And fix send_by_ref.
(_gfortran_caf_stop_str): Same.
(_gfortran_caf_error_stop_str): Same.
(_gfortran_caf_error_stop): Same.
* gfortran.map: Add report_exception for export.
* libgfortran.h (report_exception): Add to internal export.
* runtime/stop.c (report_exception): Same.
Diff:
---
libgfortran/caf/single.c | 19 +++++++++++++++----
libgfortran/gfortran.map | 1 +
libgfortran/libgfortran.h | 3 +++
libgfortran/runtime/stop.c | 7 +++++--
4 files changed, 24 insertions(+), 6 deletions(-)
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 41da970e8308..0ffbffa1d2ba 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -263,13 +263,17 @@ _gfortran_caf_sync_images (int count __attribute__
((unused)),
*stat = 0;
}
+extern void _gfortran_report_exception (void);
void
_gfortran_caf_stop_numeric(int stop_code, bool quiet)
{
if (!quiet)
- fprintf (stderr, "STOP %d\n", stop_code);
- exit (0);
+ {
+ _gfortran_report_exception ();
+ fprintf (stderr, "STOP %d\n", stop_code);
+ }
+ exit (stop_code);
}
@@ -278,6 +282,7 @@ _gfortran_caf_stop_str(const char *string, size_t len, bool
quiet)
{
if (!quiet)
{
+ _gfortran_report_exception ();
fputs ("STOP ", stderr);
while (len--)
fputc (*(string++), stderr);
@@ -292,6 +297,7 @@ _gfortran_caf_error_stop_str (const char *string, size_t
len, bool quiet)
{
if (!quiet)
{
+ _gfortran_report_exception ();
fputs ("ERROR STOP ", stderr);
while (len--)
fputc (*(string++), stderr);
@@ -373,7 +379,10 @@ void
_gfortran_caf_error_stop (int error, bool quiet)
{
if (!quiet)
- fprintf (stderr, "ERROR STOP %d\n", error);
+ {
+ _gfortran_report_exception ();
+ fprintf (stderr, "ERROR STOP %d\n", error);
+ }
exit (error);
}
@@ -2131,14 +2140,16 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t
*src_index,
/* Assume that the rank and the dimensions fit for copying src
to dst. */
GFC_DESCRIPTOR_DTYPE (dst) = GFC_DESCRIPTOR_DTYPE (src);
+ GFC_DESCRIPTOR_SPAN (dst) = GFC_DESCRIPTOR_SPAN (src);
stride_dst = 1;
+ dst->offset = 0;
for (size_t d = 0; d < src_rank; ++d)
{
extent_dst = GFC_DIMENSION_EXTENT (src->dim[d]);
GFC_DIMENSION_LBOUND (dst->dim[d]) = 1;
GFC_DIMENSION_UBOUND (dst->dim[d]) = extent_dst;
GFC_DIMENSION_STRIDE (dst->dim[d]) = stride_dst;
- dst->offset = -extent_dst;
+ dst->offset -= stride_dst;
stride_dst *= extent_dst;
}
/* Null the data-pointer to make register_component allocate
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index f58edc52e3c2..851df211eeee 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1997,4 +1997,5 @@ GFORTRAN_15 {
_gfortran_sminloc1_8_m2;
_gfortran_sminloc1_8_m4;
_gfortran_sminloc1_8_m8;
+ _gfortran_report_exception;
} GFORTRAN_14;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index aaa9222c43b6..cf3dda07d3d1 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -986,6 +986,9 @@ internal_proto(filename_from_unit);
/* stop.c */
+extern void report_exception (void);
+iexport_proto (report_exception);
+
extern _Noreturn void stop_string (const char *, size_t, bool);
export_proto(stop_string);
diff --git a/libgfortran/runtime/stop.c b/libgfortran/runtime/stop.c
index 2eefe21a9e90..3ac5beff6bba 100644
--- a/libgfortran/runtime/stop.c
+++ b/libgfortran/runtime/stop.c
@@ -38,7 +38,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
inexact - and we optionally ignore underflow, cf. thread starting at
http://mailman.j3-fortran.org/pipermail/j3/2013-June/006452.html. */
-static void
+extern void report_exception (void);
+iexport_proto (report_exception);
+
+void
report_exception (void)
{
struct iovec iov[8];
@@ -108,7 +111,7 @@ report_exception (void)
estr_writev (iov, iovcnt);
}
-
+iexport (report_exception);
/* A numeric STOP statement. */
