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, 134 insertions, 128 deletions

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 9eb63d7..3b5f3f7 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -252,125 +252,128 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
       cf_strcpy (iqp->pad, iqp->pad_len, p);
     }
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
-    *iqp->pending = 0;
-  
-  if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
-    *iqp->id = 0;
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
     {
-      if (u == NULL || u->flags.form != FORM_FORMATTED)
-	p = undefined;
-      else
-	switch (u->flags.encoding)
-	  {
-	  case ENCODING_DEFAULT:
-	    p = "UNKNOWN";
-	    break;
-	  case ENCODING_UTF8:
-	    p = "UTF-8";
-	    break;
-	  default:
-	    internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
-	  }
-
-      cf_strcpy (iqp->encoding, iqp->encoding_len, p);
-    }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
-    {
-      if (u == NULL || u->flags.form != FORM_FORMATTED)
-	p = undefined;
-      else
-	switch (u->flags.decimal)
-	  {
-	  case DECIMAL_POINT:
-	    p = "POINT";
-	    break;
-	  case DECIMAL_COMMA:
-	    p = "COMMA";
-	    break;
-	  default:
-	    internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
-	  }
-
-      cf_strcpy (iqp->decimal, iqp->decimal_len, p);
-    }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
-    {
-      if (u == NULL)
-	p = undefined;
-      else
-	switch (u->flags.async)
-	  {
-	  case ASYNC_YES:
-	    p = "YES";
-	    break;
-	  case ASYNC_NO:
-	    p = "NO";
-	    break;
-	  default:
-	    internal_error (&iqp->common, "inquire_via_unit(): Bad async");
-	  }
+      if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
+	*iqp->pending = 0;
+  
+      if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
+        *iqp->id = 0;
 
-      cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
-    }
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+	{
+	  if (u == NULL || u->flags.form != FORM_FORMATTED)
+	    p = undefined;
+          else
+	    switch (u->flags.encoding)
+	      {
+	      case ENCODING_DEFAULT:
+		p = "UNKNOWN";
+		break;
+	      case ENCODING_UTF8:
+		p = "UTF-8";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
+	      }
+
+	  cf_strcpy (iqp->encoding, iqp->encoding_len, p);
+	}
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
-    {
-      if (u == NULL)
-	p = undefined;
-      else
-	switch (u->flags.sign)
-	  {
-	  case SIGN_PROCDEFINED:
-	    p = "PROCESSOR_DEFINED";
-	    break;
-	  case SIGN_SUPPRESS:
-	    p = "SUPPRESS";
-	    break;
-	  case SIGN_PLUS:
-	    p = "PLUS";
-	    break;
-	  default:
-	    internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
-	  }
+      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+	{
+	  if (u == NULL || u->flags.form != FORM_FORMATTED)
+	    p = undefined;
+	  else
+	    switch (u->flags.decimal)
+	      {
+	      case DECIMAL_POINT:
+		p = "POINT";
+		break;
+	      case DECIMAL_COMMA:
+		p = "COMMA";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
+	      }
+
+	  cf_strcpy (iqp->decimal, iqp->decimal_len, p);
+	}
 
-      cf_strcpy (iqp->sign, iqp->sign_len, p);
-    }
+      if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
+	{
+	  if (u == NULL)
+	    p = undefined;
+	  else
+	    switch (u->flags.async)
+	    {
+	      case ASYNC_YES:
+		p = "YES";
+		break;
+	      case ASYNC_NO:
+		p = "NO";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad async");
+	    }
+
+	  cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
+	}
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
-    {
-      if (u == NULL)
-	p = undefined;
-      else
-	switch (u->flags.round)
-	  {
-	  case ROUND_UP:
-	    p = "UP";
-	    break;
-	  case ROUND_DOWN:
-	    p = "DOWN";
-	    break;
-	  case ROUND_ZERO:
-	    p = "ZERO";
-	    break;
-	  case ROUND_NEAREST:
-	    p = "NEAREST";
-	    break;
-	  case ROUND_COMPATIBLE:
-	    p = "COMPATIBLE";
-	    break;
-	  case ROUND_PROCDEFINED:
-	    p = "PROCESSOR_DEFINED";
-	    break;
-	  default:
-	    internal_error (&iqp->common, "inquire_via_unit(): Bad round");
-	  }
+      if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
+	{
+	  if (u == NULL)
+	    p = undefined;
+	  else
+	    switch (u->flags.sign)
+	    {
+	      case SIGN_PROCDEFINED:
+		p = "PROCESSOR_DEFINED";
+		break;
+	      case SIGN_SUPPRESS:
+		p = "SUPPRESS";
+		break;
+	      case SIGN_PLUS:
+		p = "PLUS";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
+	    }
+
+	  cf_strcpy (iqp->sign, iqp->sign_len, p);
+	}
 
-      cf_strcpy (iqp->round, iqp->round_len, p);
+      if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
+	{
+	  if (u == NULL)
+	    p = undefined;
+	  else
+	    switch (u->flags.round)
+	    {
+	      case ROUND_UP:
+		p = "UP";
+		break;
+	      case ROUND_DOWN:
+		p = "DOWN";
+		break;
+	      case ROUND_ZERO:
+		p = "ZERO";
+		break;
+	      case ROUND_NEAREST:
+		p = "NEAREST";
+		break;
+	      case ROUND_COMPATIBLE:
+		p = "COMPATIBLE";
+		break;
+	      case ROUND_PROCDEFINED:
+		p = "PROCESSOR_DEFINED";
+		break;
+	      default:
+		internal_error (&iqp->common, "inquire_via_unit(): Bad round");
+	    }
+
+	  cf_strcpy (iqp->round, iqp->round_len, p);
+	}
     }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
@@ -581,14 +584,26 @@ inquire_via_filename (st_parameter_inquire *iqp)
   if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
     cf_strcpy (iqp->pad, iqp->pad_len, undefined);
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
-    cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
+  if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
+    {
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
   
-  if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
-    cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
+	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+	cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
 
-  if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
-    cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
+      if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
+	cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+
+      if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
+	cf_strcpy (iqp->pad, iqp->pad_len, undefined);
+  
+      if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+	cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
+    }
 
   if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
     cf_strcpy (iqp->position, iqp->position_len, undefined);
@@ -613,15 +628,6 @@ inquire_via_filename (st_parameter_inquire *iqp)
       p = inquire_read (iqp->file, iqp->file_len);
       cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
     }
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
-    cf_strcpy (iqp->delim, iqp->delim_len, undefined);
-
-  if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
-    cf_strcpy (iqp->pad, iqp->pad_len, undefined);
-  
-  if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
-    cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
 }