[patch, libgfortram] PR32456 IO error message should show Unit/Filename

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch is straightforward.

Internal units have a unit number of zero.  For those, we issue the usual error
message.  For regular files, those with unit number greater than 0, a simple
extension is added to the locus information.

An example:

At line 7 of file error_format.f90 (unit = 99, file = 'foo.dat')
Fortran runtime error: End of file

This has no effect on any existing test cases since it is in the locus output.

The attached test case works, but leaves behind the file.  I have attempted to 
find the right directives for that.  Suggestions welcome.

Regression tested on X86-64.

OK for trunk?

Jerry

2007-06-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/32456
	* runtime/error.c (show_locus): Update to emit the unit number
	and file name involved with the error.  Use new function
	filename_from_unit.
	* libgfortran.h (filename_from_unit): Declare new function.
	* io/unit.c (init_units): Set the unit file name for stdin, stdout,
	and stderr for use later in error reporting.
	(filename_from_unit): Add this new function.

Index: runtime/error.c
===================================================================
*** runtime/error.c	(revision 125970)
--- runtime/error.c	(working copy)
*************** st_sprintf (char *buffer, const char *fo
*** 248,255 ****
--- 248,269 ----
  void
  show_locus (st_parameter_common *cmp)
  {
+   static char *filename;
+ 
    if (!options.locus || cmp == NULL || cmp->filename == NULL)
      return;
+   
+   if (cmp->unit > 0)
+     {
+       filename = filename_from_unit (cmp->unit);
+       if (filename != NULL)
+ 	{
+ 	  st_printf ("At line %d of file %s (unit = %d, file = '%s')\n",
+ 		   (int) cmp->line, cmp->filename, cmp->unit, filename);
+ 	  free_mem (filename);
+ 	}
+       return;
+     }
  
    st_printf ("At line %d of file %s\n", (int) cmp->line, cmp->filename);
  }
Index: libgfortran.h
===================================================================
*** libgfortran.h	(revision 125970)
--- libgfortran.h	(working copy)
*************** extern int st_printf (const char *, ...)
*** 683,688 ****
--- 683,691 ----
    __attribute__ ((format (printf, 1, 2)));
  internal_proto(st_printf);
  
+ extern char * filename_from_unit (int);
+ internal_proto(filename_from_unit);
+ 
  /* stop.c */
  
  extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
Index: io/unit.c
===================================================================
*** io/unit.c	(revision 125970)
--- io/unit.c	(working copy)
*************** __gthread_mutex_t unit_lock = __GTHREAD_
*** 84,89 ****
--- 84,95 ----
  __gthread_mutex_t unit_lock;
  #endif
  
+ /* We use these filenames for error reporting.  */
+ 
+ static char stdin_name[] = "stdin";
+ static char stdout_name[] = "stdout";
+ static char stderr_name[] = "stderr";
+ 
  /* This implementation is based on Stefan Nilsson's article in the
   * July 1997 Doctor Dobb's Journal, "Treaps in Java". */
  
*************** init_units (void)
*** 506,511 ****
--- 512,521 ----
        u->recl = options.default_recl;
        u->endfile = NO_ENDFILE;
  
+       u->file_len = strlen (stdin_name);
+       u->file = get_mem (u->file_len);
+       memmove (u->file, stdin_name, u->file_len);
+     
        __gthread_mutex_unlock (&u->lock);
      }
  
*************** init_units (void)
*** 524,529 ****
--- 534,543 ----
  
        u->recl = options.default_recl;
        u->endfile = AT_ENDFILE;
+     
+       u->file_len = strlen (stdout_name);
+       u->file = get_mem (u->file_len);
+       memmove (u->file, stdout_name, u->file_len);
  
        __gthread_mutex_unlock (&u->lock);
      }
*************** init_units (void)
*** 544,549 ****
--- 558,567 ----
        u->recl = options.default_recl;
        u->endfile = AT_ENDFILE;
  
+       u->file_len = strlen (stderr_name);
+       u->file = get_mem (u->file_len);
+       memmove (u->file, stderr_name, u->file_len);
+ 
        __gthread_mutex_unlock (&u->lock);
      }
  
*************** update_position (gfc_unit *u)
*** 665,667 ****
--- 683,706 ----
    else
      u->flags.position = POSITION_ASIS;
  }
+ 
+ 
+ /* filename_from_unit()-- If the unit_number exists, return a pointer to the
+    name of the associated file, otherwise return the empty string.  The caller
+    must free memory allocated for the filename string.  */
+ 
+ char *
+ filename_from_unit (int unit_number)
+ {
+   char *filename;
+   gfc_unit *u = NULL;
+   u = find_unit (unit_number);
+   if (u != NULL)
+     {
+       filename = (char *) get_mem (u->file_len + 1);
+       unpack_filename (filename, u->file, u->file_len);
+       return filename;
+     }
+   else
+     return (char *) NULL;
+ }
\ No newline at end of file

! { dg-do run }
! { dg-shouldfail "" }
! PR32456 IO error message should show Unit/Filename
program test
  implicit none
  integer :: i
  open(99, file="foodat.mod")
  read(99,*) i
end program
! { dg-output "*(unit = 99, file = 'foodat.mod')" }
! { dg-output "Fortran runtime error: End of file" }
! { dg-final { cleanup-modules "foodat.mod" } }