OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/34482 (FAIL: gfortran.dg/nan_4.f90 -O tests for errors)

Browse Source 
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:
Tobias Burnus 2007-12-20 09:13:09 +01:00 committed by Tobias Burnus
parent f411364823
commit c7abc45c7f
10 changed files with 120 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -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

3
gcc/fortran/expr.c
View File

@ -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)

5
gcc/fortran/gfortran.texi
View File

@ -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}

3
gcc/fortran/resolve.c
View File

@ -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)

15
gcc/fortran/simplify.c
View File

@ -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");
}

42
gcc/fortran/target-memory.c
View File

@ -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;
}

2
gcc/fortran/target-memory.h
View File

@ -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 *);

7
gcc/testsuite/ChangeLog
View File

@ -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.

1
gcc/testsuite/gfortran.dg/boz_8.f90
View File

@ -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

90
gcc/testsuite/gfortran.dg/boz_9.f90
View File

@ -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