This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR34342 - BOZ diagnostic, Fortran 2003 BOZ, BOZ extensions


:ADDPATCH fortran:

This patch adds:

a) Fortran 2003 BOZ, i.e. real(boz), dble(boz),
cmplx(boz,y)/cmplx(x,boz) are treated as if the BOZ had been TRANSFERed.

b) Using BOZ in DATA statements to initialize non-integer variables
gives now an error with -std=f95/f2003

c) Using BOZ in DATA statement for non-integer variables, now TRANSFERs
the bit pattern and does not convert the integer value to be compatible
with several other compilers. (Only for REAL and COMPLEX variables.)

d) Using  "real r = boz" now also TRANSFERs the bit pattern as long as
there is no expression on the right-hand side; i.e. in "real r = boz +
1" the boz is regarded as integer. (For expressions with BOZ, different
compilers behave quite differently.)

e) Improve the BOZ documentation by (1) telling more about BOZ and (2)
by making clear how gfortran extends the standard syntax.

If anyone has an idea how to reject with -f2003 BOZ of the following
type I'd be happy:
   r = z'1234' + 1.0

Build and regression tested on x86-64-linux.
OK for the trunk?

Tobias

PS: I plan to compile/test a couple of applications to make sure we do
not regress.

PPS: boz_9.f90 will fail with -fdefault-integer-8/-fdefault-real-8. Has
anyone an idea how to fix it w/o specifying a kind= parameter for int,
real, cmplx (the kind parameter causes a different code path) and
without breaking dble?

PPPS: I just saw that there is now no range check for:
  DOUBLE PRECISION inf
  DATA inf / Z'7FF0000000000000' /
Please state whether it should be added.

2007-12-06  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-06  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.

Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi	(revision 130648)
+++ gcc/fortran/gfortran.texi	(working copy)
@@ -1084,26 +1084,43 @@ of the @code{READ} statement, and the ou
 @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{CMPL}; 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}.
+
 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.
+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 to use 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 kind type with
+the largest decimal representation, and 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.
 
-Similarly, initializing an @code{INTEGER} variable with a statement such
-as @code{DATA i/Z'FFFFFFFF'/} will produce an integer overflow rather
+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
Index: gcc/fortran/Make-lang.in
===================================================================
--- gcc/fortran/Make-lang.in	(revision 130648)
+++ gcc/fortran/Make-lang.in	(working copy)
@@ -324,6 +324,6 @@ fortran/trans-intrinsic.o: $(GFORTRAN_TR
   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)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 130648)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -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;
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 130648)
+++ gcc/fortran/expr.c	(working copy)
@@ -24,6 +24,7 @@ along with GCC; see the file COPYING3.  
 #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_
       && 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;
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 130648)
+++ gcc/fortran/resolve.c	(working copy)
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3.  
 #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,
   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,
   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)
     {
Index: gcc/fortran/target-memory.c
===================================================================
--- gcc/fortran/target-memory.c	(revision 130648)
+++ gcc/fortran/target-memory.c	(working copy)
@@ -595,3 +595,46 @@ gfc_merge_initializers (gfc_typespec ts,
 
   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;
+}
Index: gcc/fortran/target-memory.h
===================================================================
--- gcc/fortran/target-memory.h	(revision 130648)
+++ gcc/fortran/target-memory.h	(working copy)
@@ -24,6 +24,9 @@ along with GCC; see the file COPYING3.  
 
 #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 *);
 
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 130648)
+++ gcc/fortran/primary.c	(working copy)
@@ -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)
Index: gcc/fortran/simplify.c
===================================================================
--- gcc/fortran/simplify.c	(revision 130648)
+++ gcc/fortran/simplify.c	(working copy)
@@ -740,7 +740,8 @@ simplify_cmplx (const char *name, gfc_ex
   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_ex
       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_ex
 	}
     }
 
+  /* 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
   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
       /* 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");
 }
 
Index: gcc/testsuite/gfortran.dg/pr16433.f
===================================================================
--- gcc/testsuite/gfortran.dg/pr16433.f	(revision 130644)
+++ gcc/testsuite/gfortran.dg/pr16433.f	(working copy)
@@ -1,6 +1,6 @@
 ! { dg-do compile }
       real x
       double precision dx
-      data x/x'2ffde'/ ! { dg-warning "exadecimal constant" "Hex constant can't begin with x" }
+      data x/x'2ffde'/ ! { dg-warning "Hexadecimal constant | used to initialize non-integer" } 
       dx = x  ! { dg-bogus "exadecimal constant" "Hex constant where there is none" }
       end
Index: gcc/testsuite/gfortran.dg/ibits.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ibits.f90	(revision 130644)
+++ gcc/testsuite/gfortran.dg/ibits.f90	(working copy)
@@ -2,7 +2,7 @@
 ! Test that the mask is properly converted to the kind type of j in ibits.
 program ibits_test
   implicit none
-  integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ used outside a DATA statement" }
+  integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
   integer(8) i,j,k,m
   j = 1
   do i=1,70
Index: gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unf_io_convert_1.f90	(revision 130644)
+++ gcc/testsuite/gfortran.dg/unf_io_convert_1.f90	(working copy)
@@ -18,9 +18,9 @@ program main
   integer i
   character*4 str
 
-  m(1) = Z'11223344' ! { dg-warning "BOZ used outside a DATA statement" }
-  m(2) = Z'55667788' ! { dg-warning "BOZ used outside a DATA statement" }
-  n    = Z'77AABBCC' ! { dg-warning "BOZ used outside a DATA statement" }
+  m(1) = Z'11223344' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  m(2) = Z'55667788' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  n    = Z'77AABBCC' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
   str = 'asdf'
   do i = 1,size
      r(i) = i
@@ -46,7 +46,7 @@ program main
   read(9) str
   !
   ! check results
-  if (m(1).ne.Z'11223344') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (m(1).ne.Z'11223344') then
      if (debug) then
         print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
      else
@@ -54,7 +54,7 @@ program main
      endif
   endif
   
-  if (m(2).ne.Z'55667788') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (m(2).ne.Z'55667788') then
      if (debug) then
         print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
      else
@@ -62,7 +62,7 @@ program main
      endif
   endif
   
-  if (n.ne.Z'77AABBCC') then ! { dg-warning "BOZ used outside a DATA statement" }
+  if (n.ne.Z'77AABBCC') then
      if (debug) then
         print '(A,Z8)','n incorrect.  n = ',n
      else
Index: gcc/testsuite/gfortran.dg/boz_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_7.f90	(revision 130644)
+++ gcc/testsuite/gfortran.dg/boz_7.f90	(working copy)
@@ -6,7 +6,7 @@
 ! Some BOZ extensions where not diagnosed
 !
 integer :: k, m
-integer :: j = z'000abc' ! { dg-error "Extension: BOZ used outside a DATA statement" }
+integer :: j = z'000abc' ! { dg-error "BOZ used outside a DATA statement" }
 data k/x'0003'/ ! { dg-error "uses non-standard syntax" }
 data m/'0003'z/ ! { dg-error "uses non-standard postfix syntax" }
 end
Index: gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unf_io_convert_2.f90	(revision 130644)
+++ gcc/testsuite/gfortran.dg/unf_io_convert_2.f90	(working copy)
@@ -15,26 +15,26 @@ program main
   close(10,status="delete")
 
   open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
-  i = (/ Z'11223344', Z'55667700' /) ! { dg-warning "BOZ used outside a DATA statement" }
+  i = (/ Z'11223344', Z'55667700' /)
   write (10) i
   rewind (10)
   read (10) b
-  if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
+  if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) &
     call abort
   backspace 10
   read (10) j
-  if (j /= Z'1122334455667700') call abort ! { dg-warning "BOZ used outside a DATA statement" }
+  if (j /= Z'1122334455667700') call abort
   close (10, status="delete")
 
   open (10, form="unformatted", convert="little_endian") ! { dg-warning "Extension: CONVERT" }
   write (10) i
   rewind (10)
   read (10) b
-  if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) & ! { dg-warning "BOZ used outside a DATA statement" }
+  if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) &
     call abort
   backspace 10
   read (10) j
-  if (j /= Z'5566770011223344') call abort ! { dg-warning "BOZ used outside a DATA statement" }
+  if (j /= Z'5566770011223344') call abort
   close (10, status="delete")
 
 end program main
Index: gcc/testsuite/gfortran.dg/boz_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_8.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/boz_8.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. Cf. Fortran 2003, 5.2.5 DATA statement:
+! "If a data-stmt-constant is a boz-literal-constant, the
+!  corresponding variable shall be of type integer."
+!
+real :: r
+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" }
+end
Index: gcc/testsuite/gfortran.dg/boz_10.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_10.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/boz_10.f90	(revision 0)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. And outside DATA statements.
+!
+real :: r
+integer :: i
+r = real(z'FFFF') ! { dg-error "outside a DATA statement" }
+i = int(z'4455')  ! { dg-error "outside a DATA statement" }
+r = z'FFFF' + 1.0 ! { dg-error "outside a DATA statement" }
+i = z'4455' + 1   ! { dg-error "outside a DATA statement" }
+end
Index: gcc/testsuite/gfortran.dg/boz_9.f90
===================================================================
--- gcc/testsuite/gfortran.dg/boz_9.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/boz_9.f90	(revision 0)
@@ -0,0 +1,118 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+!
+! PR fortran/34342
+!
+! Test for Fortran 2003 BOZ.
+!
+program f2003
+implicit none
+
+real,parameter             :: r2c = real(int(z'3333'))
+real,parameter             :: rc  = real(z'3333')
+double precision,parameter :: dc  = dble(Z'3FD34413509F79FF')
+complex,parameter          :: z1c = cmplx(b'10101',-4.0)
+complex,parameter          :: z2c = cmplx(5.0, o'01245')
+
+real             :: r2 = real(int(z'3333'))
+real             :: r  = real(z'3333')
+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'
+
+r2 = dble(int(z'3333'))
+r = real(z'3333')
+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'
+
+call test4()
+call test8()
+
+contains
+
+subroutine test4
+real,parameter             :: r2c = real(int(z'3333', kind=4), kind=4)
+real,parameter             :: rc  = real(z'3333', kind=4)
+complex,parameter          :: z1c = cmplx(b'10101',-4.0, kind=4)
+complex,parameter          :: z2c = cmplx(5.0, o'01245', kind=4)
+
+real             :: r2 = real(int(z'3333', kind=4), kind=4)
+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 (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'
+
+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'
+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)
+complex(8),parameter  :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8),parameter  :: z2c = cmplx(5.0, o'444444444442222222222233301245', kind=8)
+
+real(8)             :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+real(8)             :: r  = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
+complex(8)          :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8)          :: z2 = cmplx(5.0, o'444444444442222222222233301245', 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 (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'
+
+r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+r  = real(z'AAAAAAAAAAAAAAAAFFFFFFF3333', kind=8)
+z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+z2 = cmplx(5.0, o'444444444442222222222233301245', 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'
+
+end subroutine test8
+
+end program f2003

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]