X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=libgfortran%2Fio%2Ftransfer.c;h=e707fbc510e41db6fec65f8a10ae42d97739e5a9;hp=c810f4d7bea5f8a8fec74d1548bbf5ff0e6e8e4f;hb=bc45c9ffdd1813a3cecb164e96148634c5142a52;hpb=9d3674bbd65736cd16fb0d997b173365e9b17152

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index c810f4d7bea..e707fbc510e 100644
--- a/libgfortran/io/transfer.c
+++ b/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;
@@ -329,10 +330,11 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes)
 	   to unit record length and proceed, otherwise error.  */
 	  if (dtp->u.p.current_unit->unit_number == options.stdin_unit
 	      && dtp->u.p.current_unit->recl == DEFAULT_RECL)
-          dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+            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 = 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;
+
   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;
 
@@ -1836,60 +1849,61 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
      st_parameter_open opp;
      unit_convert conv;
 
-     if (dtp->common.unit < 0)
-     {
-       close_unit (dtp->u.p.current_unit);
-       dtp->u.p.current_unit = NULL;
-       generate_error (&dtp->common, LIBERROR_BAD_OPTION,
-		       "Bad unit number in OPEN statement");
-       return;
-     }
-     memset (&u_flags, '\0', sizeof (u_flags));
-     u_flags.access = ACCESS_SEQUENTIAL;
-     u_flags.action = ACTION_READWRITE;
-
-     /* Is it unformatted?  */
-     if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT
-		 | IOPARM_DT_IONML_SET)))
-       u_flags.form = FORM_UNFORMATTED;
-     else
-       u_flags.form = FORM_UNSPECIFIED;
-
-     u_flags.delim = DELIM_UNSPECIFIED;
-     u_flags.blank = BLANK_UNSPECIFIED;
-     u_flags.pad = PAD_UNSPECIFIED;
-     u_flags.decimal = DECIMAL_UNSPECIFIED;
-     u_flags.encoding = ENCODING_UNSPECIFIED;
-     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);
-
-     if (conv == GFC_CONVERT_NONE)
-       conv = compile_options.convert;
-
-     /* We use big_endian, which is 0 on little-endian machines
-	and 1 on big-endian machines.  */
-     switch (conv)
-       {
-       case GFC_CONVERT_NATIVE:
-       case GFC_CONVERT_SWAP:
-	 break;
+    if (dtp->common.unit < 0)
+      {
+	close_unit (dtp->u.p.current_unit);
+	dtp->u.p.current_unit = NULL;
+	generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+			"Bad unit number in OPEN statement");
+	return;
+      }
+    memset (&u_flags, '\0', sizeof (u_flags));
+    u_flags.access = ACCESS_SEQUENTIAL;
+    u_flags.action = ACTION_READWRITE;
+
+    /* Is it unformatted?  */
+    if (!(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT
+		| IOPARM_DT_IONML_SET)))
+      u_flags.form = FORM_UNFORMATTED;
+    else
+      u_flags.form = FORM_UNSPECIFIED;
+
+    u_flags.delim = DELIM_UNSPECIFIED;
+    u_flags.blank = BLANK_UNSPECIFIED;
+    u_flags.pad = PAD_UNSPECIFIED;
+    u_flags.decimal = DECIMAL_UNSPECIFIED;
+    u_flags.encoding = ENCODING_UNSPECIFIED;
+    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);
+
+    if (conv == GFC_CONVERT_NONE)
+      conv = compile_options.convert;
+
+    /* We use big_endian, which is 0 on little-endian machines
+       and 1 on big-endian machines.  */
+    switch (conv)
+      {
+	case GFC_CONVERT_NATIVE:
+	case GFC_CONVERT_SWAP:
+	  break;
 	 
-       case GFC_CONVERT_BIG:
-	 conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
-	 break;
+	case GFC_CONVERT_BIG:
+	  conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
+	  break;
       
-       case GFC_CONVERT_LITTLE:
-	 conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
-	 break;
+	case GFC_CONVERT_LITTLE:
+	  conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
+	  break;
 	 
-       default:
-	 internal_error (&opp.common, "Illegal value for CONVERT");
-	 break;
-       }
+	default:
+	  internal_error (&opp.common, "Illegal value for CONVERT");
+	  break;
+      }
 
      u_flags.convert = conv;
 
@@ -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,52 +2073,58 @@ 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;
 
-  /* 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");
+  /* 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->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;
+      if (dtp->u.p.decimal_status == DECIMAL_UNSPECIFIED)
+	dtp->u.p.decimal_status = dtp->u.p.current_unit->flags.decimal;
 
-  /* 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,
-		   "Bad SIGN parameter in data transfer statement");
+      /* Check the sign mode. */
+      dtp->u.p.sign_status
+	= !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED :
+	  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)
-    dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign;
-
-  /* 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,
-		   "Bad BLANK parameter in data transfer statement");
+      if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
+	dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign;
+
+      /* Check the blank mode.  */
+      dtp->u.p.blank_status
+	= !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED :
+	  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)
-    dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
+      if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
+	dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
   
-  /* 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,
-		   "Bad DELIM parameter in data transfer statement");
+      /* Check the delim mode.  */
+      dtp->u.p.delim_status
+	= !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
+	  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)
-    dtp->u.p.delim_status = dtp->u.p.current_unit->flags.delim;
-
-  /* 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,
-		   "Bad PAD parameter in data transfer statement");
+      if (dtp->u.p.delim_status == DELIM_UNSPECIFIED)
+	dtp->u.p.delim_status = dtp->u.p.current_unit->flags.delim;
+
+      /* Check the pad mode.  */
+      dtp->u.p.pad_status
+	= !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
+	  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;
- 
+      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)
     {