re PR fortran/34342 (BOZ extensions not diagnosed as such with -std=f95)

2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.texi (BOZ literal constants): Improve documentation
        and adapt for BOZ changes.
        * Make-lang.ini (resolve.o): Add target-memory.h dependency.
        * gfortran.h (gfc_expr): Add is_boz flag.
        * expr.c: Include target-memory.h.
        (gfc_check_assign): Support transferring BOZ for real/cmlx.
        * resolve.c: Include target-memory.h
        (resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
        * target-memory.c (gfc_convert_boz): New function.
        * target-memory.c (gfc_convert_boz): Add prototype.
        * primary.c (match_boz_constant): Set is_boz, enable F95 error
        also without -pedantic, and allow for Fortran 2003 BOZ.
        (match_real_constant): Fix comment.
        * simplify.c
        * (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
        gfc_simplify_real): Support Fortran 2003 BOZ.

2007-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34342
        PR fortran/34345
        PR fortran/18026
        PR fortran/29471

        * gfortran.dg/boz_8.f90: New.
        * gfortran.dg/boz_9.f90: New.
        * gfortran.dg/boz_10.f90: New.
        * gfortran.dg/boz_7.f90: Update dg-warning.
        * gfortran.dg/pr16433.f: Add dg-error.
        * gfortan.dg/ibits.f90: Update dg-warning.
        * gfortran.dg/unf_io_convert_1.f90: Update/delete dg-warning.
        * gfortran.dg/unf_io_convert_2.f90: Ditto.

From-SVN: r130713

10 files changed, 217 insertions, 32 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 25717b1..290005f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,26 @@
+2007-12-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34342
+	PR fortran/34345
+	PR fortran/18026
+	PR fortran/29471
+
+	* gfortran.texi (BOZ literal constants): Improve documentation
+	and adapt for BOZ changes.
+	* Make-lang.ini (resolve.o): Add target-memory.h dependency.
+	* gfortran.h (gfc_expr): Add is_boz flag.
+	* expr.c: Include target-memory.h.
+	(gfc_check_assign): Support transferring BOZ for real/cmlx.
+	* resolve.c: Include target-memory.h
+	(resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
+	* target-memory.c (gfc_convert_boz): New function.
+	* target-memory.c (gfc_convert_boz): Add prototype.
+	* primary.c (match_boz_constant): Set is_boz, enable F95 error
+	also without -pedantic, and allow for Fortran 2003 BOZ.
+	(match_real_constant): Fix comment.
+	* simplify.c (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
+	gfc_simplify_real): Support Fortran 2003 BOZ.
+
 2007-12-08  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/34359
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 16d4d35..0f5d032 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -324,6 +324,6 @@ fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
   gt-fortran-trans-intrinsic.h
 fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H)
-fortran/resolve.o: fortran/dependency.h fortran/data.h
+fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h
 fortran/data.o: fortran/data.h
 fortran/options.o: $(PARAMS_H) $(TARGET_H)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index e33d97a..1242e5e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -24,6 +24,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "arith.h"
 #include "match.h"
+#include "target-memory.h" /* for gfc_convert_boz */
 
 /* Get a new expr node.  */
 
@@ -2723,6 +2724,29 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
       && gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS)
     return FAILURE;
 
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
+      && lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L used to "
+                         "initialize non-integer variable '%s'",
+			 &rvalue->where, lvalue->symtree->n.sym->name)
+	 == FAILURE)
+    return FAILURE;
+  else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+			 "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+			 &rvalue->where) == FAILURE)
+    return FAILURE;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER)
+    {
+      if (gfc_option.warn_surprising)
+        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_compare_types (&lvalue->ts, &rvalue->ts))
     return SUCCESS;
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 07dbe92..1045338 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1430,7 +1430,7 @@ typedef struct gfc_expr
 
   /* True if the expression is a call to a function that returns an array,
      and if we have decided not to allocate temporary data for that array.  */
-  unsigned int inline_noncopying_intrinsic : 1;
+  unsigned int inline_noncopying_intrinsic : 1, is_boz : 1;
 
   /* Used to quickly find a given constructor by its offset.  */
   splay_tree con_by_offset;
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 095517d..84795fb 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -862,6 +862,9 @@ Renaming of operators in the @code{USE} statement.
 @cindex ISO C Bindings
 Interoperability with C (ISO C Bindings)
 
+@item
+BOZ as argument of INT, REAL, DBLE and CMPLX.
+
 @end itemize
 
 
@@ -1084,26 +1087,45 @@ of the @code{READ} statement, and the output item lists of the
 @section BOZ literal constants
 @cindex BOZ literal constants
 
+Besides decimal constants, Fortran also supports binary (@code{b}),
+octal (@code{o}) and hexadecimal (@code{z}) integer constants. The
+syntax is: @samp{prefix quote digits quote}, were the prefix is
+either @code{b}, @code{o} or @code{z}, quote is either @code{'} or
+@code{"} and the digits are for binary @code{0} or @code{1}, for
+octal between @code{0} and @code{7}, and for hexadecimal between
+@code{0} and @code{F}. (Example: @code{b'01011101'}.)
+
+Up to Fortran 95, BOZ literals were only allowed to initialize
+integer variables in DATA statements. Since Fortran 2003 BOZ literals
+are also allowed as argument of @code{REAL}, @code{DBLE}, @code{INT}
+and @code{CMPLX}; the result is the same as if the integer BOZ
+literal had been converted by @code{TRANSFER} to, respectively,
+@code{real}, @code{double precision}, @code{integer} or @code{complex}.
+The GNU Fortran intrinsic procedure @code{FLOAT}, @code{DFLOAT},
+@code{COMPLEX} and @code{DCMPLX} are treated alike.
+
 As an extension, GNU Fortran allows hexadecimal BOZ literal constants to
-be specified using the X prefix, in addition to the standard Z prefix.
-BOZ literal constants can also be specified by adding a suffix to the
-string. For example, @code{Z'ABC'} and @code{'ABC'Z} are equivalent.
-
-The Fortran standard restricts the appearance of a BOZ literal constant
-to the @code{DATA} statement, and it is expected to be assigned to an
-@code{INTEGER} variable.  GNU Fortran permits a BOZ literal to appear in
-any initialization expression as well as assignment statements.
-
-Attempts to use a BOZ literal constant to do a bitwise initialization of
-a variable can lead to confusion.  A BOZ literal constant is converted
-to an @code{INTEGER} value with the kind type with the largest decimal
-representation, and this value is then converted numerically to the type
-and kind of the variable in question.  Thus, one should not expect a
-bitwise copy of the BOZ literal constant to be assigned to a @code{REAL}
-variable.
-
-Similarly, initializing an @code{INTEGER} variable with a statement such
-as @code{DATA i/Z'FFFFFFFF'/} will produce an integer overflow rather
+be specified using the @code{X} prefix, in addition to the standard
+@code{Z} prefix. The BOZ literal can also be specified by adding a
+suffix to the string, for example, @code{Z'ABC'} and @code{'ABC'Z} are
+equivalent.
+
+Furthermore, GNU Fortran allows using BOZ literal constants outside
+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
+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}
+with @code{2.0}.) As different compilers implement the extension
+differently, one should be careful when doing bitwise initialization
+of non-integer variables.
+
+Note that initializing an @code{INTEGER} variable with a statement such
+as @code{DATA i/Z'FFFFFFFF'/} will give an integer overflow error rather
 than the desired result of @math{-1} when @code{i} is a 32-bit integer
 on a system that supports 64-bit integers.  The @samp{-fno-range-check}
 option can be used as a workaround for legacy code that initializes
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 99cdaad..155cfb1 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -349,7 +349,7 @@ match_boz_constant (gfc_expr **result)
   if (delim != '\'' && delim != '\"')
     goto backup;
 
-  if (x_hex && pedantic
+  if (x_hex
       && (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
 			  "constant at %C uses non-standard syntax")
 	  == FAILURE))
@@ -415,6 +415,9 @@ match_boz_constant (gfc_expr **result)
   kind = gfc_max_integer_kind;
   e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
 
+  /* Mark as boz variable.  */
+  e->is_boz = 1;
+
   if (gfc_range_check (e) != ARITH_OK)
     {
       gfc_error ("Integer too big for integer kind %i at %C", kind);
@@ -422,10 +425,8 @@ match_boz_constant (gfc_expr **result)
       return MATCH_ERROR;
     }
 
-  /* FIXME: Fortran 2003 allows BOZ also in REAL(), CMPLX(), INT();
-     see PR18026 and PR29471.  */
   if (!gfc_in_match_data ()
-      && (gfc_notify_std (GFC_STD_GNU, "Extension: BOZ used outside a DATA "
+      && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BOZ used outside a DATA "
 			  "statement at %C")
 	  == FAILURE))
       return MATCH_ERROR;
@@ -440,7 +441,7 @@ backup:
 
 
 /* Match a real constant of some sort.  Allow a signed constant if signflag
-   is nonzero.  Allow integer constants if allow_int is true.  */
+   is nonzero.  */
 
 static match
 match_real_constant (gfc_expr **result, int signflag)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5083b9b..c5b95b4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "arith.h"  /* For gfc_compare_expr().  */
 #include "dependency.h"
 #include "data.h"
+#include "target-memory.h" /* for gfc_simplify_transfer */
 
 /* Types used in equivalence statements.  */
 
@@ -5885,7 +5886,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   int n;
   gfc_ref *ref;
 
-
   if (gfc_extend_assign (code, ns) == SUCCESS)
     {
       lhs = code->ext.actual->expr;
@@ -5912,6 +5912,24 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   lhs = code->expr;
   rhs = code->expr2;
 
+  if (rhs->is_boz
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+                         "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+                         &code->loc) == FAILURE)
+    return false;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
+    {
+      if (gfc_option.warn_surprising)
+	gfc_warning ("BOZ literal at %L is bitwise transferred "
+		     "non-integer symbol '%s'", &code->loc,
+		     lhs->symtree->n.sym->name);
+
+      gfc_convert_boz (rhs, &lhs->ts);
+    }
+
+
   if (lhs->ts.type == BT_CHARACTER
 	&& gfc_option.warn_character_truncation)
     {
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 598ec57..ea807d1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -740,7 +740,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
   switch (x->ts.type)
     {
     case BT_INTEGER:
-      mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
+      if (!x->is_boz)
+	mpfr_set_z (result->value.complex.r, x->value.integer, GFC_RND_MODE);
       break;
 
     case BT_REAL:
@@ -761,7 +762,8 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
       switch (y->ts.type)
 	{
 	case BT_INTEGER:
-	  mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
+	  if (!y->is_boz)
+	    mpfr_set_z (result->value.complex.i, y->value.integer, GFC_RND_MODE);
 	  break;
 
 	case BT_REAL:
@@ -773,6 +775,25 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
 	}
     }
 
+  /* Handle BOZ.  */
+  if (x->is_boz)
+    {
+      gfc_typespec ts;
+      ts.kind = result->ts.kind;
+      ts.type = BT_REAL;
+      gfc_convert_boz (x, &ts);
+      mpfr_set (result->value.complex.r, x->value.real, GFC_RND_MODE);
+    }
+
+  if (y && y->is_boz)
+    {
+      gfc_typespec ts;
+      ts.kind = result->ts.kind;
+      ts.type = BT_REAL;
+      gfc_convert_boz (y, &ts);
+      mpfr_set (result->value.complex.i, y->value.real, GFC_RND_MODE);
+    }
+
   return range_check (result, name);
 }
 
@@ -918,7 +939,8 @@ gfc_simplify_dble (gfc_expr *e)
   switch (e->ts.type)
     {
     case BT_INTEGER:
-      result = gfc_int2real (e, gfc_default_double_kind);
+      if (!e->is_boz)
+	result = gfc_int2real (e, gfc_default_double_kind);
       break;
 
     case BT_REAL:
@@ -933,6 +955,15 @@ gfc_simplify_dble (gfc_expr *e)
       gfc_internal_error ("gfc_simplify_dble(): bad type at %L", &e->where);
     }
 
+  if (e->ts.type == BT_INTEGER && e->is_boz)
+    {
+      gfc_typespec ts;
+      ts.type = BT_REAL;
+      ts.kind = gfc_default_double_kind;
+      result = gfc_copy_expr (e);
+      gfc_convert_boz (result, &ts);
+    }
+
   return range_check (result, "DBLE");
 }
 
@@ -1111,7 +1142,18 @@ gfc_simplify_float (gfc_expr *a)
   if (a->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  result = gfc_int2real (a, gfc_default_real_kind);
+  if (a->is_boz)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_REAL;
+      ts.kind = gfc_default_real_kind;
+
+      result = gfc_copy_expr (a);
+      gfc_convert_boz (result, &ts);
+    }
+  else
+    result = gfc_int2real (a, gfc_default_real_kind);
   return range_check (result, "FLOAT");
 }
 
@@ -2954,7 +2996,8 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
   switch (e->ts.type)
     {
     case BT_INTEGER:
-      result = gfc_int2real (e, kind);
+      if (!e->is_boz)
+	result = gfc_int2real (e, kind);
       break;
 
     case BT_REAL:
@@ -2970,6 +3013,14 @@ gfc_simplify_real (gfc_expr *e, gfc_expr *k)
       /* Not reached */
     }
 
+  if (e->ts.type == BT_INTEGER && e->is_boz)
+    {
+      gfc_typespec ts;
+      ts.type = BT_REAL;
+      ts.kind = kind;
+      result = gfc_copy_expr (e);
+      gfc_convert_boz (result, &ts);
+    }
   return range_check (result, "REAL");
 }
 
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 3686261..92318e2 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -595,3 +595,46 @@ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
 
   return len;
 }
+
+void
+gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
+{
+  size_t buffer_size;
+  unsigned char *buffer;
+
+  if (!expr->is_boz)
+    return;
+
+  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);
+  else if (ts->type == BT_COMPLEX)
+    buffer_size = size_complex (ts->kind);
+  else
+    return;
+
+  buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
+
+  buffer = (unsigned char*)alloca (buffer_size);
+  encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
+  mpz_clear (expr->value.integer);
+
+  if (ts->type == BT_REAL)
+    {
+      mpfr_init (expr->value.real);
+      gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
+    }
+  else
+    {
+      mpfr_init (expr->value.complex.r);
+      mpfr_init (expr->value.complex.i);
+      gfc_interpret_complex (ts->kind, buffer, buffer_size,
+			     expr->value.complex.r, expr->value.complex.i);
+    }
+  expr->is_boz = 0;  
+  expr->ts.type = ts->type;
+  expr->ts.kind = ts->kind;
+}
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 0bb47dd..ac1ba0a 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -24,6 +24,9 @@ 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 *);
+
 /* Return the size of an expression in its target representation.  */
 size_t gfc_target_expr_size (gfc_expr *);