diff options
| author | Jakub Jelinek <jakub@redhat.com> | 2006-03-27 14:32:51 +0200 |
|---|---|---|
| committer | Jakub Jelinek <jakub@gcc.gnu.org> | 2006-03-27 14:32:51 +0200 |
| commit | 8370d5bcb1e3a2fd2445bbc8ee7db50d199e3ad1 (patch) | |
| tree | 615542d5e9e2f86f74f8ed1582839fc780eeb790 /gcc | |
| parent | 7b9c708f1527051df149a21318aff0b6ba531fa8 (diff) | |
| download | gcc-8370d5bcb1e3a2fd2445bbc8ee7db50d199e3ad1.zip gcc-8370d5bcb1e3a2fd2445bbc8ee7db50d199e3ad1.tar.gz gcc-8370d5bcb1e3a2fd2445bbc8ee7db50d199e3ad1.tar.bz2 | |
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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 24 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/advance_2.f90 | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/advance_3.f90 | 8 |
5 files changed, 35 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b6e4cae..6d19805 100644 --- 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 b45e983a..30344d9 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 2358532..e1139be 100644 --- 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 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 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 |