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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131098 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3d1092..4701a2f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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