io.c (check_io_constraints): Add constrains.

2008-04-06  Tobias Burnus  <burnus@net-b.de>

        * io.c (check_io_constraints): Add constrains. ID= requires
        asynchronous= and asynchronous= must be init expression.

2008-04-06  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/f2003_io_1.f03: Make standard conform.
        * gfortran.dg/f2003_io_8.f03: New.

From-SVN: r133962

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d7cfedb47c0c3059b272e59c2fd028e4284729df..49c8a0c32d37d738177b1afff8d565f71b57ded9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2008-04-06  Tobias Burnus  <burnus@net-b.de>
+
+       * io.c (check_io_constraints): Add constrains. ID= requires
+       asynchronous= and asynchronous= must be init expression.
+
 2008-04-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * f95-lang.c: Set LANG_HOOKS_NAME to "GNU Fortran".

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 917acc3443e9a572038daeb127c3b3e12e00f1b0..034039f87e094beb7d424d9f4897fe59c8cd874e 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2866,10 +2866,17 @@ if (condition) \
                     &dt->eor_where);
     }
 
-  if (dt->asynchronous && dt->asynchronous->expr_type == EXPR_CONSTANT)
+  if (dt->asynchronous) 
     {
       static const char * asynchronous[] = { "YES", "NO", NULL };
 
+      if (dt->asynchronous->expr_type != EXPR_CONSTANT)
+       {
+         gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization "
+                    "expression", &dt->asynchronous->where);
+         return MATCH_ERROR;
+       }
+
       if (!compare_to_allowed_values
                ("ASYNCHRONOUS", asynchronous, NULL, NULL,
                 dt->asynchronous->value.character.string,
@@ -2879,8 +2886,8 @@ if (condition) \
 
   if (dt->id)
     {
-      io_constraint (dt->asynchronous
-                    && strcmp (dt->asynchronous->value.character.string,
+      io_constraint (!dt->asynchronous
+                    || strcmp (dt->asynchronous->value.character.string,
                                 "yes"),
                     "ID=specifier at %L must be with ASYNCHRONOUS='yes' "
                     "specifier", &dt->id->where);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9fc756e01284d29bebd16693b93c41ade66ac1e9..528bafabc02d8c8d6188d666efe8bfa279f4e790 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-04-06  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/f2003_io_1.f03: Make standard conform.
+       * gfortran.dg/f2003_io_8.f03: New.
+
 2008-04-06  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/pack5.adb: New test.

diff --git a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 b/gcc/testsuite/gfortran.dg/f2003_io_1.f03
index 0f8bebdded24b4fa49a65b7238231d57fc61ca79..6ec14aa053fd5ae88d5bd0e483136dae3933f56b 100644 (file)
--- a/gcc/testsuite/gfortran.dg/f2003_io_1.f03
+++ b/gcc/testsuite/gfortran.dg/f2003_io_1.f03
@@ -10,7 +10,7 @@ a = 23.45
 b = 0.0
 open(10, file='mydata', asynchronous="yes", blank="null")
 
-write(10,'(10f8.3)',  decimal="comma", id=j) a
+write(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=j) a
 rewind(10)
 read(10,'(10f8.3)', asynchronous="yes", decimal="comma", blank="zero") b
 if (any(b.ne.23.45)) call abort

diff --git a/gcc/testsuite/gfortran.dg/f2003_io_8.f03 b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
new file mode 100644 (file)
index 0000000..2362697
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+real :: a(4), b(4)
+real :: c
+integer :: istat, j
+character(25) :: msg
+
+open(10, file='mydata', asynchronous="yes", blank="null")
+write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" }
+read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" }
+read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "must be an initialization expression" }
+end