diff mbox

[libgfortran] PR80484 Three syntax errors involving derived-type I/O

Message ID 0f1e7130-a126-3843-ffaa-ec1944fb93f3@charter.net
State New
Headers show

Commit Message

Jerry DeLisle April 23, 2017, 2:28 a.m. UTC 
Hi all,

The attached patch fixes these issues.

Regression tested on x86_64-pc-linux-gnu. New test attached.

OK for Trunk (8)?  I think we should backport to 7 when it re-opens. The failing 
repeat count on DT format is very not good.

Regards,

Jerry

2017-04-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/80484
	* io.c (format_lex): Check for '/' and set token to FMT_SLASH.
	(check_format): Move FMT_DT checking code to data_desc section.
	* module.c (gfc_match_use): Include the case of INTERFACE_DTIO.
! { dg-do compile }
! PR80484 Three syntax errors involving derived-type I/O
module dt_write_mod
   type, public :: B_type
      real :: amount
   end type B_type
   interface write (formatted)
      procedure :: Write_b
   end interface
contains

subroutine Write_b &
   (amount, unit, b_edit_descriptor, v_list, iostat, iomsg)

   class (B_type), intent(in) :: amount
   integer, intent(in) :: unit
   character (len=*), intent(in) :: b_edit_descriptor
   integer, dimension(:), intent(in) :: v_list
   integer, intent(out) :: iostat
   character (len=*), intent(inout) :: iomsg
   write (unit=unit, fmt="(f9.3)", iostat=iostat) amount%amount

end subroutine Write_b

end module dt_write_mod

program test
   use dt_write_mod, only: B_type  , write(formatted)
   implicit none

   real :: wage = 15.10
   integer :: ios
   character(len=99) :: iom = "OK"

   write (unit=*, fmt="(DT'$$$Z.##')", iostat=ios, iomsg=iom) &
     B_type(wage), B_type(wage)
   print *, trim(iom)
   write (unit=*, fmt="(2DT'$$$Z.##')", iostat=ios, iomsg=iom) &
     B_type(wage), B_type(wage)
   print *, trim(iom)
   write (unit=*, fmt="(3DT'$$$Z.##')", iostat=ios, iomsg=iom) &
     B_type(wage), B_type(wage)
   print *, trim(iom)
   write (unit=*, fmt="(DT'$$$Z.##'/)", iostat=ios, iomsg=iom) &
     B_type(wage), B_type(wage)
   print *, trim(iom)
end program test

Comments

Paul Richard Thomas April 23, 2017, 8:46 a.m. UTC | #1 
Hi Jerry,

OK for trunk and 7-branch, when it reopens.

Thanks for keeping Walt happy :-)

Cheers

Paul

On 23 April 2017 at 03:28, Jerry DeLisle <jvdelisle@charter.net> wrote:
> Hi all,
>
> The attached patch fixes these issues.
>
> Regression tested on x86_64-pc-linux-gnu. New test attached.
>
> OK for Trunk (8)?  I think we should backport to 7 when it re-opens. The
> failing repeat count on DT format is very not good.
>
> Regards,
>
> Jerry
>
> 2017-04-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
>
>         PR fortran/80484
>         * io.c (format_lex): Check for '/' and set token to FMT_SLASH.
>         (check_format): Move FMT_DT checking code to data_desc section.
>         * module.c (gfc_match_use): Include the case of INTERFACE_DTIO.
diff mbox

Patch

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 60df44dc..7ab897da 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -491,6 +491,11 @@  format_lex (void)
 			  token = FMT_END;
 			  break;
 			}
+		      if (c == '/')
+			{
+			  token = FMT_SLASH;
+			  break;
+			}
 		      if (c == delim)
 			continue;
 		      unget_char ();
@@ -498,6 +503,11 @@  format_lex (void)
 		    }
 		}
 	    }
+	  else if (c == '/')
+	    {
+	      token = FMT_SLASH;
+	      break;
+	    }
 	  else
 	    unget_char ();
 	}
@@ -687,54 +697,6 @@  format_item_1:
 	return false;
       goto between_desc;
 
-    case FMT_DT:
-      t = format_lex ();
-      if (t == FMT_ERROR)
-	goto fail;
-      switch (t)
-	{
-	case FMT_RPAREN:
-	  level--;
-	  if (level < 0)
-	    goto finished;
-	  goto between_desc;
-
-	case FMT_COMMA:
-	  goto format_item;
-
-	case FMT_LPAREN:
-
-  dtio_vlist:
-	  t = format_lex ();
-	  if (t == FMT_ERROR)
-	    goto fail;
-
-	  if (t != FMT_POSINT)
-	    {
-	      error = posint_required;
-	      goto syntax;
-	    }
-
-	  t = format_lex ();
-	  if (t == FMT_ERROR)
-	    goto fail;
-
-	  if (t == FMT_COMMA)
-	    goto dtio_vlist;
-	  if (t != FMT_RPAREN)
-	    {
-	      error = _("Right parenthesis expected at %C");
-	      goto syntax;
-	    }
-	  goto between_desc;
-
-	default:
-	  error = unexpected_element;
-	  goto syntax;
-	}
-
-      goto format_item;
-
     case FMT_SIGN:
     case FMT_BLANK:
     case FMT_DP:
@@ -783,6 +745,7 @@  format_item_1:
     case FMT_A:
     case FMT_D:
     case FMT_H:
+    case FMT_DT:
       goto data_desc;
 
     case FMT_END:
@@ -1004,6 +967,53 @@  data_desc:
 
       break;
 
+    case FMT_DT:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      switch (t)
+	{
+	case FMT_RPAREN:
+	  level--;
+	  if (level < 0)
+	    goto finished;
+	  goto between_desc;
+
+	case FMT_COMMA:
+	  goto format_item;
+
+	case FMT_LPAREN:
+
+  dtio_vlist:
+	  t = format_lex ();
+	  if (t == FMT_ERROR)
+	    goto fail;
+
+	  if (t != FMT_POSINT)
+	    {
+	      error = posint_required;
+	      goto syntax;
+	    }
+
+	  t = format_lex ();
+	  if (t == FMT_ERROR)
+	    goto fail;
+
+	  if (t == FMT_COMMA)
+	    goto dtio_vlist;
+	  if (t != FMT_RPAREN)
+	    {
+	      error = _("Right parenthesis expected at %C");
+	      goto syntax;
+	    }
+	  goto between_desc;
+
+	default:
+	  error = unexpected_element;
+	  goto syntax;
+	}
+      break;
+
     case FMT_F:
       t = format_lex ();
       if (t == FMT_ERROR)
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4d6afa55..e8cba145 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -631,6 +631,7 @@  gfc_match_use (void)
 
 	case INTERFACE_USER_OP:
 	case INTERFACE_GENERIC:
+	case INTERFACE_DTIO:
 	  m = gfc_match (" =>");
 
 	  if (type == INTERFACE_USER_OP && m == MATCH_YES