check.c (gfc_check_atan_2): Typo in comment.

2011-10-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	* check.c (gfc_check_atan_2): Typo in comment.
	(gfc_check_nearest): If 's' is constant, check that it is not 0.
	* simplify.c (simplify_dshift, gfc_simplify_ibclr, gfc_simplify_ibits,
	gfc_simplify_ibset, simplify_shift, gfc_simplify_ishftc,
	gfc_simplify_nearest): Remove dead code.

2011-10-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	* gfortran.dg/nearest_5.f90: New test.

From-SVN: r180618

1 files changed, 10 insertions, 74 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a499996..01071cf 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1899,13 +1899,7 @@ simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
   k = gfc_validate_kind (BT_INTEGER, arg1->ts.kind, false);
   size = gfc_integer_kinds[k].bit_size;
 
-  if (gfc_extract_int (shiftarg, &shift) != NULL)
-    {
-      gfc_error ("Invalid SHIFT argument of DSHIFTL at %L", &shiftarg->where);
-      return &gfc_bad_expr;
-    }
-
-  gcc_assert (shift >= 0 && shift <= size);
+  gfc_extract_int (shiftarg, &shift);
 
   /* DSHIFTR(I,J,SHIFT) = DSHIFTL(I,J,SIZE-SHIFT).  */
   if (right)
@@ -2509,21 +2503,10 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
-    {
-      gfc_error ("Invalid second argument of IBCLR at %L", &y->where);
-      return &gfc_bad_expr;
-    }
+  gfc_extract_int (y, &pos);
 
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
 
-  if (pos >= gfc_integer_kinds[k].bit_size)
-    {
-      gfc_error ("Second argument of IBCLR exceeds bit size at %L",
-		 &y->where);
-      return &gfc_bad_expr;
-    }
-
   result = gfc_copy_expr (x);
 
   convert_mpz_to_unsigned (result->value.integer,
@@ -2551,17 +2534,8 @@ gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
       || z->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
-    {
-      gfc_error ("Invalid second argument of IBITS at %L", &y->where);
-      return &gfc_bad_expr;
-    }
-
-  if (gfc_extract_int (z, &len) != NULL || len < 0)
-    {
-      gfc_error ("Invalid third argument of IBITS at %L", &z->where);
-      return &gfc_bad_expr;
-    }
+  gfc_extract_int (y, &pos);
+  gfc_extract_int (z, &len);
 
   k = gfc_validate_kind (BT_INTEGER, x->ts.kind, false);
 
@@ -2614,21 +2588,10 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
-    {
-      gfc_error ("Invalid second argument of IBSET at %L", &y->where);
-      return &gfc_bad_expr;
-    }
+  gfc_extract_int (y, &pos);
 
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
 
-  if (pos >= gfc_integer_kinds[k].bit_size)
-    {
-      gfc_error ("Second argument of IBSET exceeds bit size at %L",
-		 &y->where);
-      return &gfc_bad_expr;
-    }
-
   result = gfc_copy_expr (x);
 
   convert_mpz_to_unsigned (result->value.integer,
@@ -3004,11 +2967,8 @@ simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
 
   if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
     return NULL;
-  if (gfc_extract_int (s, &shift) != NULL)
-    {
-      gfc_error ("Invalid second argument of %s at %L", name, &s->where);
-      return &gfc_bad_expr;
-    }
+
+  gfc_extract_int (s, &shift);
 
   k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
   bitsize = gfc_integer_kinds[k].bit_size;
@@ -3146,11 +3106,7 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
   if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (gfc_extract_int (s, &shift) != NULL)
-    {
-      gfc_error ("Invalid second argument of ISHFTC at %L", &s->where);
-      return &gfc_bad_expr;
-    }
+  gfc_extract_int (s, &shift);
 
   k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
   isize = gfc_integer_kinds[k].bit_size;
@@ -3160,18 +3116,8 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
       if (sz->expr_type != EXPR_CONSTANT)
 	return NULL;
 
-      if (gfc_extract_int (sz, &ssize) != NULL || ssize <= 0)
-	{
-	  gfc_error ("Invalid third argument of ISHFTC at %L", &sz->where);
-	  return &gfc_bad_expr;
-	}
+      gfc_extract_int (sz, &ssize);
 
-      if (ssize > isize)
-	{
-	  gfc_error ("Magnitude of third argument of ISHFTC exceeds "
-		     "BIT_SIZE of first argument at %L", &s->where);
-	  return &gfc_bad_expr;
-	}
     }
   else
     ssize = isize;
@@ -3183,10 +3129,7 @@ gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
 
   if (ashift > ssize)
     {
-      if (sz != NULL)
-	gfc_error ("Magnitude of second argument of ISHFTC exceeds "
-		   "third argument at %L", &s->where);
-      else
+      if (sz == NULL)
 	gfc_error ("Magnitude of second argument of ISHFTC exceeds "
 		   "BIT_SIZE of first argument at %L", &s->where);
       return &gfc_bad_expr;
@@ -4382,13 +4325,6 @@ gfc_simplify_nearest (gfc_expr *x, gfc_expr *s)
   if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  if (mpfr_sgn (s->value.real) == 0)
-    {
-      gfc_error ("Second argument of NEAREST at %L shall not be zero",
-		 &s->where);
-      return &gfc_bad_expr;
-    }
-
   result = gfc_copy_expr (x);
 
   /* Save current values of emin and emax.  */