procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: Fix caf_stop_numeric and reporting exceptions from caf [PR57598]

Browse source 
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.
This commit is contained in:
Andre Vehreschild 2024-12-18 12:43:39 +01:00
parent 71732eafed
commit a25cc26884
4 changed files with 24 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
libgfortran/caf/single.c
View file

@ -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

1
libgfortran/gfortran.map
View file

@ -1997,4 +1997,5 @@ GFORTRAN_15 {
_gfortran_sminloc1_8_m2;
_gfortran_sminloc1_8_m4;
_gfortran_sminloc1_8_m8;
_gfortran_report_exception;
} GFORTRAN_14;

3
libgfortran/libgfortran.h
View file

@ -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);

7
libgfortran/runtime/stop.c
View file

@ -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. */