re PR fortran/37498 (Incorrect array value returned - 4.3 ABI Broken)

2008-09-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org

	PR libfortran/37498
	* list_read.c (eat_separator): Revert previous patch and move
	delim_status, decimal_status, and pad_status to gfc_unit.
	(parse_real): Ditto. (read_real): Ditto.
	* read.c (read_a): Likewise. (read_a_char4): Likewise.
	(read_f): Likewise.
	* inquire.c (inquire_via_unit): Add missing check for
	IOPARM_INQUIRE_HAS_FLAGS2. (inquire_via_filename): Likewise.
	* io.h (unit_sign_s): Move delim_status, decimal_status, and pad_status
	to gfc_unit.
	* transfer.c (read_sf): Ditto. (read_block_form): Ditto.
	(formatted_transfer_scalar): Ditto. (data_transfer_init): Ditto.
	* write.c (write_default_char4): Ditto. (write_utf8_char4): Ditto.
	(write_character): Ditto. (write_real_g0): Ditto.
	(list_formatted_write_scalar): Ditto. (nml_write_obj): Ditto.
	(namelist_write): Ditto.
	* write_float.def (calculate_sign): Ditto. (output_float): Ditto.

From-SVN: r140684

1 files changed, 22 insertions, 48 deletions

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 121a9b1..020f473 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -65,9 +65,7 @@ write_default_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
     }
 
   /* Get ready to handle delimiters if needed.  */
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -129,9 +127,7 @@ write_utf8_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
     }
 
   /* Get ready to handle delimiters if needed.  */
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -882,9 +878,7 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
   int i, extra;
   char *p, d;
 
-  d = ' ';
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  switch (dtp->u.p.delim_status)
+  switch (dtp->u.p.current_unit->delim_status)
     {
     case DELIM_APOSTROPHE:
       d = '\'';
@@ -1022,10 +1016,8 @@ write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
 static void
 write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size)
 {
-  char semi_comma = ',';
-
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma =
+	dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
 
   if (write_char (dtp, '('))
     return;
@@ -1072,17 +1064,9 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
     }
   else
     {
-      if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-	{
-	  if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
-	      dtp->u.p.delim_status != DELIM_NONE)
-	    write_separator (dtp);
-	}
-      else
-	{
-          if (type != BT_CHARACTER || !dtp->u.p.char_flag)
-	    write_separator (dtp);
-	}
+      if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
+	dtp->u.p.current_unit->delim_status != DELIM_NONE)
+      write_separator (dtp);
     }
 
   switch (type)
@@ -1197,10 +1181,8 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
   /* Set the character to be used to separate values
      to a comma or semi-colon.  */
 
-  char semi_comma = ',';
-
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma =
+	dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? ',' : ';';
 
   /* Write namelist variable names in upper case. If a derived type,
      nothing is output.  If a component, base and base_name are set.  */
@@ -1315,25 +1297,20 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
               break;
 
 	    case GFC_DTYPE_CHARACTER:
-	      if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-		{
-		  tmp_delim = dtp->u.p.delim_status;
-		  if (dtp->u.p.nml_delim == '"')
-		    dtp->u.p.delim_status = DELIM_QUOTE;
-		  if (dtp->u.p.nml_delim == '\'')
-		    dtp->u.p.delim_status = DELIM_APOSTROPHE;
-		  write_character (dtp, p, 1, obj->string_length);
-		  dtp->u.p.delim_status = tmp_delim;
-		}
-	      else
-		write_character (dtp, p, 1, obj->string_length);
+	      tmp_delim = dtp->u.p.current_unit->delim_status;
+	      if (dtp->u.p.nml_delim == '"')
+		dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
+	      if (dtp->u.p.nml_delim == '\'')
+		dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE;
+	      write_character (dtp, p, 1, obj->string_length);
+		dtp->u.p.current_unit->delim_status = tmp_delim;
               break;
 
 	    case GFC_DTYPE_REAL:
 	      write_real (dtp, p, len);
               break;
 
-	    case GFC_DTYPE_COMPLEX:
+	   case GFC_DTYPE_COMPLEX:
 	      dtp->u.p.no_leading_blank = 0;
 	      num++;
               write_complex (dtp, p, len, obj_size);
@@ -1464,9 +1441,7 @@ namelist_write (st_parameter_dt *dtp)
   unit_delim tmp_delim = DELIM_UNSPECIFIED;
 
   /* Set the delimiter for namelist output.  */
-if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-  {
-  tmp_delim = dtp->u.p.delim_status;
+  tmp_delim = dtp->u.p.current_unit->delim_status;
   switch (tmp_delim)
     {
     case (DELIM_QUOTE):
@@ -1483,8 +1458,8 @@ if (dtp->common.flags & IOPARM_DT_HAS_F2003)
     }
 
   /* Temporarily disable namelist delimters.  */
-  dtp->u.p.delim_status = DELIM_NONE;
-  }
+  dtp->u.p.current_unit->delim_status = DELIM_NONE;
+
   write_character (dtp, "&", 1, 1);
 
   /* Write namelist name in upper case - f95 std.  */
@@ -1507,8 +1482,7 @@ if (dtp->common.flags & IOPARM_DT_HAS_F2003)
   write_character (dtp, "  /", 1, 3);
   namelist_write_newline (dtp);
   /* Restore the original delimiter.  */
-  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
-    dtp->u.p.delim_status = tmp_delim;
+  dtp->u.p.current_unit->delim_status = tmp_delim;
 }
 
 #undef NML_DIGITS