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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b186bfd65aa321ea7d006575fb169d6fd3739e78..c5ed5071b09e1d599a337655af5e5f0fd8dc8164 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 60df44dc695f2299110eeab75839c3553477f9a2..7ab897daa44b0d37b8c8a1d0a5bff67609d1e381 100644 (file)
--- 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 4d6afa55d3853b91b6c8d06e18fa4d2c95a3c0f8..e8cba1455aafa920662a5a2cb1a45454e37ee418 100644 (file)
--- 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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 27f5be805eceab1b93d25419651e236798e97e08..e87a01adf3c7aa3b96e5b06919a0de190c374b68 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/dtio_29.f03 b/gcc/testsuite/gfortran.dg/dtio_29.f03
new file mode 100644 (file)
index 0000000..46961e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_29.f03
@@ -0,0 +1,47 @@
+! { 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