From cb13c28858b9c5c243241121206578b5f9f2827c Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sun, 6 May 2007 22:28:31 +0000 Subject: [PATCH] re PR fortran/31201 (Too large unit number generates wrong code) 2007-05-06 Jerry DeLisle PR libfortran/31201 * runtime/error.c (runtime_error_at): New function. (generate_error): Export this function. * gfortran.map: Add _gfortran_generate_error and _gfortran_runtime_error_at. * libgfortran.h: Add comment to reference error codes in front end. (library_start): Locate prototype with library_end macro and add a new comment. Add prototype for runtime_error_at. Export prototype for generate_error. * io/lock.c (library_start): Fix check for error condition. * io/transfer.c (data_transfer_init): Add library check. From-SVN: r124479 --- libgfortran/ChangeLog | 14 ++++++++++++++ libgfortran/gfortran.map | 2 ++ libgfortran/io/lock.c | 4 ++-- libgfortran/io/transfer.c | 3 +++ libgfortran/libgfortran.h | 22 +++++++++++++++------- libgfortran/runtime/error.c | 15 ++++++++++++++- 6 files changed, 50 insertions(+), 10 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 79a6a80394f..24cf9297d8a 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,17 @@ +2007-05-06 Jerry DeLisle + + PR libfortran/31201 + * runtime/error.c (runtime_error_at): New function. + (generate_error): Export this function. + * gfortran.map: Add _gfortran_generate_error and + _gfortran_runtime_error_at. + * libgfortran.h: Add comment to reference error codes in front end. + (library_start): Locate prototype with library_end macro and add + a new comment. Add prototype for runtime_error_at. Export prototype for + generate_error. + * io/lock.c (library_start): Fix check for error condition. + * io/transfer.c (data_transfer_init): Add library check. + 2007-05-04 Daniel Franke PR fortran/22359 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 19b458b7b64..c1ca7255bb1 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -138,6 +138,7 @@ GFORTRAN_1.0 { _gfortran_ftell_i2_sub; _gfortran_ftell_i4_sub; _gfortran_ftell_i8_sub; + _gfortran_generate_error; _gfortran_gerror; _gfortran_getarg_i4; _gfortran_getarg_i8; @@ -582,6 +583,7 @@ GFORTRAN_1.0 { _gfortran_rrspacing_r4; _gfortran_rrspacing_r8; _gfortran_runtime_error; + _gfortran_runtime_error_at; _gfortran_secnds; _gfortran_second; _gfortran_second_sub; diff --git a/libgfortran/io/lock.c b/libgfortran/io/lock.c index c39188f9d61..39bb67090d8 100644 --- a/libgfortran/io/lock.c +++ b/libgfortran/io/lock.c @@ -38,8 +38,8 @@ Boston, MA 02110-1301, USA. */ void library_start (st_parameter_common *cmp) { - if ((cmp->flags & IOPARM_HAS_IOSTAT) != 0) - *cmp->iostat = ERROR_OK; + if ((cmp->flags & IOPARM_LIBRETURN_ERROR) != 0) + return; cmp->flags &= ~IOPARM_LIBRETURN_MASK; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 1e90e835f88..9735aae7cce 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1708,6 +1708,9 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) dtp->u.p.ionml = ionml; dtp->u.p.mode = read_flag ? READING : WRITING; + if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) + return; + if ((cf & IOPARM_DT_HAS_SIZE) != 0) dtp->u.p.size_used = 0; /* Initialize the count. */ diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 3703949d17a..bfbfbef634d 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -401,7 +401,9 @@ typedef struct } st_option; -/* Runtime errors. The EOR and EOF errors are required to be negative. */ +/* Runtime errors. The EOR and EOF errors are required to be negative. + These codes must be kept sychronized with their equivalents in + gcc/fortran/gfortran.h . */ typedef enum { @@ -534,17 +536,19 @@ st_parameter_common; #define IOPARM_OPEN_HAS_PAD (1 << 16) #define IOPARM_OPEN_HAS_CONVERT (1 << 17) - -/* main.c */ - -extern void stupid_function_name_for_static_linking (void); -internal_proto(stupid_function_name_for_static_linking); +/* library start function and end macro. These can be expanded if needed + in the future. cmp is st_parameter_common *cmp */ extern void library_start (st_parameter_common *); internal_proto(library_start); #define library_end() +/* main.c */ + +extern void stupid_function_name_for_static_linking (void); +internal_proto(stupid_function_name_for_static_linking); + extern void set_args (int, char **); export_proto(set_args); @@ -587,6 +591,10 @@ internal_proto(show_locus); extern void runtime_error (const char *) __attribute__ ((noreturn)); iexport_proto(runtime_error); +extern void runtime_error_at (const char *, const char *) +__attribute__ ((noreturn)); +iexport_proto(runtime_error_at); + extern void internal_error (st_parameter_common *, const char *) __attribute__ ((noreturn)); internal_proto(internal_error); @@ -602,7 +610,7 @@ extern const char *translate_error (int); internal_proto(translate_error); extern void generate_error (st_parameter_common *, int, const char *); -internal_proto(generate_error); +iexport_proto(generate_error); extern try notify_std (st_parameter_common *, int, const char *); internal_proto(notify_std); diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 3c44d218963..2bcc293091a 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -299,6 +299,19 @@ runtime_error (const char *message) } iexport(runtime_error); +/* void runtime_error_at()-- These are errors associated with a + * run time error generated by the front end compiler. */ + +void +runtime_error_at (const char *where, const char *message) +{ + recursion_check (); + st_printf ("%s\n", where); + st_printf ("Fortran runtime error: %s\n", message); + sys_exit (2); +} +iexport(runtime_error_at); + /* void internal_error()-- These are this-can't-happen errors * that indicate something deeply wrong. */ @@ -475,7 +488,7 @@ generate_error (st_parameter_common *cmp, int family, const char *message) st_printf ("Fortran runtime error: %s\n", message); sys_exit (2); } - +iexport(generate_error); /* Whether, for a feature included in a given standard set (GFC_STD_*), we should issue an error or a warning, or be quiet. */