Skip to content

R
riscv-gcc-1
Commit c7abc45c by Tobias Burnus Committed by Tobias Burnus
Options

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
parent f4113648
Showing with 121 additions and 62 deletions
gcc/fortran/ChangeLog
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> 2007-12-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/34325 PR fortran/34325
......
gcc/fortran/expr.c
...@@ -2777,7 +2777,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) ...@@ -2777,7 +2777,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
gfc_warning ("BOZ literal at %L is bitwise transferred " gfc_warning ("BOZ literal at %L is bitwise transferred "
"non-integer symbol '%s'", &rvalue->where, "non-integer symbol '%s'", &rvalue->where,
lvalue->symtree->n.sym->name); 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 = gfc_range_check (rvalue)) != ARITH_OK)
{ {
if (rc == ARITH_UNDERFLOW) if (rc == ARITH_UNDERFLOW)
......
gcc/fortran/gfortran.texi
...@@ -1115,8 +1115,9 @@ DATA statements and the four intrinsic functions allowed by Fortran 2003. ...@@ -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 In DATA statements, in direct assignments, where the right-hand side
only contains a BOZ literal constant, and for old-style initializers of only contains a BOZ literal constant, and for old-style initializers of
the form @code{integer i /o'0173'/}, the constant is transferred 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 as if @code{TRANSFER} had been used; for @code{COMPLEX} numbers, only
constant is converted to an @code{INTEGER} value with 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 the largest decimal representation. This value is then converted
numerically to the type and kind of the variable in question. numerically to the type and kind of the variable in question.
(For instance @code{real :: r = b'0000001' + 1} initializes @code{r} (For instance @code{real :: r = b'0000001' + 1} initializes @code{r}
......
gcc/fortran/resolve.c
...@@ -5932,7 +5932,8 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) ...@@ -5932,7 +5932,8 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
"non-integer symbol '%s'", &code->loc, "non-integer symbol '%s'", &code->loc,
lhs->symtree->n.sym->name); 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 = gfc_range_check (rhs)) != ARITH_OK)
{ {
if (rc == ARITH_UNDERFLOW) if (rc == ARITH_UNDERFLOW)
......
gcc/fortran/simplify.c
...@@ -781,7 +781,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind) ...@@ -781,7 +781,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
gfc_typespec ts; gfc_typespec ts;
ts.kind = result->ts.kind; ts.kind = result->ts.kind;
ts.type = BT_REAL; 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); 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) ...@@ -790,7 +791,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
gfc_typespec ts; gfc_typespec ts;
ts.kind = result->ts.kind; ts.kind = result->ts.kind;
ts.type = BT_REAL; 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); mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
} }
...@@ -961,7 +963,8 @@ gfc_simplify_dble (gfc_expr *e) ...@@ -961,7 +963,8 @@ gfc_simplify_dble (gfc_expr *e)
ts.type = BT_REAL; ts.type = BT_REAL;
ts.kind = gfc_default_double_kind; ts.kind = gfc_default_double_kind;
result = gfc_copy_expr (e); 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"); return range_check (result, "DBLE");
...@@ -1150,7 +1153,8 @@ gfc_simplify_float (gfc_expr *a) ...@@ -1150,7 +1153,8 @@ gfc_simplify_float (gfc_expr *a)
ts.kind = gfc_default_real_kind; ts.kind = gfc_default_real_kind;
result = gfc_copy_expr (a); result = gfc_copy_expr (a);
gfc_convert_boz (result, &ts); if (!gfc_convert_boz (result, &ts))
return &gfc_bad_expr;
} }
else else
result = gfc_int2real (a, gfc_default_real_kind); result = gfc_int2real (a, gfc_default_real_kind);
...@@ -3019,7 +3023,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k) ...@@ -3019,7 +3023,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
ts.type = BT_REAL; ts.type = BT_REAL;
ts.kind = kind; ts.kind = kind;
result = gfc_copy_expr (e); 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"); return range_check (result, "REAL");
} }
......
gcc/fortran/target-memory.c
...@@ -596,26 +596,54 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data, ...@@ -596,26 +596,54 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
return len; 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) 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; unsigned char *buffer;
if (!expr->is_boz) if (!expr->is_boz)
return; return true;
gcc_assert (expr->expr_type == EXPR_CONSTANT gcc_assert (expr->expr_type == EXPR_CONSTANT
&& expr->ts.type == BT_INTEGER); && expr->ts.type == BT_INTEGER);
/* Don't convert BOZ to logical, character, derived etc. */ /* Don't convert BOZ to logical, character, derived etc. */
if (ts->type == BT_REAL) 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) 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 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_size = MAX (buffer_size, size_integer (expr->ts.kind));
buffer = (unsigned char*)alloca (buffer_size); buffer = (unsigned char*)alloca (buffer_size);
...@@ -637,4 +665,6 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) ...@@ -637,4 +665,6 @@ gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
expr->is_boz = 0; expr->is_boz = 0;
expr->ts.type = ts->type; expr->ts.type = ts->type;
expr->ts.kind = ts->kind; expr->ts.kind = ts->kind;
return true;
} }
gcc/fortran/target-memory.h
...@@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -25,7 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h" #include "gfortran.h"
/* Convert a BOZ to REAL or COMPLEX. */ /* 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. */ /* Return the size of an expression in its target representation. */
size_t gfc_target_expr_size (gfc_expr *); size_t gfc_target_expr_size (gfc_expr *);
......
gcc/testsuite/ChangeLog
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> 2007-12-19 Zdenek Dvorak <ook@ucw.cz>
* gcc.dg/gomp/combined-1.c: New test. * gcc.dg/gomp/combined-1.c: New test.
gcc/testsuite/gfortran.dg/boz_8.f90
...@@ -13,4 +13,5 @@ integer :: i ...@@ -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'" } 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" } r = z'FFFF' ! { dg-error "outside a DATA statement" }
i = z'4455' ! { 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 end
gcc/testsuite/gfortran.dg/boz_9.f90
...@@ -20,17 +20,17 @@ double precision :: d = dble(Z'3FD34413509F79FF') ...@@ -20,17 +20,17 @@ double precision :: d = dble(Z'3FD34413509F79FF')
complex :: z1 = cmplx(b'10101',-4.0) complex :: z1 = cmplx(b'10101',-4.0)
complex :: z2 = cmplx(5.0, o'01245') complex :: z2 = cmplx(5.0, o'01245')
if (r2c /= 13107.0) stop '1' if (r2c /= 13107.0) call abort()
if (rc /= 1.83668190E-41) stop '2' if (rc /= 1.83668190E-41) call abort()
if (dc /= 0.30102999566398120) stop '3' if (dc /= 0.30102999566398120) call abort()
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4' if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5' if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
if (r2 /= 13107.0) stop '1' if (r2 /= 13107.0) call abort()
if (r /= 1.83668190E-41) stop '2' if (r /= 1.83668190E-41) call abort()
if (d /= 0.30102999566398120) stop '3' if (d /= 0.30102999566398120) call abort()
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
r2 = dble(int(z'3333')) r2 = dble(int(z'3333'))
r = real(z'3333') r = real(z'3333')
...@@ -38,11 +38,11 @@ d = dble(Z'3FD34413509F79FF') ...@@ -38,11 +38,11 @@ d = dble(Z'3FD34413509F79FF')
z1 = cmplx(b'10101',-4.0) z1 = cmplx(b'10101',-4.0)
z2 = cmplx(5.0, o'01245') z2 = cmplx(5.0, o'01245')
if (r2 /= 13107.0) stop '1' if (r2 /= 13107.0) call abort()
if (r /= 1.83668190E-41) stop '2' if (r /= 1.83668190E-41) call abort()
if (d /= 0.30102999566398120) stop '3' if (d /= 0.30102999566398120) call abort()
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
call test4() call test4()
call test8() call test8()
...@@ -60,58 +60,58 @@ real :: r = real(z'3333', kind=4) ...@@ -60,58 +60,58 @@ real :: r = real(z'3333', kind=4)
complex :: z1 = cmplx(b'10101',-4.0, kind=4) complex :: z1 = cmplx(b'10101',-4.0, kind=4)
complex :: z2 = cmplx(5.0, o'01245', kind=4) complex :: z2 = cmplx(5.0, o'01245', kind=4)
if (r2c /= 13107.0) stop '1' if (r2c /= 13107.0) call abort()
if (rc /= 1.83668190E-41) stop '2' if (rc /= 1.83668190E-41) call abort()
if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) stop '4' if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) stop '5' if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
if (r2 /= 13107.0) stop '1' if (r2 /= 13107.0) call abort()
if (r /= 1.83668190E-41) stop '2' if (r /= 1.83668190E-41) call abort()
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
r2 = real(int(z'3333'), kind=4) r2 = real(int(z'3333'), kind=4)
r = real(z'3333', kind=4) r = real(z'3333', kind=4)
z1 = cmplx(b'10101',-4.0, kind=4) z1 = cmplx(b'10101',-4.0, kind=4)
z2 = cmplx(5.0, o'01245', kind=4) z2 = cmplx(5.0, o'01245', kind=4)
if (r2 /= 13107.0) stop '1' if (r2 /= 13107.0) call abort()
if (r /= 1.83668190E-41) stop '2' if (r /= 1.83668190E-41) call abort()
if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
end subroutine test4 end subroutine test4
subroutine test8 subroutine test8
real(8),parameter :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8) 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 :: 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) :: 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) :: 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 (r2c /= 1099511575347.0d0) call abort()
if (rc /= -3.72356884822177915d-103) stop '2' if (rc /= -3.72356884822177915d-103) call abort()
if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) stop '4' if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) call abort()
if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) stop '5' if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) call abort()
if (r2 /= 1099511575347.0d0) stop '1' if (r2 /= 1099511575347.0d0) call abort()
if (r /= -3.72356884822177915d-103) stop '2' if (r /= -3.72356884822177915d-103) call abort()
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
r2 = real(int(z'FFFFFF3333',kind=8),kind=8) 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) 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 (r2 /= 1099511575347.0d0) call abort()
if (r /= -3.72356884822177915d-103) stop '2' if (r /= -3.72356884822177915d-103) call abort()
if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) stop '4' if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) stop '5' if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
end subroutine test8 end subroutine test8
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment