* io.c (check_io_constraints): Don't look at

	dt->advance->value.charater.string, unless it is a CHARACTER
	constant.

	* gfortran.dg/advance_2.f90: New test.
	* gfortran.dg/advance_3.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112417 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b6e4cae..6d19805 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,9 @@
 2006-03-27  Jakub Jelinek  <jakub@redhat.com>
 
+       * io.c (check_io_constraints): Don't look at
+       dt->advance->value.charater.string, unless it is a CHARACTER
+       constant.
+
        * f95-lang.c (gfc_get_alias_set): New function.
        (LANG_HOOKS_GET_ALIAS_SET): Define.
 

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index b45e983..30344d9 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2317,30 +2317,34 @@ if (condition) \
 
   if (dt->advance)
     {
-      const char * advance;
       int not_yes, not_no;
       expr = dt->advance;
-      advance = expr->value.character.string;
 
       io_constraint (dt->format_label == &format_asterisk,
                     "List directed format(*) is not allowed with a "
                     "ADVANCE=specifier at %L.", &expr->where);
 
-      not_no = strncasecmp (advance, "no", 2) != 0;
-      not_yes = strncasecmp (advance, "yes", 2) != 0;
+      if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
+       {
+         const char * advance = expr->value.character.string;
+         not_no = strncasecmp (advance, "no", 2) != 0;
+         not_yes = strncasecmp (advance, "yes", 2) != 0;
+       }
+      else
+       {
+         not_no = 0;
+         not_yes = 0;
+       }
 
-      io_constraint (expr->expr_type == EXPR_CONSTANT
-                      && not_no && not_yes,
+      io_constraint (not_no && not_yes,
                     "ADVANCE=specifier at %L must have value = "
                     "YES or NO.", &expr->where);
 
-      io_constraint (dt->size && expr->expr_type == EXPR_CONSTANT
-                      && not_no && k == M_READ,
+      io_constraint (dt->size && not_no && k == M_READ,
                     "SIZE tag at %L requires an ADVANCE = 'NO'",
                     &dt->size->where);
 
-      io_constraint (dt->eor && expr->expr_type == EXPR_CONSTANT 
-                      && not_no && k == M_READ,
+      io_constraint (dt->eor && not_no && k == M_READ,
                     "EOR tag at %L requires an ADVANCE = 'NO'",
                     &dt->eor_where);      
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2358532..e1139be 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,8 @@
 2006-03-27  Jakub Jelinek  <jakub@redhat.com>
 
+       * gfortran.dg/advance_2.f90: New test.
+       * gfortran.dg/advance_3.f90: New test.
+
        * gfortran.fortran-torture/execute/equiv_5.f: New test.
 
 2006-03-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

diff --git a/gcc/testsuite/gfortran.dg/advance_2.f90 b/gcc/testsuite/gfortran.dg/advance_2.f90
new file mode 100644 (file)
index 0000000..1e83aae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+subroutine foo
+  character(len=5) :: a
+  a = "yes"
+  write(*, '(a)', advance=a) "hello world"
+end subroutine foo

diff --git a/gcc/testsuite/gfortran.dg/advance_3.f90 b/gcc/testsuite/gfortran.dg/advance_3.f90
new file mode 100644 (file)
index 0000000..49b1755
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_3.f90
@@ -0,0 +1,8 @@
+subroutine foo
+  real :: a
+  a = 1
+  write(*, '(a)', advance=a) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine foo
+subroutine bar
+  write(*, '(a)', advance=5.) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine bar