From e713bf6dd99b59d450c790b1e7494462a17b459e Mon Sep 17 00:00:00 2001 From: tobi Date: Sun, 4 Sep 2005 12:08:53 +0000 Subject: [PATCH] fortran/ PR fortran/23661 * io.c (match_io): Correctly backup if PRINT followed by symbol which is not a namelist. Force blank between PRINT and namelist in free form. testsuite/ PR fortran/23661 * gfortran.dg/print_fmt_1.f90, gfortran.dg/print_fmt_2.f90 gfortran.dg/print_fmt_3.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103824 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++ gcc/fortran/io.c | 50 +++++++++++++++++-------------- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/print_fmt_1.f90 | 7 +++++ gcc/testsuite/gfortran.dg/print_fmt_2.f90 | 11 +++++++ gcc/testsuite/gfortran.dg/print_fmt_3.f | 11 +++++++ 6 files changed, 70 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/print_fmt_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/print_fmt_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/print_fmt_3.f diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a03d3df..e88f468 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-09-04 Tobias Schl"uter + + PR fortran/23661 + * io.c (match_io): Correctly backup if PRINT followed by + symbol which is not a namelist. Force blank between PRINT + and namelist in free form. + 2005-08-31 Francois-Xavier Coudert PR fortran/20592 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 5b27ead..37a7493 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -2133,33 +2133,39 @@ match_io (io_kind k) if (gfc_match_char ('(') == MATCH_NO) { - /* Treat the non-standard case of PRINT namelist. */ - if (k == M_PRINT && (gfc_match_name (name) == MATCH_YES) - && !gfc_find_symbol (name, NULL, 1, &sym) - && (sym->attr.flavor == FL_NAMELIST)) + if (k == M_WRITE) + goto syntax; + else if (k == M_PRINT + && (gfc_current_form == FORM_FIXED + || gfc_peek_char () == ' ')) { - if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " - "%C is an extension") == FAILURE) - { - m = MATCH_ERROR; - goto cleanup; - } - if (gfc_match_eos () == MATCH_NO) + /* Treat the non-standard case of PRINT namelist. */ + where = gfc_current_locus; + if ((gfc_match_name (name) == MATCH_YES) + && !gfc_find_symbol (name, NULL, 1, &sym) + && sym->attr.flavor == FL_NAMELIST) { - gfc_error ("Namelist followed by I/O list at %C"); - m = MATCH_ERROR; - goto cleanup; - } + if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at " + "%C is an extension") == FAILURE) + { + m = MATCH_ERROR; + goto cleanup; + } + if (gfc_match_eos () == MATCH_NO) + { + gfc_error ("Namelist followed by I/O list at %C"); + m = MATCH_ERROR; + goto cleanup; + } - dt->io_unit = default_unit (k); - dt->namelist = sym; - goto get_io_list; + dt->io_unit = default_unit (k); + dt->namelist = sym; + goto get_io_list; + } + else + gfc_current_locus = where; } - - if (k == M_WRITE) - goto syntax; - if (gfc_current_form == FORM_FREE) { c = gfc_peek_char(); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 17b5b03..c849daa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2005-09-04 Tobias Schl"uter + + PR fortran/23661 + * gfortran.dg/print_fmt_1.f90, gfortran.dg/print_fmt_2.f90 + gfortran.dg/print_fmt_3.f90: New test. + 2005-09-03 Jakub Jelinek * gfortran.dg/fmt_t_1.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/print_fmt_1.f90 b/gcc/testsuite/gfortran.dg/print_fmt_1.f90 new file mode 100644 index 0000000..f7622b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/print_fmt_1.f90 @@ -0,0 +1,7 @@ +! { dg-do run } +! PR 23661 +! PRINT with a character format was broken +character(5) :: f = "(a)" +! { dg-output "check" } +print f, "check" +end diff --git a/gcc/testsuite/gfortran.dg/print_fmt_2.f90 b/gcc/testsuite/gfortran.dg/print_fmt_2.f90 new file mode 100644 index 0000000..c7a5cc1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/print_fmt_2.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR 23661 Make sure space between PRINT and variable name is enforced in +! free form. +! Also tests the namelist case +character(5) :: f = "(a)" +real x +namelist /mynml/ x +printf, "check" ! { dg-error "Unclassifiable" } +x = 1 +printmynml ! { dg-error "" } +end diff --git a/gcc/testsuite/gfortran.dg/print_fmt_3.f b/gcc/testsuite/gfortran.dg/print_fmt_3.f new file mode 100644 index 0000000..c46b756 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/print_fmt_3.f @@ -0,0 +1,11 @@ +! { dg-do compile } +! PR 23661 Make sure space between PRINT and variable name is not enforced in +! fixed form. +! Also tests the namelist case + character(5) :: f = "(a)" + real x + namelist /mynml/ x + printf, "check" + x = 1 + printmynml ! { dg-warning "extension" } + end -- 2.7.4