re PR fortran/34482 (FAIL: gfortran.dg/nan_4.f90 -O tests for errors)
2007-12-20 Tobias Burnus <burnus@net-b.de> PR fortran/34482 * gfortran.texi (BOZ): Document behavior for complex numbers. * target-memory.h (gfc_convert_boz): Update prototype. * target-memory.c (gfc_convert_boz): Add error check and convert BOZ to smallest possible bit size. * resolve.c (resolve_ordinary_assign): Check return value. * expr.c (gfc_check_assign): Ditto. * simplify.c (simplify_cmplx, gfc_simplify_dble, gfc_simplify_float, gfc_simplify_real): Ditto. 2007-12-20 Tobias Burnus <burnus@net-b.de> PR fortran/34482 * gfortran.dg/boz_8.f90: Add error-check check. * gfortran.dg/boz_9.f90: Shorten BOZ where needed, replace stop by call abort. From-SVN: r131098
This commit is contained in:
parent
f411364823
commit
c7abc45c7f
|
@ -1,3 +1,16 @@
|
|||
2007-12-20 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/34482
|
||||
* gfortran.texi (BOZ): Document behavior for complex
|
||||
numbers.
|
||||
* target-memory.h (gfc_convert_boz): Update prototype.
|
||||
* target-memory.c (gfc_convert_boz): Add error check
|
||||
and convert BOZ to smallest possible bit size.
|
||||
* resolve.c (resolve_ordinary_assign): Check return value.
|
||||
* expr.c (gfc_check_assign): Ditto.
|
||||
* simplify.c (simplify_cmplx, gfc_simplify_dble,
|
||||
gfc_simplify_float, gfc_simplify_real): Ditto.
|
||||
|
||||
2007-12-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR fortran/34325
|
||||
|
|
|
@ -2777,7 +2777,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
|
|||
gfc_warning ("BOZ literal at %L is bitwise transferred "
|
||||
"non-integer symbol '%s'", &rvalue->where,
|
||||
lvalue->symtree->n.sym->name);
|
||||
gfc_convert_boz (rvalue, &lvalue->ts);
|
||||
if (!gfc_convert_boz (rvalue, &lvalue->ts))
|
||||
return FAILURE;
|
||||
if ((rc = gfc_range_check (rvalue)) != ARITH_OK)
|
||||
{
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
|
|
|
@ -1115,8 +1115,9 @@ DATA statements and the four intrinsic functions allowed by Fortran 2003.
|
|||
In DATA statements, in direct assignments, where the right-hand side
|
||||
only contains a BOZ literal constant, and for old-style initializers of
|
||||
the form @code{integer i /o'0173'/}, the constant is transferred
|
||||
as if @code{TRANSFER} had been used. In all other cases, the BOZ literal
|
||||
constant is converted to an @code{INTEGER} value with
|
||||
as if @code{TRANSFER} had been used; for @code{COMPLEX} numbers, only
|
||||
the real part is initialized unless @code{CMPLX} is used. In all other
|
||||
cases, the BOZ literal constant is converted to an @code{INTEGER} value with
|
||||
the largest decimal representation. This value is then converted
|
||||
numerically to the type and kind of the variable in question.
|
||||
(For instance @code{real :: r = b'0000001' + 1} initializes @code{r}
|
||||
|
|
|
@ -5932,7 +5932,8 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
|
|||
"non-integer symbol '%s'", &code->loc,
|
||||
lhs->symtree->n.sym->name);
|
||||
|
||||
gfc_convert_boz (rhs, &lhs->ts);
|
||||
if (!gfc_convert_boz (rhs, &lhs->ts))
|
||||
return false;
|
||||
if ((rc = gfc_range_check (rhs)) != ARITH_OK)
|
||||
{
|
||||
if (rc == ARITH_UNDERFLOW)
|
||||
|
|
|
@ -781,7 +781,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
gfc_typespec ts;
|
||||
ts.kind = result->ts.kind;
|
||||
ts.type = BT_REAL;
|
||||
gfc_convert_boz (x, &ts);
|
||||
if (!gfc_convert_boz (x, &ts))
|
||||
return &gfc_bad_expr;
|
||||
mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
|
||||
}
|
||||
|
||||
|
@ -790,7 +791,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
|
|||
gfc_typespec ts;
|
||||
ts.kind = result->ts.kind;
|
||||
ts.type = BT_REAL;
|
||||
gfc_convert_boz (y, &ts);
|
||||
if (!gfc_convert_boz (y, &ts))
|
||||
return &gfc_bad_expr;
|
||||
mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
|
||||
}
|
||||
|
||||
|
@ -961,7 +963,8 @@ gfc_simplify_dble (gfc_expr *e)
|
|||
ts.type = BT_REAL;
|
||||
ts.kind = gfc_default_double_kind;
|
||||
result = gfc_copy_expr (e);
|
||||
gfc_convert_boz (result, &ts);
|
||||
if (!gfc_convert_boz (result, &ts))
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
|
||||
return range_check (result, "DBLE");
|
||||
|
@ -1150,7 +1153,8 @@ gfc_simplify_float (gfc_expr *a)
|
|||
ts.kind = gfc_default_real_kind;
|
||||
|
||||
result = gfc_copy_expr (a);
|
||||
gfc_convert_boz (result, &ts);
|
||||
if (!gfc_convert_boz (result, &ts))
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
else
|
||||
result = gfc_int2real (a, gfc_default_real_kind);
|
||||
|
@ -3019,7 +3023,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
|
|||
ts.type = BT_REAL;
|
||||
ts.kind = kind;
|
||||
result = gfc_copy_expr (e);
|
||||
gfc_convert_boz (result, &ts);
|
||||
if (!gfc_convert_boz (result, &ts))
|
||||
return &gfc_bad_expr;
|
||||
}
|
||||
return range_check (result, "REAL");
|
||||
}
|
||||
|
|
|
@ -596,26 +596,54 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
|
|||
return len;
|
||||
}
|
||||
|
||||
void
|
||||
|
||||
/* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
|
||||
When successful, no BOZ or nothing to do, true is returned. */
|
||||
|
||||
bool
|
||||
gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
|
||||
{
|
||||
size_t buffer_size;
|
||||
size_t buffer_size, boz_bit_size, ts_bit_size;
|
||||
int index;
|
||||
unsigned char *buffer;
|
||||
|
||||
if (!expr->is_boz)
|
||||
return;
|
||||
return true;
|
||||
|
||||
gcc_assert (expr->expr_type == EXPR_CONSTANT
|
||||
&& expr->ts.type == BT_INTEGER);
|
||||
|
||||
/* Don't convert BOZ to logical, character, derived etc. */
|
||||
if (ts->type == BT_REAL)
|
||||
buffer_size = size_float (ts->kind);
|
||||
{
|
||||
buffer_size = size_float (ts->kind);
|
||||
ts_bit_size = buffer_size * 8;
|
||||
}
|
||||
else if (ts->type == BT_COMPLEX)
|
||||
buffer_size = size_complex (ts->kind);
|
||||
{
|
||||
buffer_size = size_complex (ts->kind);
|
||||
ts_bit_size = buffer_size * 8 / 2;
|
||||
}
|
||||
else
|
||||
return;
|
||||
return true;
|
||||
|
||||
/* Convert BOZ to the smallest possible integer kind. */
|
||||
boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
|
||||
|
||||
if (boz_bit_size > ts_bit_size)
|
||||
{
|
||||
gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
|
||||
&expr->where, (long) boz_bit_size, (long) ts_bit_size);
|
||||
return false;
|
||||
}
|
||||
|
||||
for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
|
||||
{
|
||||
if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
|
||||
break;
|
||||
}
|
||||
|
||||
expr->ts.kind = gfc_integer_kinds[index].kind;
|
||||
buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
|
||||
|
||||
buffer = (unsigned char*)alloca (buffer_size);
|
||||
|
@ -637,4 +665,6 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
|
|||
expr->is_boz = 0;
|
||||
expr->ts.type = ts->type;
|
||||
expr->ts.kind = ts->kind;
|
||||
|
||||
return true;
|
||||
}
|
||||
|
|
|
@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see
|
|||
#include "gfortran.h"
|
||||
|
||||
/* Convert a BOZ to REAL or COMPLEX. */
|
||||
void gfc_convert_boz (gfc_expr *, gfc_typespec *);
|
||||
bool gfc_convert_boz (gfc_expr *, gfc_typespec *);
|
||||
|
||||
/* Return the size of an expression in its target representation. */
|
||||
size_t gfc_target_expr_size (gfc_expr *);
|
||||
|
|
|
@ -1,3 +1,10 @@
|
|||
2007-12-20 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/34482
|
||||
* gfortran.dg/boz_8.f90: Add error-check check.
|
||||
* gfortran.dg/boz_9.f90: Shorten BOZ where needed, replace
|
||||
stop by call abort.
|
||||
|
||||
2007-12-19 Zdenek Dvorak <ook@ucw.cz>
|
||||
|
||||
* gcc.dg/gomp/combined-1.c: New test.
|
||||
|
|
|
@ -13,4 +13,5 @@ integer :: i
|
|||
data i/z'111'/, r/z'4455'/ ! { dg-error "BOZ literal at .1. used to initialize non-integer variable 'r'" }
|
||||
r = z'FFFF' ! { dg-error "outside a DATA statement" }
|
||||
i = z'4455' ! { dg-error "outside a DATA statement" }
|
||||
r = real(z'FFFFFFFFF') ! { dg-error "is too large" }
|
||||
end
|
||||
|
|
|
@ -20,17 +20,17 @@ double precision :: d = dble(Z'3FD34413509F79FF')
|
|||
complex :: z1 = cmplx(b'10101',-4.0)
|
||||
complex :: z2 = cmplx(5.0, o'01245')
|
||||
|
||||
if (r2c /= 13107.0) stop '1'
|
||||
if (rc /= 1.83668190E-41) stop '2'
|
||||
if (dc /= 0.30102999566398120) stop '3'
|
||||
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
|
||||
if (r2c /= 13107.0) call abort()
|
||||
if (rc /= 1.83668190E-41) call abort()
|
||||
if (dc /= 0.30102999566398120) call abort()
|
||||
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
|
||||
|
||||
if (r2 /= 13107.0) stop '1'
|
||||
if (r /= 1.83668190E-41) stop '2'
|
||||
if (d /= 0.30102999566398120) stop '3'
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
|
||||
if (r2 /= 13107.0) call abort()
|
||||
if (r /= 1.83668190E-41) call abort()
|
||||
if (d /= 0.30102999566398120) call abort()
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
|
||||
|
||||
r2 = dble(int(z'3333'))
|
||||
r = real(z'3333')
|
||||
|
@ -38,11 +38,11 @@ d = dble(Z'3FD34413509F79FF')
|
|||
z1 = cmplx(b'10101',-4.0)
|
||||
z2 = cmplx(5.0, o'01245')
|
||||
|
||||
if (r2 /= 13107.0) stop '1'
|
||||
if (r /= 1.83668190E-41) stop '2'
|
||||
if (d /= 0.30102999566398120) stop '3'
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
|
||||
if (r2 /= 13107.0) call abort()
|
||||
if (r /= 1.83668190E-41) call abort()
|
||||
if (d /= 0.30102999566398120) call abort()
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
|
||||
|
||||
call test4()
|
||||
call test8()
|
||||
|
@ -60,58 +60,58 @@ real :: r = real(z'3333', kind=4)
|
|||
complex :: z1 = cmplx(b'10101',-4.0, kind=4)
|
||||
complex :: z2 = cmplx(5.0, o'01245', kind=4)
|
||||
|
||||
if (r2c /= 13107.0) stop '1'
|
||||
if (rc /= 1.83668190E-41) stop '2'
|
||||
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4'
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5'
|
||||
if (r2c /= 13107.0) call abort()
|
||||
if (rc /= 1.83668190E-41) call abort()
|
||||
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
|
||||
|
||||
if (r2 /= 13107.0) stop '1'
|
||||
if (r /= 1.83668190E-41) stop '2'
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
|
||||
if (r2 /= 13107.0) call abort()
|
||||
if (r /= 1.83668190E-41) call abort()
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
|
||||
|
||||
r2 = real(int(z'3333'), kind=4)
|
||||
r = real(z'3333', kind=4)
|
||||
z1 = cmplx(b'10101',-4.0, kind=4)
|
||||
z2 = cmplx(5.0, o'01245', kind=4)
|
||||
|
||||
if (r2 /= 13107.0) stop '1'
|
||||
if (r /= 1.83668190E-41) stop '2'
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5'
|
||||
if (r2 /= 13107.0) call abort()
|
||||
if (r /= 1.83668190E-41) call abort()
|
||||
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
|
||||
end subroutine test4
|
||||
|
||||
|
||||
subroutine test8
|
||||
real(8),parameter :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
|
||||
real(8),parameter :: rc = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
|
||||
real(8),parameter :: rc = real(z'AAAAAFFFFFFF3333', kind=8)
|
||||
complex(8),parameter :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
|
||||
complex(8),parameter :: z2c = cmplx(5.0, o'444444444442222222222233301245', kind=8)
|
||||
complex(8),parameter :: z2c = cmplx(5.0, o'442222222222233301245', kind=8)
|
||||
|
||||
real(8) :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
|
||||
real(8) :: r = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
|
||||
real(8) :: r = real(z'AAAAAFFFFFFF3333', kind=8)
|
||||
complex(8) :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
|
||||
complex(8) :: z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
|
||||
complex(8) :: z2 = cmplx(5.0, o'442222222222233301245', kind=8)
|
||||
|
||||
if (r2c /= 1099511575347.0d0) stop '1'
|
||||
if (rc /= -3.72356884822177915d-103) stop '2'
|
||||
if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) stop '4'
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) stop '5'
|
||||
if (r2c /= 1099511575347.0d0) call abort()
|
||||
if (rc /= -3.72356884822177915d-103) call abort()
|
||||
if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) call abort()
|
||||
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) call abort()
|
||||
|
||||
if (r2 /= 1099511575347.0d0) stop '1'
|
||||
if (r /= -3.72356884822177915d-103) stop '2'
|
||||
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
|
||||
if (r2 /= 1099511575347.0d0) call abort()
|
||||
if (r /= -3.72356884822177915d-103) call abort()
|
||||
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
|
||||
|
||||
r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
|
||||
r = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
|
||||
r = real(z'AAAAAFFFFFFF3333', kind=8)
|
||||
z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
|
||||
z2 = cmplx(5.0, o'444444444442222222222233301245', kind=8)
|
||||
z2 = cmplx(5.0, o'442222222222233301245', kind=8)
|
||||
|
||||
if (r2 /= 1099511575347.0d0) stop '1'
|
||||
if (r /= -3.72356884822177915d-103) stop '2'
|
||||
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4'
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5'
|
||||
if (r2 /= 1099511575347.0d0) call abort()
|
||||
if (r /= -3.72356884822177915d-103) call abort()
|
||||
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
|
||||
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
|
||||
|
||||
end subroutine test8
|
||||
|
||||
|
|
Loading…
Reference in New Issue