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!
2011-12-04 Tobias Burnus <bur...@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 <bur...@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
