From 8370d5bcb1e3a2fd2445bbc8ee7db50d199e3ad1 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Mon, 27 Mar 2006 14:32:51 +0200 Subject: [PATCH] io.c (check_io_constraints): Don't look at dt->advance->value.charater.string, unless it is a CHARACTER constant. * 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. From-SVN: r112417 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/io.c | 24 ++++++++++++++---------- gcc/testsuite/ChangeLog | 3 +++ gcc/testsuite/gfortran.dg/advance_2.f90 | 6 ++++++ gcc/testsuite/gfortran.dg/advance_3.f90 | 8 ++++++++ 5 files changed, 35 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/advance_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/advance_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b6e4cae77f4..6d19805ee66 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,9 @@ 2006-03-27 Jakub Jelinek + * 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 b45e983a045..30344d90e74 100644 --- 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 23585329300..e1139be7216 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,8 @@ 2006-03-27 Jakub Jelinek + * 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 diff --git a/gcc/testsuite/gfortran.dg/advance_2.f90 b/gcc/testsuite/gfortran.dg/advance_2.f90 new file mode 100644 index 00000000000..1e83aaee316 --- /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 index 00000000000..49b17556f69 --- /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 -- 2.30.2