re PR fortran/31201 (Too large unit number generates wrong code)

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

	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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 79a6a80..24cf929 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,17 @@
+2007-05-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       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  <franke.daniel@gmail.com>
 
        PR fortran/22359

diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 19b458b..c1ca725 100644 (file)
--- 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 c39188f..39bb670 100644 (file)
--- 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 1e90e83..9735aae 100644 (file)
--- 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 3703949..bfbfbef 100644 (file)
--- 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 3c44d21..2bcc293 100644 (file)
--- 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.  */