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

2007-05-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/31201
	* gfortran.h: Add runtime error codes from libgfortran.h. Define
	MAX_UNIT_NUMBER.
	* trans.c (gfc_trans_runtime_check): Update the format of runtime error
	messages to match library runtime errors.  Use call to new library
	function runtime_error_at().
	* trans.h: Add prototype for new function gfc_trans_io_runtime_check.
	Add declaration for library functions runtime_error_at and
	generate_error.
	* trans_io.c (gfc_trans_io_runtime_check): New function.
	(set_parameter_value): Add error checking for UNIT numbers.
	(set_parameter_ref): Initialize the users variable to zero. 
	(gfc_trans_open): Move setting of unit number to after setting of common
	flags so that runtime error trapping can be detected.
	(gfc_trans_close): Likewise. (build_filepos): Likewise.
	(gfc_trans_inquire): Likewise. (build_dt): Likewise.
	* trans-decl.c: Add declarations for runtime_error_at and
	generate_error. (gfc_build_builtin_function_decls): Build function
	declarations for runtime_error_at and generate_error.

Co-Authored-By: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

From-SVN: r124480

gcc/fortran/ChangeLog

+2007-05-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31201
+	* gfortran.h: Add runtime error codes from libgfortran.h. Define
+	MAX_UNIT_NUMBER.
+	* trans.c (gfc_trans_runtime_check): Update the format of runtime error
+	messages to match library runtime errors.  Use call to new library
+	function runtime_error_at().
+	* trans.h: Add prototype for new function gfc_trans_io_runtime_check.
+	Add declaration for library functions runtime_error_at and
+	generate_error.
+	* trans_io.c (gfc_trans_io_runtime_check): New function.
+	(set_parameter_value): Add error checking for UNIT numbers.
+	(set_parameter_ref): Initialize the users variable to zero. 
+	(gfc_trans_open): Move setting of unit number to after setting of common
+	flags so that runtime error trapping can be detected.
+	(gfc_trans_close): Likewise. (build_filepos): Likewise.
+	(gfc_trans_inquire): Likewise. (build_dt): Likewise.
+	* trans-decl.c: Add declarations for runtime_error_at and
+	generate_error. (gfc_build_builtin_function_decls): Build function
+	declarations for runtime_error_at and generate_error.
+
 2007-05-06  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/31540

gcc/fortran/gfortran.h

@@ -472,6 +472,39 @@ enum gfc_generic_isym_id
 };
 typedef enum gfc_generic_isym_id gfc_generic_isym_id;
 
+/* Runtime errors.  The EOR and EOF errors are required to be negative.
+   These codes must be kept synchronized with their equivalents in
+   libgfortran/libgfortran.h .  */
+
+typedef enum
+{
+  IOERROR_FIRST = -3,		/* Marker for the first error.  */
+  IOERROR_EOR = -2,
+  IOERROR_END = -1,
+  IOERROR_OK = 0,			/* Indicates success, must be zero.  */
+  IOERROR_OS = 5000,		/* Operating system error, more info in errno.  */
+  IOERROR_OPTION_CONFLICT,
+  IOERROR_BAD_OPTION,
+  IOERROR_MISSING_OPTION,
+  IOERROR_ALREADY_OPEN,
+  IOERROR_BAD_UNIT,
+  IOERROR_FORMAT,
+  IOERROR_BAD_ACTION,
+  IOERROR_ENDFILE,
+  IOERROR_BAD_US,
+  IOERROR_READ_VALUE,
+  IOERROR_READ_OVERFLOW,
+  IOERROR_INTERNAL,
+  IOERROR_INTERNAL_UNIT,
+  IOERROR_ALLOCATION,
+  IOERROR_DIRECT_EOR,
+  IOERROR_SHORT_RECORD,
+  IOERROR_CORRUPT_FILE,
+  IOERROR_LAST			/* Not a real error, the last error # + 1.  */
+}
+ioerror_codes;
+
+
 /************************* Structures *****************************/
 
 /* Used for keeping things in balanced binary trees.  */

gcc/fortran/trans-decl.c

@@ -90,6 +90,8 @@ tree gfor_fndecl_stop_numeric;
 tree gfor_fndecl_stop_string;
 tree gfor_fndecl_select_string;
 tree gfor_fndecl_runtime_error;
+tree gfor_fndecl_runtime_error_at;
+tree gfor_fndecl_generate_error;
 tree gfor_fndecl_set_fpe;
 tree gfor_fndecl_set_std;
 tree gfor_fndecl_set_convert;
@@ -2335,6 +2337,18 @@ gfc_build_builtin_function_decls (void)
   /* The runtime_error function does not return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1;
 
+  gfor_fndecl_runtime_error_at =
+    gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error_at")),
+				     void_type_node, 2, pchar_type_node,
+				     pchar_type_node);
+  /* The runtime_error_at function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1;
+  
+  gfor_fndecl_generate_error =
+    gfc_build_library_function_decl (get_identifier (PREFIX("generate_error")),
+				     void_type_node, 3, pvoid_type_node,
+                                     gfc_c_int_type_node, pchar_type_node);
+
   gfor_fndecl_set_fpe =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")),
 				    void_type_node, 1, gfc_c_int_type_node);

gcc/fortran/trans.c

@@ -318,8 +318,8 @@ gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock,
   stmtblock_t block;
   tree body;
   tree tmp;
-  tree arg;
-  char * message;
+  tree arg, arg2;
+  char *message;
   int line;
 
   if (integer_zerop (cond))
@@ -335,17 +335,21 @@ gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock,
 #else 
       line = where->lb->linenum;
 #endif
-      asprintf (&message, "%s (in file '%s', at line %d)", _(msgid),
-		where->lb->file->filename, line);
+      asprintf (&message, "At line %d of file %s",  line,
+		where->lb->file->filename);
     }
   else
-    asprintf (&message, "%s (in file '%s', around line %d)", _(msgid),
+    asprintf (&message, "In file '%s', around line %d",
 	      gfc_source_file, input_line + 1);
 
   arg = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message));
   gfc_free(message);
+  
+  asprintf (&message, "%s", _(msgid));
+  arg2 = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message));
+  gfc_free(message);
 
-  tmp = build_call_expr (gfor_fndecl_runtime_error, 1, arg);
+  tmp = build_call_expr (gfor_fndecl_runtime_error_at, 2, arg, arg2);
   gfc_add_expr_to_block (&block, tmp);
 
   body = gfc_finish_block (&block);

gcc/fortran/trans.h

@@ -448,6 +448,7 @@ tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);
 /* Initialize function decls for library functions.  */
 void gfc_build_intrinsic_lib_fndecls (void);
 /* Create function decls for IO library functions.  */
+void gfc_trans_io_runtime_check (tree, tree, int, const char *, stmtblock_t *);
 void gfc_build_io_library_fndecls (void);
 /* Build a function decl for a library function.  */
 tree gfc_build_library_function_decl (tree, tree, int, ...);
@@ -487,6 +488,8 @@ extern GTY(()) tree gfor_fndecl_stop_numeric;
 extern GTY(()) tree gfor_fndecl_stop_string;
 extern GTY(()) tree gfor_fndecl_select_string;
 extern GTY(()) tree gfor_fndecl_runtime_error;
+extern GTY(()) tree gfor_fndecl_runtime_error_at;
+extern GTY(()) tree gfor_fndecl_generate_error;
 extern GTY(()) tree gfor_fndecl_set_fpe;
 extern GTY(()) tree gfor_fndecl_set_std;
 extern GTY(()) tree gfor_fndecl_ttynam;