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 --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 41da970e830862c50c216ca35dd742b1360a885e..0ffbffa1d2ba441b96cb99d1ea3ef63bec236f8a 100644 (file)
--- 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 f58edc52e3c2f0914e5c148b4280cd43ea9d8c59..851df211eeee75b63d13aa25807371afae1c5dda 100644 (file)
--- 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 aaa9222c43b6bce6b36dad3b7be8880a595091d3..cf3dda07d3d16684258f0efd2e817ea03f7952a4 100644 (file)
--- 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 2eefe21a9e9067a6d694220408ac449ca8dcf151..3ac5beff6bbaf04faec9a8989788f48ac6c10a25 100644 (file)
--- 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.  */