diff mbox

[Fortran] Reject non-default-kind characters as flags to I/O statements

Message ID 4DCC577F.3040206@net-b.de
State New
Headers show

Commit Message

Tobias Burnus May 12, 2011, 9:56 p.m. UTC 
The patch is a correctness issue as the Fortran standard has those as 
constraints - and the results of passing kind=4 strings is also odd ...

I used also the chance to resolve INQUIRE's decimal ...

Build and partially regtested on x86-64-linux.
OK for the trunk?

Tobias

PS: I will regtest again after PR 48984 has been fixed, which caused 
many test-suite failures.

Comments

Janne Blomqvist May 13, 2011, 9:26 a.m. UTC | #1 
On Fri, May 13, 2011 at 00:56, Tobias Burnus <burnus@net-b.de> wrote:
> The patch is a correctness issue as the Fortran standard has those as
> constraints - and the results of passing kind=4 strings is also odd ...
>
> I used also the chance to resolve INQUIRE's decimal ...
>
> Build and partially regtested on x86-64-linux.
> OK for the trunk?

Ok, thanks for the patch. And especially thanks for the exhaustive
test cases! However, can you combine the test cases, I don't really
see any special reason to have them separate as they test more or less
the same thing?
H.J. Lu May 13, 2011, 8:47 p.m. UTC | #2 
On Thu, May 12, 2011 at 2:56 PM, Tobias Burnus <burnus@net-b.de> wrote:
> The patch is a correctness issue as the Fortran standard has those as
> constraints - and the results of passing kind=4 strings is also odd ...
>
> I used also the chance to resolve INQUIRE's decimal ...
>
> Build and partially regtested on x86-64-linux.
> OK for the trunk?
>

It caused:

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48991


--
H.J.
diff mbox

Patch

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.

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index df9ee1e..c2d46af 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -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)
--- /dev/null	2011-05-12 07:35:17.079892192 +0200
+++ gcc/gcc/testsuite/gfortran.dg/io_constraints_8.f90	2011-05-12 23:19:51.000000000 +0200
@@ -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
--- /dev/null	2011-05-12 07:35:17.079892192 +0200
+++ gcc/gcc/testsuite/gfortran.dg/io_constraints_9.f90	2011-05-12 23:16:41.000000000 +0200
@@ -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