On Sat, Oct 22, 2011 at 01:16:14PM -0700, Steve Kargl wrote:
> The attach patch reaps some code that is now dead
> due to my recent changes for ishftc in check.c.
> Regression tested on i686-*-freebsd.
>
> 2011-10-22 Steevn G. Kargl <[email protected]>
>
> * simplify.c (gfc_simplify_ishftc): Reap dead code.
Here's a revised patch that does 2 things. First, it adds
a check in gfc_check_nearest that the 2nd argument (if it
is a constant) is not zero. Second, it reaps a dead code
in several of the simplification functions.
2011-10-26 Steven G. Kargl <[email protected]>
* 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-26 Steven G. Kargl <[email protected]>
* gfortran.dg/nearest_5.f90: New test.
--
Steve
Index: fortran/check.c
===================================================================
--- fortran/check.c (revision 180529)
+++ fortran/check.c (working copy)
@@ -934,7 +934,7 @@ null_arg:
gfc_try
gfc_check_atan_2 (gfc_expr *y, gfc_expr *x)
{
- /* gfc_notify_std would be a wast of time as the return value
+ /* gfc_notify_std would be a waste of time as the return value
is seemingly used only for the generic resolution. The error
will be: Too many arguments. */
if ((gfc_option.allow_std & GFC_STD_F2008) == 0)
@@ -2710,6 +2710,16 @@ gfc_check_nearest (gfc_expr *x, gfc_expr
if (type_check (s, 1, BT_REAL) == FAILURE)
return FAILURE;
+ if (s->expr_type == EXPR_CONSTANT)
+ {
+ if (mpfr_sgn (s->value.real) == 0)
+ {
+ gfc_error ("Argument 'S' of NEAREST at %L shall not be zero",
+ &s->where);
+ return FAILURE;
+ }
+ }
+
return SUCCESS;
}
Index: fortran/simplify.c
===================================================================
--- fortran/simplify.c (revision 180529)
+++ fortran/simplify.c (working copy)
@@ -1899,13 +1899,7 @@ simplify_dshift (gfc_expr *arg1, gfc_exp
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_exp
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_exp
|| 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_exp
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
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_ex
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_ex
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_ex
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_e
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. */
Index: testsuite/gfortran.dg/nearest_5.f90
===================================================================
--- testsuite/gfortran.dg/nearest_5.f90 (revision 0)
+++ testsuite/gfortran.dg/nearest_5.f90 (revision 0)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+program a
+ real x, y(2)
+ x = 1./3.
+ y = [1, 2] / 3.
+ print *, nearest(x, 0.) ! { dg-error "shall not be zero" }
+ print *, nearest(y, 0.) ! { dg-error "shall not be zero" }
+ print *, nearest([1., 2.] / 3., 0.) ! { dg-error "shall not be zero" }
+ print *, nearest(1., 0.) ! { dg-error "shall not be zero" }
+end program a
