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

login
register
mail settings
Submitter Tobias Burnus
Date Dec. 4, 2011, 5:46 p.m.
Message ID <4EDBB1EC.8050408@net-b.de>
Download mbox | patch
Permalink /patch/129176/
State New
Headers show

Comments

Tobias Burnus - Dec. 4, 2011, 5:46 p.m.
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!
Tobias Burnus - Dec. 7, 2011, 1:54 p.m.
* 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.
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

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