OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/48972 (OPEN with Unicode file name) 

2011-05-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48972
        * io.c (resolve_tag_format, resolve_tag): Make sure
        that the string is of default kind.
        (gfc_resolve_inquire): Also resolve decimal tag.

2011-05-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48972
        * gfortran.dg/io_constraints_8.f90: New.
        * gfortran.dg/io_constraints_9.f90: New.

From-SVN: r173736
This commit is contained in:
Tobias Burnus 2011-05-13 20:16:37 +02:00 committed by Tobias Burnus
parent 9f47a24e79
commit 75933b07b7
5 changed files with 111 additions and 3 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 @@
2011-05-13 Tobias Burnus <burnus@net-b.de>
PR fortran/48972
* io.c (resolve_tag_format, resolve_tag): Make sure
that the string is of default kind.
(gfc_resolve_inquire): Also resolve decimal tag.
2011-05-12 Tobias Burnus <burnus@net-b.de>
PR fortran/48972

16
gcc/fortran/io.c
View File

@ -1394,10 +1394,12 @@ resolve_tag_format (const gfc_expr *e)
|| e->symtree->n.sym->as == NULL
|| e->symtree->n.sym->as->rank == 0))
{
if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
if ((e->ts.type != BT_CHARACTER
|| e->ts.kind != gfc_default_character_kind)
&& e->ts.type != BT_INTEGER)
{
gfc_error ("FORMAT tag at %L must be of type CHARACTER or INTEGER",
&e->where);
gfc_error ("FORMAT tag at %L must be of type default-kind CHARACTER "
"or of INTEGER", &e->where);
return FAILURE;
}
else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
@ -1478,6 +1480,13 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
return FAILURE;
}
if (e->ts.type == BT_CHARACTER && e->ts.kind != gfc_default_character_kind)
{
gfc_error ("%s tag at %L must be a character string of default kind",
tag->name, &e->where);
return FAILURE;
}
if (e->rank != 0)
{
gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
@ -4059,6 +4068,7 @@ gfc_resolve_inquire (gfc_inquire *inquire)
INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round);
INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending);
INQUIRE_RESOLVE_TAG (&tag_size, inquire->size);
INQUIRE_RESOLVE_TAG (&tag_s_decimal, inquire->decimal);
#undef INQUIRE_RESOLVE_TAG
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2011-05-13 Tobias Burnus <burnus@net-b.de>
PR fortran/48972
* gfortran.dg/io_constraints_8.f90: New.
* gfortran.dg/io_constraints_9.f90: New.
2011-05-13 Martin Thuresson <martint@google.com>
PR gcov-profile/47793

72
gcc/testsuite/gfortran.dg/io_constraints_8.f90 Normal file
View File

@ -0,0 +1,72 @@
! { dg-do compile }
! { dg-options "-fmax-errors=100 -Wall" }
!
! PR fortran/48972
!
!
! All string arguments to I/O statements shall
! be of default-character type. (Except for the
! internal unit.)
!
character(len=30, kind=4) :: str1
integer :: i
OPEN(99, access=4_'direct') ! { dg-error "must be a character string of default kind" }
OPEN(99, action=4_'read') ! { dg-error "must be a character string of default kind" }
OPEN(99, asynchronous=4_'no') ! { dg-error "must be a character string of default kind" })
OPEN(99, blank=4_'null') ! { dg-error "must be a character string of default kind" }
OPEN(99, decimal=4_'comma') ! { dg-error "must be a character string of default kind" }
OPEN(99, delim=4_'quote') ! { dg-error "must be a character string of default kind" }
OPEN(99, encoding=4_'default') ! { dg-error "must be a character string of default kind" }
OPEN(99, file=4_'Test.dat') ! { dg-error "must be a character string of default kind" }
OPEN(99, form=4_'formatted') ! { dg-error "must be a character string of default kind" }
OPEN(99, pad=4_'yes') ! { dg-error "must be a character string of default kind" }
OPEN(99, position=4_'asis') ! { dg-error "must be a character string of default kind" }
OPEN(99, round=4_'down') ! { dg-error "must be a character string of default kind" }
OPEN(99, sign=4_'plus') ! { dg-error "must be a character string of default kind" }
OPEN(99, status=4_'old') ! { dg-error "must be a character string of default kind" }
OPEN(99, IOSTAT=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
close(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
close(99, status=4_'delete') ! { dg-error "must be a character string of default kind" }
write(99, '(a)', advance=4_'no')! { dg-error "must be a character string of default kind" }
read (99, *, blank=4_'null') ! { dg-error "must be a character string of default kind" }
write(99, *, decimal=4_'comma') ! { dg-error "must be a character string of default kind" }
write(99, *, delim=4_'quote') ! { dg-error "must be a character string of default kind" }
read (99, *, pad=4_'yes') ! { dg-error "must be a character string of default kind" }
write(99, *, round=4_'down') ! { dg-error "must be a character string of default kind" }
write(99, *, sign=4_'plus') ! { dg-error "must be a character string of default kind" }
wait(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
endfile (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
backspace(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
rewind (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
flush (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" }
inquire (file=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,access=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,action=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,asynchronous=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,blank=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,decimal=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,delim=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,direct=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,encoding=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,form=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,formatted=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,iomsg=str1, iostat=i) ! { dg-error "must be a character string of default kind" }
inquire (99,name=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,pad=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,position=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,read=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,readwrite=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,round=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,sequential=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,sign=str1) ! { dg-error "must be a character string of default kind" }
!inquire (99,stream=str1) ! Fails due to PR 48976
inquire (99,unformatted=str1) ! { dg-error "must be a character string of default kind" }
inquire (99,write=str1) ! { dg-error "must be a character string of default kind" }
end

13
gcc/testsuite/gfortran.dg/io_constraints_9.f90 Normal file
View File

@ -0,0 +1,13 @@
! { dg-do compile }
!
! PR fortran/48972
!
! All string arguments to I/O statements shall
! be of default-character type. (Except for the
! internal unit.)
!
character(len=20, kind=4) :: str1
write(99, str1) 'a' ! { dg-error "must be of type default-kind CHARACTER" }
read(99, fmt=str1) ! { dg-error "must be of type default-kind CHARACTER" }
end