Skip to content

R
riscv-gcc-1
Commit f25bf34f by Tobias Schlüter
Options

io.c (resolve_tag_format): New function using code split out and simplified from ... 

fortran/
* io.c (resolve_tag_format): New function using code split out
and simplified from ...
(resolve_tag): ... this function.  Simplify logic.  Unify
IOSTAT, IOLENGTH and SIZE handling.
testsuite/
* gfortran.dg/g77/19981216-0.f: Remove dg-warning annotation.
* gfortran.dg/io_constraints_1.f90: Make a -std=f95 test.  Add
warning annotation.
* gfortran.dg/iostat_3.f90: Make a -std=f95 test.

From-SVN: r128623
parent 770a9950
Showing with 110 additions and 110 deletions
gcc/fortran/ChangeLog
2007-09-20 Tobias Schlüter <tobi@gcc.gnu.org>
* io.c (resolve_tag_format): New function using code split out
and simplified from ...
(resolve_tag): ... this function. Simplify logic. Unify
IOSTAT, IOLENGTH and SIZE handling.
2007-09-20 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/33497
......
gcc/fortran/io.c
......@@ -1091,141 +1091,125 @@ match_ltag (const io_tag *tag, gfc_st_label ** label)
}
/* Do expression resolution and type-checking on an expression tag. */
/* Resolution of the FORMAT tag, to be called from resolve_tag. */
static try
resolve_tag (const io_tag *tag, gfc_expr *e)
resolve_tag_format (const gfc_expr *e)
{
if (e == NULL)
return SUCCESS;
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
if (e->ts.type != tag->type && tag != &tag_format)
if (e->expr_type == EXPR_CONSTANT
&& (e->ts.type != BT_CHARACTER
|| e->ts.kind != gfc_default_character_kind))
{
gfc_error ("%s tag at %L must be of type %s", tag->name,
&e->where, gfc_basic_typename (tag->type));
gfc_error ("Constant expression in FORMAT tag at %L must be "
"of type default CHARACTER", &e->where);
return FAILURE;
}
if (tag == &tag_format)
/* If e's rank is zero and e is not an element of an array, it should be
of integer or character type. The integer variable should be
ASSIGNED. */
if (e->symtree == NULL || e->symtree->n.sym->as == NULL
|| e->symtree->n.sym->as->rank == 0)
{
if (e->expr_type == EXPR_CONSTANT
&& (e->ts.type != BT_CHARACTER
|| e->ts.kind != gfc_default_character_kind))
if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
{
gfc_error ("Constant expression in FORMAT tag at %L must be "
"of type default CHARACTER", &e->where);
gfc_error ("FORMAT tag at %L must be of type CHARACTER or INTEGER",
&e->where);
return FAILURE;
}
/* If e's rank is zero and e is not an element of an array, it should be
of integer or character type. The integer variable should be
ASSIGNED. */
if (e->symtree == NULL || e->symtree->n.sym->as == NULL
|| e->symtree->n.sym->as->rank == 0)
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
{
if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
{
gfc_error ("%s tag at %L must be of type %s or %s", tag->name,
&e->where, gfc_basic_typename (BT_CHARACTER),
gfc_basic_typename (BT_INTEGER));
return FAILURE;
}
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
{
if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED "
"variable in FORMAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
if (e->symtree->n.sym->attr.assign != 1)
{
gfc_error ("Variable '%s' at %L has not been assigned a "
"format label", e->symtree->n.sym->name,
&e->where);
return FAILURE;
}
}
else if (e->ts.type == BT_INTEGER)
if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED "
"variable in FORMAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
if (e->symtree->n.sym->attr.assign != 1)
{
gfc_error ("scalar '%s' FORMAT tag at %L is not an ASSIGNED "
"variable", gfc_basic_typename (e->ts.type),
&e->where);
gfc_error ("Variable '%s' at %L has not been assigned a "
"format label", e->symtree->n.sym->name, &e->where);
return FAILURE;
}
return SUCCESS;
}
else
else if (e->ts.type == BT_INTEGER)
{
/* if rank is nonzero, we allow the type to be character under
GFC_STD_GNU and other type under GFC_STD_LEGACY. It may be
assigned an Hollerith constant. */
if (e->ts.type == BT_CHARACTER)
{
if (gfc_notify_std (GFC_STD_GNU, "Extension: Character array "
"in FORMAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
}
else
{
if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character "
"in FORMAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
}
return SUCCESS;
gfc_error ("Scalar '%s' in FORMAT tag at %L is not an ASSIGNED "
"variable", gfc_basic_typename (e->ts.type), &e->where);
return FAILURE;
}
return SUCCESS;
}
/* If rank is nonzero, we allow the type to be character under GFC_STD_GNU
and other type under GFC_STD_LEGACY. It may be assigned an Hollerith
constant. */
if (e->ts.type == BT_CHARACTER)
{
if (gfc_notify_std (GFC_STD_GNU, "Extension: Character array "
"in FORMAT tag at %L", &e->where) == FAILURE)
return FAILURE;
}
else
{
if (e->rank != 0)
{
gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
return FAILURE;
}
if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character "
"in FORMAT tag at %L", &e->where) == FAILURE)
return FAILURE;
}
if (tag == &tag_iomsg)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
return SUCCESS;
}
if (tag == &tag_iostat && e->ts.kind != gfc_default_integer_kind)
{
if (gfc_notify_std (GFC_STD_GNU, "Fortran 95 requires default "
"INTEGER in IOSTAT tag at %L", &e->where)
== FAILURE)
return FAILURE;
}
if (tag == &tag_size && e->ts.kind != gfc_default_integer_kind)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
"INTEGER in SIZE tag at %L", &e->where)
== FAILURE)
return FAILURE;
}
/* Do expression resolution and type-checking on an expression tag. */
if (tag == &tag_convert)
{
if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
if (tag == &tag_iolength && e->ts.kind != gfc_default_integer_kind)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
"INTEGER in IOLENGTH tag at %L", &e->where)
== FAILURE)
return FAILURE;
}
static try
resolve_tag (const io_tag *tag, gfc_expr *e)
{
if (e == NULL)
return SUCCESS;
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
if (tag == &tag_format)
return resolve_tag_format (e);
if (e->ts.type != tag->type)
{
gfc_error ("%s tag at %L must be of type %s", tag->name,
&e->where, gfc_basic_typename (tag->type));
return FAILURE;
}
if (e->rank != 0)
{
gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
return FAILURE;
}
if (tag == &tag_iomsg)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
if ((tag == &tag_iostat || tag == &tag_size || tag == &tag_iolength)
&& e->ts.kind != gfc_default_integer_kind)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
"INTEGER in %s tag at %L", tag->name, &e->where)
== FAILURE)
return FAILURE;
}
if (tag == &tag_convert)
{
if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
return SUCCESS;
}
......
gcc/testsuite/ChangeLog
2007-09-20 Tobias Schlter <tobi@gcc.gnu.org>
* gfortran.dg/g77/19981216-0.f: Remove dg-warning annotation.
* gfortran.dg/io_constraints_1.f90: Make a -std=f95 test. Add
warning annotation.
* gfortran.dg/iostat_3.f90: Make a -std=f95 test.
2007-09-20 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/33497
gcc/testsuite/gfortran.dg/g77/19981216-0.f
......@@ -29,7 +29,7 @@ c { dg-do compile }
name = 'blah'
open(unit=8,status='unknown',file=name,form='formatted',
F iostat=ios) ! { dg-warning "INTEGER in IOSTAT" }
F iostat=ios)
END
* -------------------------------------------
......
gcc/testsuite/gfortran.dg/io_constraints_1.f90
! { dg-do compile }
! { dg-options "-std=f95" }
! Part I of the test of the IO constraints patch, which fixes PRs:
! PRs 25053, 25063, 25064, 25066, 25067, 25068, 25069, 25307 and 20862.
!
......@@ -20,7 +21,7 @@ contains
subroutine foo (i)
integer :: i
write (*, 100) i
100 format (1h , "i=", i6) ! This is OK.
100 format (1h , "i=", i6) ! { dg-warning "The H format specifier at ... is a Fortran 95 deleted feature" }
end subroutine foo
end module global
......
gcc/testsuite/gfortran.dg/iostat_3.f90
! { dg-do compile }
! { dg-options "-std=f95" }
! Testcase for PR libfortran/25068
real :: u
integer(kind=8) :: i
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment