aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog13
-rw-r--r--gcc/fortran/expr.c3
-rw-r--r--gcc/fortran/gfortran.texi5
-rw-r--r--gcc/fortran/resolve.c3
-rw-r--r--gcc/fortran/simplify.c15
-rw-r--r--gcc/fortran/target-memory.c42
-rw-r--r--gcc/fortran/target-memory.h2
-rw-r--r--gcc/testsuite/ChangeLog7
-rw-r--r--gcc/testsuite/gfortran.dg/boz_8.f901
-rw-r--r--gcc/testsuite/gfortran.dg/boz_9.f9092
10 files changed, 121 insertions, 62 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3d1092..4701a2f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 4e77605..8ae8464 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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)
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 9fda225..43e3d3a 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -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}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 57c17dc..6289d5d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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)
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index abcff3c..be0b18f 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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");
}
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 92318e2..7625877 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -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;
}
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index ac1ba0a..a693563 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -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 *);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 38a492e..231375b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gfortran.dg/boz_8.f90 b/gcc/testsuite/gfortran.dg/boz_8.f90
index 25e02a8..effce2d 100644
--- a/gcc/testsuite/gfortran.dg/boz_8.f90
+++ b/gcc/testsuite/gfortran.dg/boz_8.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/boz_9.f90 b/gcc/testsuite/gfortran.dg/boz_9.f90
index e9bb79e..e1b0592 100644
--- a/gcc/testsuite/gfortran.dg/boz_9.f90
+++ b/gcc/testsuite/gfortran.dg/boz_9.f90
@@ -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 (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 (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) 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
generated by cgit v1.1 at 2025-06-01 23:52:17 +0000