procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/23661 ('print fmt' is unclassifiable statement in gfortran)

Browse source 
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:
Tobias Schlüter 2005-09-04 14:08:53 +02:00
parent b3e7378af3
commit 08e1fe9e0f
6 changed files with 72 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -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

54
gcc/fortran/io.c
View file

@ -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)
{

6
gcc/testsuite/ChangeLog
View file

@ -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.

7
gcc/testsuite/gfortran.dg/print_fmt_1.f90 Normal file
View file

@ -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

11
gcc/testsuite/gfortran.dg/print_fmt_2.f90 Normal file
View file

@ -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

11
gcc/testsuite/gfortran.dg/print_fmt_3.f Normal file
View file

@ -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