2008-12-08 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r142553
2008-12-08  Basile Starynkevitch  <basile@starynkevitch.net>
	* gcc/Makefile.in: using BACKENDLIBS as merged from trunk r142553



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@142557 138bc75d-0d04-0410-961f-82ee72b054a4

2 files changed, 83 insertions, 26 deletions

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index c4fae32bead..318d2215ee2 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1967,7 +1967,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       return;
     }
 
-  /* Check the record or position number.  */
+  /* Check the record number.  */
 
   if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT
       && (cf & IOPARM_DT_HAS_REC) == 0)
@@ -1986,6 +1986,15 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       return;
     }
 
+  if (dtp->u.p.current_unit->flags.access == ACCESS_STREAM
+      && (cf & IOPARM_DT_HAS_REC) != 0)
+    {
+      generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT,
+		      "Record number not allowed for stream access "
+		      "data transfer");
+      return;
+    }
+
   /* Process the ADVANCE option.  */
 
   dtp->u.p.advance_status
@@ -2116,6 +2125,65 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   
   if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
 	dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
+  
+  /* Check the POS= specifier: that it is in range and that it is used with a
+     unit that has been connected for STREAM access. F2003 9.5.1.10.  */
+  
+  if (((cf & IOPARM_DT_HAS_POS) != 0))
+    {
+      if (is_stream_io (dtp))
+	{
+
+	  if (dtp->pos <= 0)
+	    {
+	      generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+			      "POS=specifier must be positive");
+	      return;
+	    }
+
+	  if (dtp->rec >= dtp->u.p.current_unit->maxrec)
+	    {
+	      generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+			      "POS=specifier too large");
+	      return;
+	    }
+
+	  dtp->rec = dtp->pos;
+
+	  if (dtp->u.p.mode == READING)
+	    {
+	      /* Required for compatibility between 4.3 and 4.4 runtime. Check
+	      to see if we might be reading what we wrote before  */
+	      if (dtp->u.p.current_unit->mode == WRITING)
+		{
+		  fbuf_flush (dtp->u.p.current_unit, 1);      
+		  flush(dtp->u.p.current_unit->s);
+		}
+
+	      if (dtp->pos < file_length (dtp->u.p.current_unit->s))
+		dtp->u.p.current_unit->endfile = NO_ENDFILE;
+	    }
+
+	  if (dtp->pos != dtp->u.p.current_unit->strm_pos)
+	    {
+	      fbuf_flush (dtp->u.p.current_unit, 1);
+	      flush (dtp->u.p.current_unit->s);
+	      if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE)
+		{
+		  generate_error (&dtp->common, LIBERROR_OS, NULL);
+		  return;
+		}
+	      dtp->u.p.current_unit->strm_pos = dtp->pos;
+	    }
+	}
+      else
+	{
+	  generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+			  "POS=specifier not allowed, "
+			  "Try OPEN with ACCESS='stream'");
+	  return;
+	}
+    }
 
   /* Sanity checks on the record number.  */
   if ((cf & IOPARM_DT_HAS_REC) != 0)
@@ -2139,10 +2207,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if (dtp->u.p.mode == READING
 	  && dtp->u.p.current_unit->mode == WRITING
 	  && !is_internal_unit (dtp))
-        {
-          fbuf_flush (dtp->u.p.current_unit, 1);      
+	{
+	  fbuf_flush (dtp->u.p.current_unit, 1);      
 	  flush(dtp->u.p.current_unit->s);
-        }
+	}
 
       /* Check whether the record exists to be read.  Only
 	 a partial record needs to exist.  */
@@ -2156,29 +2224,17 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	}
 
       /* Position the file.  */
-      if (!is_stream_io (dtp))
+      if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
+		 * dtp->u.p.current_unit->recl) == FAILURE)
 	{
-	  if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
-		     * dtp->u.p.current_unit->recl) == FAILURE)
-	    {
-	      generate_error (&dtp->common, LIBERROR_OS, NULL);
-	      return;
-	    }
+	  generate_error (&dtp->common, LIBERROR_OS, NULL);
+	  return;
 	}
-      else
-        {
-	  if (dtp->u.p.current_unit->strm_pos != dtp->rec)
-	    {
-	      fbuf_flush (dtp->u.p.current_unit, 1);
-	      flush (dtp->u.p.current_unit->s);
-	      if (sseek (dtp->u.p.current_unit->s, dtp->rec - 1) == FAILURE)
-	        {
-	          generate_error (&dtp->common, LIBERROR_OS, NULL);
-	          return;
-	        }
-	      dtp->u.p.current_unit->strm_pos = dtp->rec;
-	    }
-        }
+
+      /* This is required to maintain compatibility between
+	 4.3 and 4.4 runtime.  */
+      if (is_stream_io (dtp))
+	dtp->u.p.current_unit->strm_pos = dtp->rec;
 
     }
 
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 8bb4123084f..d8799f2ae03 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -760,7 +760,8 @@ sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 	    return;\
 	  }\
 	tmp = sign_bit ? -tmp : tmp;\
-	if (f->u.real.d == 0 && f->format == FMT_F)\
+	if (f->u.real.d == 0 && f->format == FMT_F\
+	    && dtp->u.p.scale_factor == 0)\
 	  {\
 	    if (tmp < 0.5)\
 	      tmp = 0.0;\