Hi all,
attached patch fixes a rather old open issue, that I stumbled upon
while trying to figure, why a test failed on the command line but not
in the testsuite. The implementation of the STOP command in caf_single
did not hand the errorcode over to the OS, as does non-caf STOP and as
it is required by the standard. So I fixed that. I also added reporting
of exceptions to the coarray (ERROR)? STOP routines. For this I have
exported the existing function of the regular gfortran runtime library.
I tried to do this via iexport_proto, but was never able to access the
routine from the caf-library. I always got linker errors.
After fixing caf-STOP the testsuite reported one regression, which I
also fixed in send_by_ref.
Bootstrapped and regtests ok on x86_64-pc-linux-gnu / F41. Ok for
mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gcc dot gnu dot org
From f6e3e34c33be7e8d8753079b9b26f9f4044ccd26 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Wed, 18 Dec 2024 12:43:39 +0100
Subject: [PATCH] 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.
---
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 41da970e830..0ffbffa1d2b 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 f58edc52e3c..851df211eee 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 aaa9222c43b..cf3dda07d3d 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 2eefe21a9e9..3ac5beff6bb 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. */
--
2.47.1
