------- Additional Comments From tobi at gcc dot gnu dot org 2005-09-09 15:58
-------
This patch fixes the problem in match_io.c, but leaves us with a preexisting
deficiency in I/O statement parsing:
PRINT I+I
END
will now segfault in trans-io.c.
Index: io.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/io.c,v
retrieving revision 1.31
diff -c -3 -p -r1.31 io.c
*** io.c 4 Sep 2005 12:08:40 -0000 1.31
--- io.c 9 Sep 2005 15:38:07 -0000
*************** match_io (io_kind k)
*** 2133,2169 ****
if (gfc_match_char ('(') == MATCH_NO)
{
if (k == M_WRITE)
goto syntax;
! else if (k == M_PRINT
! && (gfc_current_form == FORM_FIXED
! || gfc_peek_char () == ' '))
{
/* 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)
{
! 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;
}
- else
- gfc_current_locus = where;
}
if (gfc_current_form == FORM_FREE)
--- 2133,2170 ----
if (gfc_match_char ('(') == MATCH_NO)
{
+ where = gfc_current_locus
if (k == M_WRITE)
goto syntax;
! else if (k == M_PRINT)
{
/* Treat the non-standard case of PRINT namelist. */
! if ((gfc_current_form == FORM_FIXED || gfc_peek_char () == ' ')
! && gfc_match_name (name) == MATCH_YES)
{
! gfc_find_symbol (name, NULL, 1, &sym);
! if (sym && sym->attr.flavor == FL_NAMELIST)
{
! 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;
}
! else
! gfc_current_locus = where;
}
}
if (gfc_current_form == FORM_FREE)
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=23420
