2006-07-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@115168 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8add02f..66997a8 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       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  <coudert@clipper.ens.fr>
 
        * io/io.h: Move proto for unit_to_fd...

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 5af5c6e..aa6c68b 100644 (file)
--- 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 aa8a6a6..822930e 100644 (file)
--- 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 0670efa..0dcb3db 100644 (file)
--- 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 24713b7..3515bef 100644 (file)
--- 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 15d403c..9b91536 100644 (file)
--- 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 cb3d658..5dd2a51 100644 (file)
--- 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 8ccb381..9960733 100644 (file)
--- 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;
 }