re PR fortran/80484 (Three syntax errors involving derived-type I/O)

2017-04-23  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.

	PR fortran/80484
	* gfortran.dg/dtio_29.f03: New test.

From-SVN: r247084

gcc/fortran/ChangeLog

+2017-04-23  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.
+
 2017-04-22  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/80121

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)

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

gcc/testsuite/ChangeLog

+2017-04-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/80484
+	* gfortran.dg/dtio_29.f03: New test.
+
 2017-04-22  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/80121

gcc/testsuite/gfortran.dg/dtio_29.f03

+! { 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