From: Tobias Burnus <burnus@net-b.de>
Date: Sun, 6 Apr 2008 15:38:33 +0000 (+0200)
Subject: io.c (check_io_constraints): Add constrains.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=fbe88ffa1600321d5d83d0aa4797192665822289;p=gcc.git

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 d7cfedb47c0..49c8a0c32d3 100644
--- 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 917acc3443e..034039f87e0 100644
--- 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 9fc756e0128..528bafabc02 100644
--- 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 0f8bebdded2..6ec14aa053f 100644
--- 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
index 00000000000..2362697c6bb
--- /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