re PR fortran/23661 ('print fmt' is unclassifiable statement in gfortran)
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. From-SVN: r103824
This commit is contained in:
parent
b3e7378af3
commit
08e1fe9e0f
|
@ -1,3 +1,10 @@
|
|||
2005-09-04 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
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 <coudert@clipper.ens.fr>
|
||||
|
||||
PR fortran/20592
|
||||
|
|
|
@ -2133,32 +2133,38 @@ 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 (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;
|
||||
}
|
||||
|
||||
|
||||
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)
|
||||
{
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2005-09-04 Tobias Schl"uter <tobias.shclueter@physik.uni-muenchen.de>
|
||||
|
||||
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 <jakub@redhat.com>
|
||||
|
||||
* gfortran.dg/fmt_t_1.f90: New test.
|
||||
|
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue