From 2e4444278c4b7f27ef13f74083802232793af83f Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Tue, 4 Jul 2006 01:36:31 +0000 Subject: [PATCH] re PR libfortran/27704 (Incorrect runtime error on multiple OPEN) 2006-07-03 Jerry DeLisle PR libgfortran/27704 * runtime/error.c (notify_std): Pass common flags into function. Use flags to show locus of error or warning. * libgfortran.h: Add enum try. Add prototype for notify_std. * io/open.c (edit_modes): Allow status="old" and add extension to allow status="scratch" *io/list_read.c (nml_read_obj): Update call to notify_std. *io/io.h: Remove enum try and prototype for notify_std. *io/transfer.c (read_sf): Update call to notify_std. *io/format.c (parse_format_list): Update call to notify_std. From-SVN: r115168 --- libgfortran/ChangeLog | 13 +++++++++++++ libgfortran/io/format.c | 4 ++-- libgfortran/io/io.h | 7 ------- libgfortran/io/list_read.c | 2 +- libgfortran/io/open.c | 12 +++++++++--- libgfortran/io/transfer.c | 3 ++- libgfortran/libgfortran.h | 8 ++++++++ libgfortran/runtime/error.c | 9 +++++++-- 8 files changed, 42 insertions(+), 16 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 8add02fb4e2..66997a8071b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2006-07-03 Jerry DeLisle + + PR libgfortran/27704 + * runtime/error.c (notify_std): Pass common flags into function. Use + flags to show locus of error or warning. + * libgfortran.h: Add enum try. Add prototype for notify_std. + * io/open.c (edit_modes): Allow status="old" and add extension to + allow status="scratch" + *io/list_read.c (nml_read_obj): Update call to notify_std. + *io/io.h: Remove enum try and prototype for notify_std. + *io/transfer.c (read_sf): Update call to notify_std. + *io/format.c (parse_format_list): Update call to notify_std. + 2006-06-25 Francois-Xavier Coudert * io/io.h: Move proto for unit_to_fd... diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 5af5c6e8bde..aa6c68bbf25 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -575,7 +575,7 @@ parse_format_list (st_parameter_dt *dtp) case FMT_DOLLAR: get_fnode (fmt, &head, &tail, FMT_DOLLAR); tail->repeat = 1; - notify_std (GFC_STD_GNU, "Extension: $ descriptor"); + notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor"); goto between_desc; case FMT_T: @@ -671,7 +671,7 @@ parse_format_list (st_parameter_dt *dtp) { fmt->saved_token = t; fmt->value = 1; /* Default width */ - notify_std(GFC_STD_GNU, posint_required); + notify_std (&dtp->common, GFC_STD_GNU, posint_required); } } diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index aa8a6a693f7..822930e776a 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -46,10 +46,6 @@ typedef enum bt; -typedef enum -{ SUCCESS = 1, FAILURE } -try; - struct st_parameter_dt; typedef struct stream @@ -865,9 +861,6 @@ extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, internal_proto(list_formatted_write); /* error.c */ -extern try notify_std (int, const char *); -internal_proto(notify_std); - extern notification notification_std(int); internal_proto(notification_std); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0670efab86f..0dcb3dba688 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2214,7 +2214,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, and set the flag to zero to prevent further warnings. */ if (dtp->u.p.expanded_read == 2) { - notify_std (GFC_STD_GNU, "Non-standard expanded namelist read."); + notify_std (&dtp->common, GFC_STD_GNU, "Non-standard expanded namelist read."); dtp->u.p.expanded_read = 0; } diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 24713b76f49..3515bef75ce 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -128,7 +128,7 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) { /* Complain about attempts to change the unchangeable. */ - if (flags->status != STATUS_UNSPECIFIED && + if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && u->flags.status != flags->status) generate_error (&opp->common, ERROR_BAD_OPTION, "Cannot change STATUS parameter in OPEN statement"); @@ -154,8 +154,14 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && flags->status != STATUS_UNKNOWN) - generate_error (&opp->common, ERROR_BAD_OPTION, + { + if (flags->status == STATUS_SCRATCH) + notify_std (&opp->common, GFC_STD_GNU, "OPEN statement must have a STATUS of OLD or UNKNOWN"); + else + generate_error (&opp->common, ERROR_BAD_OPTION, + "OPEN statement must have a STATUS of OLD or UNKNOWN"); + } if (u->flags.form == FORM_UNFORMATTED) { @@ -615,7 +621,7 @@ st_open (st_parameter_open *opp) "Conflicting ACCESS and POSITION flags in" " OPEN statement"); - notify_std (GFC_STD_GNU, + notify_std (&opp->common, GFC_STD_GNU, "Extension: APPEND as a value for ACCESS in OPEN statement"); flags.access = ACCESS_SEQUENTIAL; flags.position = POSITION_APPEND; diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 15d403c5714..9b91536d077 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -220,7 +220,8 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error) if (*q == ',') if (dtp->u.p.sf_read_comma == 1) { - notify_std (GFC_STD_GNU, "Comma in formatted numeric read."); + notify_std (&dtp->common, GFC_STD_GNU, + "Comma in formatted numeric read."); *length = n; break; } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index cb3d6589c33..5dd2a51e1e0 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -414,6 +414,11 @@ typedef enum { SILENT, WARNING, ERROR } notification; +/* This is returned by notify_std and several io functions. */ +typedef enum +{ SUCCESS = 1, FAILURE } +try; + /* The filename and line number don't go inside the globals structure. They are set by the rest of the program and must be linked to. */ @@ -492,6 +497,9 @@ internal_proto(translate_error); extern void generate_error (struct st_parameter_common *, int, const char *); internal_proto(generate_error); +extern try notify_std (struct st_parameter_common *, int, const char *); +internal_proto(notify_std); + /* fpu.c */ extern void set_fpu (void); diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 8ccb381a650..9960733f16a 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -527,7 +527,7 @@ notification_std (int std) standard does not contain the requested bits. */ try -notify_std (int std, const char * message) +notify_std (st_parameter_common *cmp, int std, const char * message) { int warning; @@ -540,10 +540,15 @@ notify_std (int std, const char * message) if (!warning) { + recursion_check (); + show_locus (cmp); st_printf ("Fortran runtime error: %s\n", message); sys_exit (2); } else - st_printf ("Fortran runtime warning: %s\n", message); + { + show_locus (cmp); + st_printf ("Fortran runtime warning: %s\n", message); + } return FAILURE; }