[gcc] GCC 4.5.0=>4.5.1

gcc/libgfortran/io/write_float.def

Index: gcc/libgfortran/io/write_float.def
diff --git a/gcc/libgfortran/io/write_float.def b/gcc/libgfortran/io/write_float.def
index 9804d7b9ab1caa226f7d705b5ac993e1440ab7d4..b945eb012db14c5e28cf56e8ded1489b1323eee4 100644
--- a/gcc/libgfortran/io/write_float.def
+++ b/gcc/libgfortran/io/write_float.def
@@ -1,4 +1,4 @@
-/* Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
    Contributed by Andy Vaught
    Write float code factoring to this file by Jerry DeLisle   
    F2003 I/O support contributed by Jerry DeLisle
@@ -68,7 +68,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
   char *out;
   char *digits;
   int e;
-  char expchar;
+  char expchar, rchar;
   format_token ft;
   int w;
   int d;
@@ -89,6 +89,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
   w = f->u.real.w;
   d = f->u.real.d;
 
+  rchar = '5';
   nzero_real = -1;
 
   /* We should always know the field width and precision.  */
@@ -140,6 +141,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
   switch (ft)
     {
     case FMT_F:
+      if (d == 0 && e <= 0 && dtp->u.p.scale_factor == 0)
+	{
+	  memmove (digits + 1, digits, ndigits - 1);
+	  digits[0] = '0';
+	  e++;
+	}
+
       nbefore = e + dtp->u.p.scale_factor;
       if (nbefore < 0)
 	{
@@ -235,24 +243,75 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
       internal_error (&dtp->common, "Unexpected format token");
     }
 
-  /* Round the value.  */
+  /* Round the value.  The value being rounded is an unsigned magnitude.
+     The ROUND_COMPATIBLE is rounding away from zero when there is a tie.  */
+  switch (dtp->u.p.current_unit->round_status)
+    {
+      case ROUND_ZERO: /* Do nothing and truncation occurs.  */
+	goto skip;
+      case ROUND_UP:
+	if (sign_bit)
+	  goto skip;
+	rchar = '0';
+	break;
+      case ROUND_DOWN:
+	if (!sign_bit)
+	  goto skip;
+	rchar = '0';
+	break;
+      case ROUND_NEAREST:
+	/* Round compatible unless there is a tie. A tie is a 5 with
+	   all trailing zero's.  */
+	i = nafter + nbefore;
+	if (digits[i] == '5')
+	  {
+	    for(i++ ; i < ndigits; i++)
+	      {
+		if (digits[i] != '0')
+		  goto do_rnd;
+	      }
+	    /* It is a  tie so round to even.  */
+	    switch (digits[nafter + nbefore - 1])
+	      {
+		case '1':
+		case '3':
+		case '5':
+		case '7':
+		case '9':
+		  /* If odd, round away from zero to even.  */
+		  break;
+		default:
+		  /* If even, skip rounding, truncate to even.  */
+		  goto skip;
+	      }
+	  }
+	 /* Fall through.  */ 
+      case ROUND_PROCDEFINED:
+      case ROUND_UNSPECIFIED:
+      case ROUND_COMPATIBLE:
+	rchar = '5';
+	/* Just fall through and do the actual rounding.  */
+    }
+    
+  do_rnd:
+ 
   if (nbefore + nafter == 0)
     {
       ndigits = 0;
-      if (nzero_real == d && digits[0] >= '5')
-        {
-          /* We rounded to zero but shouldn't have */
-          nzero--;
-          nafter = 1;
-          digits[0] = '1';
-          ndigits = 1;
-        }
+      if (nzero_real == d && digits[0] >= rchar)
+	{
+	  /* We rounded to zero but shouldn't have */
+	  nzero--;
+	  nafter = 1;
+	  digits[0] = '1';
+	  ndigits = 1;
+	}
     }
   else if (nbefore + nafter < ndigits)
     {
       ndigits = nbefore + nafter;
       i = ndigits;
-      if (digits[i] >= '5')
+      if (digits[i] >= rchar)
 	{
 	  /* Propagate the carry.  */
 	  for (i--; i >= 0; i--)
@@ -267,9 +326,10 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
 
 	  if (i < 0)
 	    {
-	      /* The carry overflowed.  Fortunately we have some spare space
-		 at the start of the buffer.  We may discard some digits, but
-		 this is ok because we already know they are zero.  */
+	      /* The carry overflowed.  Fortunately we have some spare
+	         space at the start of the buffer.  We may discard some
+	         digits, but this is ok because we already know they are
+	         zero.  */
 	      digits--;
 	      digits[0] = '1';
 	      if (ft == FMT_F)
@@ -297,6 +357,8 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
 	}
     }
 
+  skip:
+
   /* Calculate the format of the exponent field.  */
   if (expchar)
     {
@@ -756,21 +818,13 @@ sprintf (buffer, "%+-#" STR(MIN_FIELD_WIDTH) ".*" \
 {\
 	GFC_REAL_ ## x tmp;\
 	tmp = * (GFC_REAL_ ## x *)source;\
-	sign_bit = signbit (tmp);\
+	sign_bit = __builtin_signbit (tmp);\
 	if (!isfinite (tmp))\
 	  { \
 	    write_infnan (dtp, f, isnan (tmp), sign_bit);\
 	    return;\
 	  }\
 	tmp = sign_bit ? -tmp : tmp;\
-	if (f->u.real.d == 0 && f->format == FMT_F\
-	    && dtp->u.p.scale_factor == 0)\
-	  {\
-	    if (tmp < 0.5)\
-	      tmp = 0.0;\
-	    else if (tmp < 1.0)\
-	      tmp = 1.0;\
-	  }\
 	zero_flag = (tmp == 0.0);\
 \
 	DTOA ## y\