re PR libfortran/27704 (Incorrect runtime error on multiple OPEN)

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.

From-SVN: r115168

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

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

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

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;
 	}
 

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;

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;
 	  }

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

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;
 }