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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@140576 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 23 insertions, 10 deletions

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 8d25493b2fa..e35a7b1bdc3 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -439,9 +439,10 @@ read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
     read_utf8_char1 (dtp, p, length, w);
   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 == ',')
-	    *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->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;
+  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)