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

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

	PR fortran/37498
	* trans-io.c (gfc_build_io_library_fndecls): Bump pad size.
	(build_dt): Set mask bit for IOPARM_dt_f2003.
	* ioparm.def: Add IOPARM_dt_f2003.

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

	PR libfortran/37498
	* file_pos (st_endfile): Clear memory only for libfortran 4.3 private
	area.
	* list_read.c (eat_separator): Only access F2003 I/O parameters if
	IOPARM_DT_HAS_F2003 bit is set. (parse_real): Ditto.
	(read_real): Ditto.
	* read.c (read_a): Likewise. (read_a_char4): Likewise though not
	strictly necessary. (read_f): Likewise.
	* io.h (unit_sign_s): New enumerator to allow duplication of
	st_parameter structures. (IOPARM_DT_HAS_F2003): New mask bit.
	(st_parameter_43): New structure copied from 4.3 version of 
	st_paramater_dt private section. (st_parameter_44): New structure with
	F2003 items added. (st_parameter_dt): Modified to create union of new
	and old structures to allow correct memory setting for 4.3 ABI
	compatibility. Bumped the pad size.
	* transfer.c (read_sf): Do not use F2003 I/O memory areas unless
	IOPARM_DT_HAS_F2003 bit has been set. (read_block_form): Ditto.
	(formatted_transfer_scalar): Ditto. (data_transfer_init): Ditto and
	add comment, fix formatting.
	* write.c (write_default_char4): Likewise though not strictly necessary.
	(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): Eliminate warning by including all
	cases in switch. (output_float): Output only decimal point of F2003 flag
	is not set.

From-SVN: r140576

gcc/fortran/ChangeLog

+2008-09-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org
+
+	PR fortran/37498
+	* trans-io.c (gfc_build_io_library_fndecls): Bump pad size.
+	(build_dt): Set mask bit for IOPARM_dt_f2003.
+	* ioparm.def: Add IOPARM_dt_f2003.
+
 2008-09-22  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/37486

gcc/fortran/ioparm.def

@@ -93,3 +93,4 @@ IOPARM (dt,      pad,		1 << 22, char1)
 IOPARM (dt,      round,		1 << 23, char2)
 IOPARM (dt,      sign,		1 << 24, char1)
 IOPARM (dt,      u,		0,	 pad)
+#define IOPARM_dt_f2003			(1 << 25)

gcc/fortran/trans-io.c

@@ -291,7 +291,7 @@ gfc_build_io_library_fndecls (void)
 			    = build_pointer_type (gfc_intio_type_node);
   types[IOPARM_type_parray] = pchar_type_node;
   types[IOPARM_type_pchar] = pchar_type_node;
-  pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
+  pad_size = 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
   pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node));
   pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size));
   types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx);
@@ -1641,7 +1641,7 @@ build_dt (tree function, gfc_code * code)
   tree tmp, var;
   gfc_expr *nmlname;
   gfc_namelist *nml;
-  unsigned int mask = 0;
+  unsigned int mask = IOPARM_dt_f2003;
 
   gfc_start_block (&block);
   gfc_init_block (&post_block);

libgfortran/ChangeLog

+2008-09-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org
+
+	PR libfortran/37498
+	* file_pos (st_endfile): Clear memory only for libfortran 4.3 private
+	area.
+	* list_read.c (eat_separator): Only access F2003 I/O parameters if
+	IOPARM_DT_HAS_F2003 bit is set. (parse_real): Ditto.
+	(read_real): Ditto.
+	* read.c (read_a): Likewise. (read_a_char4): Likewise though not
+	strictly necessary. (read_f): Likewise.
+	* io.h (unit_sign_s): New enumerator to allow duplication of
+	st_parameter structures. (IOPARM_DT_HAS_F2003): New mask bit.
+	(st_parameter_43): New structure copied from 4.3 version of 
+	st_paramater_dt private section. (st_parameter_44): New structure with
+	F2003 items added. (st_parameter_dt): Modified to create union of new
+	and old structures to allow correct memory setting for 4.3 ABI
+	compatibility. Bumped the pad size.
+	* transfer.c (read_sf): Do not use F2003 I/O memory areas unless
+	IOPARM_DT_HAS_F2003 bit has been set. (read_block_form): Ditto.
+	(formatted_transfer_scalar): Ditto. (data_transfer_init): Ditto and
+	add comment, fix formatting.
+	* write.c (write_default_char4): Likewise though not strictly necessary.
+	(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): Eliminate warning by including all
+	cases in switch. (output_float): Output only decimal point of F2003 flag
+	is not set.
+
 2008-09-10  Tobias Burnus  <burnus@net-b.de>
 	    H. J. Lu  <hongjiu.lu@intel.com>
 

libgfortran/io/file_pos.c

@@ -300,7 +300,7 @@ st_endfile (st_parameter_filepos *fpp)
 	{
 	  st_parameter_dt dtp;
 	  dtp.common = fpp->common;
-	  memset (&dtp.u.p, 0, sizeof (dtp.u.p));
+	  memset (&dtp.u.p.transfer, 0, sizeof (dtp.u.q));
 	  dtp.u.p.current_unit = u;
 	  next_record (&dtp, 1);
 	}

libgfortran/io/io.h

@@ -233,6 +233,10 @@ typedef enum
 { ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
 unit_async;
 
+typedef enum
+{ SIGN_S, SIGN_SS, SIGN_SP }
+unit_sign_s;
+
 #define CHARACTER1(name) \
 	      char * name; \
 	      gfc_charlen_type name ## _len
@@ -368,19 +372,92 @@ struct format_data;
 #define IOPARM_DT_HAS_PAD			(1 << 22)
 #define IOPARM_DT_HAS_ROUND			(1 << 23)
 #define IOPARM_DT_HAS_SIGN			(1 << 24)
+#define IOPARM_DT_HAS_F2003                     (1 << 25)
 /* Internal use bit.  */
 #define IOPARM_DT_IONML_SET			(1 << 31)
 
-typedef struct st_parameter_dt
+
+typedef struct st_parameter_43
+{
+  void (*transfer) (struct st_parameter_dt *, bt, void *, int,
+		    size_t, size_t);
+  struct gfc_unit *current_unit;
+  /* Item number in a formatted data transfer.  Also used in namelist
+     read_logical as an index into line_buffer.  */
+  int item_count;
+  unit_mode mode;
+  unit_blank blank_status;
+  unit_sign sign_status;
+  int scale_factor;
+  int max_pos; /* Maximum righthand column written to.  */
+  /* Number of skips + spaces to be done for T and X-editing.  */
+  int skips;
+  /* Number of spaces to be done for T and X-editing.  */
+  int pending_spaces;
+  /* Whether an EOR condition was encountered. Value is:
+       0 if no EOR was encountered
+       1 if an EOR was encountered due to a 1-byte marker (LF)
+       2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
+  int sf_seen_eor;
+  unit_advance advance_status;
+  unsigned reversion_flag : 1; /* Format reversion has occurred.  */
+  unsigned first_item : 1;
+  unsigned seen_dollar : 1;
+  unsigned eor_condition : 1;
+  unsigned no_leading_blank : 1;
+  unsigned char_flag : 1;
+  unsigned input_complete : 1;
+  unsigned at_eol : 1;
+  unsigned comma_flag : 1;
+  /* A namelist specific flag used in the list directed library
+     to flag that calls are being made from namelist read (eg. to
+     ignore comments or to treat '/' as a terminator)  */
+  unsigned namelist_mode : 1;
+  /* A namelist specific flag used in the list directed library
+     to flag read errors and return, so that an attempt can be
+     made to read a new object name.  */
+  unsigned nml_read_error : 1;
+  /* A sequential formatted read specific flag used to signal that a
+     character string is being read so don't use commas to shorten a
+     formatted field width.  */
+  unsigned sf_read_comma : 1;
+  /* A namelist specific flag used to enable reading input from 
+     line_buffer for logical reads.  */
+  unsigned line_buffer_enabled : 1;
+  /* An internal unit specific flag used to identify that the associated
+     unit is internal.  */
+  unsigned unit_is_internal : 1;
+  /* An internal unit specific flag to signify an EOF condition for list
+     directed read.  */
+  unsigned at_eof : 1;
+  /* 16 unused bits.  */
+
+  char last_char;
+  char nml_delim;
+
+  int repeat_count;
+  int saved_length;
+  int saved_used;
+  bt saved_type;
+  char *saved_string;
+  char *scratch;
+  char *line_buffer;
+  struct format_data *fmt;
+  jmp_buf *eof_jump;
+  namelist_info *ionml;
+  /* A flag used to identify when a non-standard expanded namelist read
+     has occurred.  */
+  int expanded_read;
+  /* Storage area for values except for strings.  Must be large
+     enough to hold a complex value (two reals) of the largest
+     kind.  */
+  char value[32];
+  gfc_offset size_used;
+} st_parameter_43;
+
+
+typedef struct st_parameter_44
 {
-  st_parameter_common common;
-  GFC_IO_INT rec;
-  GFC_IO_INT *size, *iolength;
-  gfc_array_char *internal_unit_desc;
-  CHARACTER1 (format);
-  CHARACTER2 (advance);
-  CHARACTER1 (internal_unit);
-  CHARACTER2 (namelist_name);
   GFC_IO_INT *id;
   GFC_IO_INT pos;
   CHARACTER1 (asynchronous);
@@ -390,12 +467,6 @@ typedef struct st_parameter_dt
   CHARACTER1 (pad);
   CHARACTER2 (round);
   CHARACTER1 (sign);
-  /* Private part of the structure.  The compiler just needs
-     to reserve enough space.  */
-  union
-    {
-      struct
-	{
   void (*transfer) (struct st_parameter_dt *, bt, void *, int,
 		    size_t, size_t);
   struct gfc_unit *current_unit;
@@ -404,8 +475,7 @@ typedef struct st_parameter_dt
   int item_count;
   unit_mode mode;
   unit_blank blank_status;
-          unit_pad pad_status;
-	  enum { SIGN_S, SIGN_SS, SIGN_SP } sign_status;
+  unit_sign sign_status;
   int scale_factor;
   int max_pos; /* Maximum righthand column written to.  */
   /* Number of skips + spaces to be done for T and X-editing.  */
@@ -418,9 +488,6 @@ typedef struct st_parameter_dt
        2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
   int sf_seen_eor;
   unit_advance advance_status;
-	  unit_decimal decimal_status;
-          unit_delim delim_status;
-
   unsigned reversion_flag : 1; /* Format reversion has occurred.  */
   unsigned first_item : 1;
   unsigned seen_dollar : 1;
@@ -474,11 +541,31 @@ typedef struct st_parameter_dt
      kind.  */
   char value[32];
   gfc_offset size_used;
-	} p;
+  unit_pad pad_status;
+  unit_decimal decimal_status;
+  unit_delim delim_status;
+} st_parameter_44;
+
+typedef struct st_parameter_dt
+{
+  st_parameter_common common;
+  GFC_IO_INT rec;
+  GFC_IO_INT *size, *iolength;
+  gfc_array_char *internal_unit_desc;
+  CHARACTER1 (format);
+  CHARACTER2 (advance);
+  CHARACTER1 (internal_unit);
+  CHARACTER2 (namelist_name);
+  /* Private part of the structure.  The compiler just needs
+     to reserve enough space.  */
+  union
+    {
+      st_parameter_43 q;
+      st_parameter_44 p;
       /* This pad size must be equal to the pad_size declared in
 	 trans-io.c (gfc_build_io_library_fndecls).  The above structure
 	 must be smaller or equal to this array.  */
-      char pad[16 * sizeof (char *) + 32 * sizeof (int)];
+      char pad[32 * sizeof (char *) + 32 * sizeof (int)];
     } u;
 }
 st_parameter_dt;
@@ -512,12 +599,12 @@ typedef struct
   unit_position position;
   unit_status status;
   unit_pad pad;
+  unit_convert convert;
+  int has_recl;
   unit_decimal decimal;
   unit_encoding encoding;
   unit_round round;
   unit_sign sign;
-  unit_convert convert;
-  int has_recl;
   unit_async async;
 }
 unit_flags;

libgfortran/io/list_read.c

@@ -324,7 +324,8 @@ eat_separator (st_parameter_dt *dtp)
   switch (c)
     {
     case ',':
-      if (dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	  && dtp->u.p.decimal_status == DECIMAL_COMMA)
 	{
 	  unget_char (dtp, c);
 	  break;
@@ -1116,7 +1117,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
       c = next_char (dtp);
     }
 
-  if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
     c = '.';
   
   if (!isdigit (c) && c != '.')
@@ -1134,7 +1136,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	  && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
 	c = '.';
       switch (c)
 	{
@@ -1305,9 +1308,17 @@ eol_1:
   else
     unget_char (dtp, c);
 
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    {
       if (next_char (dtp)
 	  !=  (dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';'))
 	goto bad_complex;
+    }
+  else
+    {
+      if (next_char (dtp) != ',')
+	goto bad_complex;
+    }
 
 eol_2:
   eat_spaces (dtp);
@@ -1360,7 +1371,8 @@ read_real (st_parameter_dt *dtp, int length)
   seen_dp = 0;
 
   c = next_char (dtp);
-  if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
     c = '.';
   switch (c)
     {
@@ -1397,7 +1409,8 @@ read_real (st_parameter_dt *dtp, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	  && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
 	c = '.';
       switch (c)
 	{
@@ -1463,7 +1476,8 @@ read_real (st_parameter_dt *dtp, int length)
       c = next_char (dtp);
     }
 
-  if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+      && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
     c = '.';
 
   if (!isdigit (c) && c != '.')
@@ -1488,7 +1502,8 @@ read_real (st_parameter_dt *dtp, int length)
   for (;;)
     {
       c = next_char (dtp);
-      if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	  && c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
 	c = '.';
       switch (c)
 	{

libgfortran/io/read.c

@@ -440,8 +440,9 @@ read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
   else
     read_default_char1 (dtp, p, length, w);
 
-  dtp->u.p.sf_read_comma =
-    dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+  dtp->u.p.sf_read_comma = 1;
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
 
 
@@ -467,8 +468,9 @@ read_a_char4 (st_parameter_dt *dtp, const fnode *f, char *p, int length)
   else
     read_default_char4 (dtp, p, length, w);
   
-  dtp->u.p.sf_read_comma =
-    dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+  dtp->u.p.sf_read_comma = 1;
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
 }
 
 /* eat_leading_spaces()-- Given a character pointer and a width,
@@ -840,8 +842,11 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       switch (*p)
 	{
 	case ',':
-	  if (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ',')
+	  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	      && (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ','))
 		*p = '.';
+	  else
+	    goto bad_float;
 	  /* Fall through */
 	case '.':
 	  if (seen_dp)
@@ -1074,9 +1079,17 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 void
 read_x (st_parameter_dt * dtp, int n)
 {
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    {
       if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
 	  && dtp->u.p.current_unit->bytes_left < n)
 	n = dtp->u.p.current_unit->bytes_left;
+    }
+  else
+    {
+      if (is_internal_unit (dtp) && dtp->u.p.current_unit->bytes_left < n)
+	n = dtp->u.p.current_unit->bytes_left;
+    }
 
   dtp->u.p.sf_read_comma = 0;
   if (n > 0)

libgfortran/io/transfer.c

@@ -264,7 +264,8 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
 	  /* Without padding, terminate the I/O statement without assigning
 	     the value.  With padding, the value still needs to be assigned,
 	     so we can just continue with a short read.  */
-	  if (dtp->u.p.pad_status == PAD_NO)
+	  if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	      && dtp->u.p.pad_status == PAD_NO)
 	    {
 	      if (no_error)
 		break;
@@ -332,7 +333,8 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
             dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
 	  else
 	    {
-	      if (dtp->u.p.pad_status == PAD_NO)
+	      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+		  && dtp->u.p.pad_status == PAD_NO)
 		{
 		  /* Not enough data left.  */
 		  generate_error (&dtp->common, LIBERROR_EOR, NULL);
@@ -379,7 +381,8 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 
   if (nread != *nbytes)
     {				/* Short read, this shouldn't happen.  */
-      if (dtp->u.p.pad_status == PAD_YES)
+      if ((dtp->common.flags & IOPARM_DT_HAS_F2003)
+	  && dtp->u.p.pad_status == PAD_YES)
 	*nbytes = nread;
       else
 	{
@@ -950,7 +953,11 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
   /* Set this flag so that commas in reads cause the read to complete before
      the entire field has been read.  The next read field will start right after
      the comma in the stream.  (Set to 0 for character reads).  */
+  dtp->u.p.sf_read_comma = 1;
+
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
     dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
+
   dtp->u.p.line_buffer = scratch;
 
   for (;;)
@@ -1820,7 +1827,13 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   namelist_info *ionml;
 
   ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL;
-  memset (&dtp->u.p, 0, sizeof (dtp->u.p));
+
+  /* To maintain ABI, &transfer is the start of the private memory area in
+     in st_parameter_dt.  Memory from the beginning of the structure to this
+     point is set by the front end and must not be touched.  The number of
+     bytes to clear must stay within the sizeof q to avoid over-writing.  */
+  memset (&dtp->u.p.transfer, 0, sizeof (dtp->u.q));
+
   dtp->u.p.ionml = ionml;
   dtp->u.p.mode = read_flag ? READING : WRITING;
 
@@ -1863,6 +1876,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
     u_flags.async = ASYNC_UNSPECIFIED;
     u_flags.round = ROUND_UNSPECIFIED;
     u_flags.sign = SIGN_UNSPECIFIED;
+
     u_flags.status = STATUS_UNKNOWN;
 
     conv = get_unformatted_convert (dtp->common.unit);
@@ -1970,7 +1984,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       && (cf & IOPARM_DT_HAS_REC) != 0)
     {
       generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-		      "Record number not allowed for sequential access data transfer");
+		      "Record number not allowed for sequential access "
+		      "data transfer");
       return;
     }
 
@@ -1986,7 +2001,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
 	{
 	  generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-			  "ADVANCE specification conflicts with sequential access");
+			  "ADVANCE specification conflicts with sequential "
+			  "access");
 	  return;
 	}
 
@@ -2018,10 +2034,12 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	  return;
 	}
 
-      if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO)
+      if ((cf & IOPARM_DT_HAS_SIZE) != 0 
+	  && dtp->u.p.advance_status != ADVANCE_NO)
 	{
 	  generate_error (&dtp->common, LIBERROR_MISSING_OPTION,
-			  "SIZE specification requires an ADVANCE specification of NO");
+			  "SIZE specification requires an ADVANCE "
+			  "specification of NO");
 	  return;
 	}
     }
@@ -2030,21 +2048,24 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if ((cf & IOPARM_END) != 0)
 	{
 	  generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-			  "END specification cannot appear in a write statement");
+			  "END specification cannot appear in a write "
+			  "statement");
 	  return;
 	}
 
       if ((cf & IOPARM_EOR) != 0)
 	{
 	  generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-			  "EOR specification cannot appear in a write statement");
+			  "EOR specification cannot appear in a write "
+			  "statement");
 	  return;
 	}
 
       if ((cf & IOPARM_DT_HAS_SIZE) != 0)
 	{
 	  generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
-			  "SIZE specification cannot appear in a write statement");
+			  "SIZE specification cannot appear in a write "
+			  "statement");
 	  return;
 	}
     }
@@ -2052,12 +2073,15 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED)
     dtp->u.p.advance_status = ADVANCE_YES;
 
+  /* To maintain ABI check these only if we have the F2003 flag set.  */
+  if(cf & IOPARM_DT_HAS_F2003)
+    {
       /* Check the decimal mode.  */
-
       dtp->u.p.decimal_status
 	= !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
-      find_option (&dtp->common, dtp->decimal, dtp->decimal_len, decimal_opt,
-		   "Bad DECIMAL parameter in data transfer statement");
+	  find_option (&dtp->common, dtp->u.p.decimal, dtp->u.p.decimal_len,
+			decimal_opt, "Bad DECIMAL parameter in data transfer "
+			"statement");
 
       if (dtp->u.p.decimal_status == DECIMAL_UNSPECIFIED)
 	dtp->u.p.decimal_status = dtp->u.p.current_unit->flags.decimal;
@@ -2065,7 +2089,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       /* Check the sign mode. */
       dtp->u.p.sign_status
 	= !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED :
-      find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt,
+	  find_option (&dtp->common, dtp->u.p.sign, dtp->u.p.sign_len, sign_opt,
 			"Bad SIGN parameter in data transfer statement");
   
       if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
@@ -2074,7 +2098,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       /* Check the blank mode.  */
       dtp->u.p.blank_status
 	= !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED :
-      find_option (&dtp->common, dtp->blank, dtp->blank_len, blank_opt,
+	  find_option (&dtp->common, dtp->u.p.blank, dtp->u.p.blank_len,
+			blank_opt,
 			"Bad BLANK parameter in data transfer statement");
   
       if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
@@ -2083,7 +2108,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       /* Check the delim mode.  */
       dtp->u.p.delim_status
 	= !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
-      find_option (&dtp->common, dtp->delim, dtp->delim_len, delim_opt,
+	  find_option (&dtp->common, dtp->u.p.delim, dtp->u.p.delim_len,
+			delim_opt,
 			"Bad DELIM parameter in data transfer statement");
   
       if (dtp->u.p.delim_status == DELIM_UNSPECIFIED)
@@ -2092,11 +2118,12 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       /* Check the pad mode.  */
       dtp->u.p.pad_status
 	= !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
-      find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt,
+	  find_option (&dtp->common, dtp->u.p.pad, dtp->u.p.pad_len, pad_opt,
 			"Bad PAD parameter in data transfer statement");
   
       if (dtp->u.p.pad_status == PAD_UNSPECIFIED)
 	dtp->u.p.pad_status = dtp->u.p.current_unit->flags.pad;
+    }
 
   /* Sanity checks on the record number.  */
   if ((cf & IOPARM_DT_HAS_REC) != 0)

libgfortran/io/write.c

@@ -65,7 +65,8 @@ 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)
     {
     case DELIM_APOSTROPHE:
@@ -128,7 +129,8 @@ 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)
     {
     case DELIM_APOSTROPHE:
@@ -880,6 +882,8 @@ 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)
     {
     case DELIM_APOSTROPHE:
@@ -1018,7 +1022,10 @@ 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 = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma = ',';
+
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
 
   if (write_char (dtp, '('))
     return;
@@ -1065,10 +1072,18 @@ 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);
+	}
+    }
 
   switch (type)
     {
@@ -1182,7 +1197,10 @@ 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 = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+  char semi_comma = ',';
+
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
+    semi_comma = dtp->u.p.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.  */
@@ -1297,6 +1315,8 @@ 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;
@@ -1304,6 +1324,9 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 		    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);
               break;
 
 	    case GFC_DTYPE_REAL:
@@ -1438,10 +1461,11 @@ namelist_write (st_parameter_dt *dtp)
   index_type dummy_offset = 0;
   char c;
   char * dummy_name = NULL;
-  unit_delim tmp_delim;
+  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;
   switch (tmp_delim)
     {
@@ -1460,7 +1484,7 @@ namelist_write (st_parameter_dt *dtp)
 
   /* Temporarily disable namelist delimters.  */
   dtp->u.p.delim_status = DELIM_NONE;
-
+  }
   write_character (dtp, "&", 1, 1);
 
   /* Write namelist name in upper case - f95 std.  */
@@ -1483,6 +1507,7 @@ namelist_write (st_parameter_dt *dtp)
   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;
 }
 

libgfortran/io/write_float.def

@@ -55,6 +55,7 @@ calculate_sign (st_parameter_dt *dtp, int negative_flag)
 	s = S_NONE;
 	break;
       case SIGN_S:	/* Processor defined. */
+      case SIGN_UNSPECIFIED:
 	s = options.optional_plus ? S_PLUS : S_NONE;
 	break;
       }
@@ -403,7 +404,10 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
       out += nbefore;
     }
   /* Output the decimal point.  */
+  if (dtp->common.flags & IOPARM_DT_HAS_F2003)
     *(out++) = dtp->u.p.decimal_status == DECIMAL_POINT ? '.' : ',';
+  else
+    *(out++) = '.';
 
   /* Output leading zeros after the decimal point.  */
   if (nzero > 0)