diff mbox

[Fortran] PR51407 - allow BOZ edit descriptors for REAL/COMPLEX

Message ID 4EDBB1EC.8050408@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Dec. 4, 2011, 5:46 p.m. UTC 
Hi all,

as Dominique has found, Fortran 2008 allows the BOZ edit descriptors now 
also with REAL and COMPLEX arguments. (See PR for quotes from the standard.)

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

Tobias

PS: Thank you, Mikael, for reviewing my ASSOCIATE patch!

Comments

Tobias Burnus Dec. 7, 2011, 1:54 p.m. UTC | #1 
* ping * ?

On 12/04/2011 06:46 PM, Tobias Burnus wrote:
> Hi all,
>
> as Dominique has found, Fortran 2008 allows the BOZ edit descriptors 
> now also with REAL and COMPLEX arguments. (See PR for quotes from the 
> standard.)
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
>
> PS: Thank you, Mikael, for reviewing my ASSOCIATE patch!
Mikael Morin Dec. 7, 2011, 7:54 p.m. UTC | #2 
On Wednesday 07 December 2011 14:54:36 Tobias Burnus wrote:
> * ping * ?
> 
> On 12/04/2011 06:46 PM, Tobias Burnus wrote:
> > Hi all,
> > 
> > as Dominique has found, Fortran 2008 allows the BOZ edit descriptors
> > now also with REAL and COMPLEX arguments. (See PR for quotes from the
> > standard.)
> > 
> > Build and regtested on x86-64-linux.
> > OK for the trunk?
> > 
OK.

Mikael
diff mbox

Patch

2011-12-04  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51407
	* io/transfer.c (require_numeric_type): New function.
	(formatted_transfer_scalar_read, formatted_transfer_scalar_write):
	Use it, allow BOZ edit descriptors with F2008.

2011-12-04  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51407
	* gfortran.dg/io_real_boz_3.f90: New.
	* gfortran.dg/io_real_boz_4.f90: New.
	* gfortran.dg/io_real_boz_5.f90: New.

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 976102f..f71e96f 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1063,6 +1063,25 @@  require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f)
 }
 
 
+static int
+require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f)
+{
+#define BUFLEN 100
+  char buffer[BUFLEN];
+
+  if (actual == BT_INTEGER || actual == BT_REAL || actual == BT_COMPLEX)
+    return 0;
+
+  /* Adjust item_count before emitting error message.  */
+  snprintf (buffer, BUFLEN, 
+	    "Expected numeric type for item %d in formatted transfer, got %s",
+	    dtp->u.p.item_count - 1, type_name (actual));
+
+  format_error (dtp, f, buffer);
+  return 1;
+}
+
+
 /* This function is in the main loop for a formatted data transfer
    statement.  It would be natural to implement this as a coroutine
    with the user program, but C makes that awkward.  We loop,
@@ -1147,6 +1166,9 @@  formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	  if (n == 0)
 	    goto need_read_data;
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  read_radix (dtp, f, p, kind, 2);
@@ -1156,6 +1178,9 @@  formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	  if (n == 0)
 	    goto need_read_data; 
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  read_radix (dtp, f, p, kind, 8);
@@ -1165,6 +1190,9 @@  formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	  if (n == 0)
 	    goto need_read_data;
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  read_radix (dtp, f, p, kind, 16);
@@ -1548,6 +1576,9 @@  formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	  if (n == 0)
 	    goto need_data;
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  write_b (dtp, f, p, kind);
@@ -1557,6 +1588,9 @@  formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	  if (n == 0)
 	    goto need_data; 
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  write_o (dtp, f, p, kind);
@@ -1566,6 +1600,9 @@  formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	  if (n == 0)
 	    goto need_data;
 	  if (!(compile_options.allow_std & GFC_STD_GNU)
+	      && require_numeric_type (dtp, type, f))
+	    return;
+	  if (!(compile_options.allow_std & GFC_STD_F2008)
               && require_type (dtp, BT_INTEGER, type, f))
 	    return;
 	  write_z (dtp, f, p, kind);
--- /dev/null	2011-12-04 08:20:24.719594993 +0100
+++ gcc/gcc/testsuite/gfortran.dg/io_real_boz_3.f90	2011-12-04 17:18:46.000000000 +0100
@@ -0,0 +1,34 @@ 
+! { dg-do  run }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/51407
+!
+! Fortran 2008 allows BOZ edit descriptors for real/complex.
+!
+       real(kind=4) :: x
+       complex(kind=4) :: z
+       character(len=64) :: str1
+
+       x = 1.0_16 + 2.0_16**(-105)
+       z = cmplx (1.0, 2.0)
+
+       write (str1,'(b32)') x
+       read (str1,'(b32)') x
+       write (str1,'(o32)') x
+       read (str1,'(o32)') x
+       write (str1,'(z32)') x
+       read (str1,'(z32)') x
+       write (str1,'(b0)') x
+       write (str1,'(o0)') x
+       write (str1,'(z0)') x
+
+       write (str1,'(2b32)') z
+       read (str1,'(2b32)') z
+       write (str1,'(2o32)') z
+       read (str1,'(2o32)') z
+       write (str1,'(2z32)') z
+       read (str1,'(2z32)') z
+       write (str1,'(2b0)') z
+       write (str1,'(2o0)') z
+       write (str1,'(2z0)') z
+       end
--- /dev/null	2011-12-04 08:20:24.719594993 +0100
+++ gcc/gcc/testsuite/gfortran.dg/io_real_boz_4.f90	2011-12-04 17:22:10.000000000 +0100
@@ -0,0 +1,15 @@ 
+! { dg-do  run }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/51407
+!
+! Valid in F2008, but in F95/F2003:
+! { dg-output "Expected INTEGER for item 1 in formatted transfer, got REAL" }
+! { dg-shouldfail "Only F2003: BOZ edit with REAL" }
+!
+       real(kind=16) :: x
+       character(len=32) :: str1
+       x = 1.0_16 + 2.0_16**(-105)
+       write (str1,'(z32)') x
+       write (str1,'(z0)') x
+       end
--- /dev/null	2011-12-04 08:20:24.719594993 +0100
+++ gcc/gcc/testsuite/gfortran.dg/io_real_boz_5.f90	2011-12-04 17:22:31.000000000 +0100
@@ -0,0 +1,13 @@ 
+! { dg-do  run }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/51407
+!
+! Invalid in F2008 (accepted with -std=gnu)
+! { dg-output "Expected numeric type for item 1 in formatted transfer, got CHARACTER" }
+! { dg-shouldfail "Character type in BOZ" }
+!
+       character(len=32) :: str1
+       x = 1.0_16 + 2.0_16**(-105)
+       write (str1,'(z0)') 'X'
+       end