diff options
| author | tobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-04 12:08:53 +0000 |
|---|---|---|
| committer | tobi <tobi@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-04 12:08:53 +0000 |
| commit | e713bf6dd99b59d450c790b1e7494462a17b459e (patch) | |
| tree | eef1595ad0678fac27350ee479d689cdf5007036 /gcc/fortran/io.c | |
| parent | 17df5dd666893a29eb9d54100b8f9f58bf34cef8 (diff) | |
| download | gcc-e713bf6dd99b59d450c790b1e7494462a17b459e.tar.gz | |
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
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 50 |
1 files changed, 28 insertions, 22 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 5b27eadc544..37a7493f786 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(); |