Revert r262224 (backport of r262221) as PDTs are not supported in 7-branch.

gcc/fortran/ChangeLog:
-2018-06-28  Fritz Reese  <fritzoreese@gmail.com>
-
-	PR fortran/82865
-	Backport from trunk.
-	* decl.c (gfc_match_type): Refactor and check for PDT declarations.
-

gcc/testsuite/ChangeLog:
-2018-06-28  Fritz Reese  <fritzoreese@gmail.com>
-
-	PR fortran/82865
-	Backport from trunk.
-	* gfortran.dg/dec_type_print_2.f03: New testcase.
-

From-SVN: r262260

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ab64529845744b54168e313acf2c70744820656a..756a330178387792c55cd38c4f73c714f65da3f3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,9 +1,3 @@
-2018-06-28  Fritz Reese  <fritzoreese@gmail.com>
-
-       PR fortran/82865
-       Backport from trunk.
-       * decl.c (gfc_match_type): Refactor and check for PDT declarations.
-
 2018-06-25  Fritz Reese  <fritzoreese@gmail.com>
 
        PR fortran/82972

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d2a6101d0b4bfff30c193e45683fc1b27ceebe13..e73f2d76f4558040f2a89f38294ebb5ae12a5a4d 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8887,9 +8887,9 @@ gfc_match_structure_decl (void)
 
 
 /* This function does some work to determine which matcher should be used to
- * match a statement beginning with "TYPE".  This is used to disambiguate TYPE
+ * match a statement beginning with "TYPE". This is used to disambiguate TYPE
  * as an alias for PRINT from derived type declarations, TYPE IS statements,
- * and [parameterized] derived type declarations.  */
+ * and derived type data declarations.  */
 
 match
 gfc_match_type (gfc_statement *st)
@@ -8916,7 +8916,11 @@ gfc_match_type (gfc_statement *st)
   /* If we see an attribute list before anything else it's definitely a derived
    * type declaration.  */
   if (gfc_match (" ,") == MATCH_YES || gfc_match (" ::") == MATCH_YES)
-    goto derived;
+    {
+      gfc_current_locus = old_loc;
+      *st = ST_DERIVED_DECL;
+      return gfc_match_derived_decl ();
+    }
 
   /* By now "TYPE" has already been matched. If we do not see a name, this may
    * be something like "TYPE *" or "TYPE <fmt>".  */
@@ -8931,11 +8935,29 @@ gfc_match_type (gfc_statement *st)
          *st = ST_WRITE;
          return MATCH_YES;
        }
-      goto derived;
+      gfc_current_locus = old_loc;
+      *st = ST_DERIVED_DECL;
+      return gfc_match_derived_decl ();
     }
 
-  /* Check for EOS.  */
-  if (gfc_match_eos () == MATCH_YES)
+  /* A derived type declaration requires an EOS. Without it, assume print.  */
+  m = gfc_match_eos ();
+  if (m == MATCH_NO)
+    {
+      /* Check manually for TYPE IS (... - this is invalid print syntax.  */
+      if (strncmp ("is", name, 3) == 0
+         && gfc_match (" (", name) == MATCH_YES)
+       {
+         gfc_current_locus = old_loc;
+         gcc_assert (gfc_match (" is") == MATCH_YES);
+         *st = ST_TYPE_IS;
+         return gfc_match_type_is ();
+       }
+      gfc_current_locus = old_loc;
+      *st = ST_WRITE;
+      return gfc_match_print ();
+    }
+  else
     {
       /* By now we have "TYPE <name> <EOS>". Check first if the name is an
        * intrinsic typename - if so let gfc_match_derived_decl dump an error.
@@ -8948,36 +8970,12 @@ gfc_match_type (gfc_statement *st)
          *st = ST_DERIVED_DECL;
          return m;
        }
+      gfc_current_locus = old_loc;
+      *st = ST_WRITE;
+      return gfc_match_print ();
     }
-  else
-    {
-      /* Here we have "TYPE <name>". Check for <TYPE IS (> or a PDT declaration
-        like <type name(parameter)>.  */
-      gfc_gobble_whitespace ();
-      bool paren = gfc_peek_ascii_char () == '(';
-      if (paren)
-       {
-         if (strcmp ("is", name) == 0)
-           goto typeis;
-         else
-           goto derived;
-       }
-    }
-
-  /* Treat TYPE... like PRINT...  */
-  gfc_current_locus = old_loc;
-  *st = ST_WRITE;
-  return gfc_match_print ();
 
-derived:
-  gfc_current_locus = old_loc;
-  *st = ST_DERIVED_DECL;
-  return gfc_match_derived_decl ();
-
-typeis:
-  gfc_current_locus = old_loc;
-  *st = ST_TYPE_IS;
-  return gfc_match_type_is ();
+  return MATCH_NO;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9c778da4161484798b80caad3738a29d3ce40dd4..1752201a47d64294fc2515ba506dbaed47fd5e2f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,9 +1,3 @@
-2018-06-28  Fritz Reese  <fritzoreese@gmail.com>
-
-       PR fortran/82865
-       Backport from trunk.
-       * gfortran.dg/dec_type_print_2.f03: New testcase.
-
 2018-06-26  Kelvin Nilsen  <kelvin@gcc.gnu.org>
 
        Backported from mainline

diff --git a/gcc/testsuite/gfortran.dg/dec_type_print_2.f03 b/gcc/testsuite/gfortran.dg/dec_type_print_2.f03
deleted file mode 100644 (file)
index 31b8c3a..0000000
--- a/gcc/testsuite/gfortran.dg/dec_type_print_2.f03
+++ /dev/null
@@ -1,59 +0,0 @@
-! { dg-do run }
-! { dg-options "-fdec -fcheck=all" }
-!
-! Verify that -fdec does not break parsing of PDTs.
-! This test code is copied from pdt_1.f03 but compiled with -fdec.
-!
-program main
-  implicit none
-  integer, parameter :: ftype = kind(0.0e0)
-  integer :: pdt_len = 4
-  integer :: i
-  type :: mytype (a,b)
-    integer, kind :: a = kind(0.0d0)
-    integer, LEN :: b
-    integer :: i
-    real(kind = a) :: d(b, b)
-    character (len = b*b) :: chr
-  end type
-
-  type(mytype(b=4)) :: z(2)
-  type(mytype(ftype, 4)) :: z2
-
-  z(1)%i = 1
-  z(2)%i = 2
-  z(1)%d = reshape ([(real(i), i = 1, 16)],[4,4])
-  z(2)%d = 10*z(1)%d
-  z(1)%chr = "hello pdt"
-  z(2)%chr = "goodbye pdt"
-
-  z2%d = z(1)%d * 10 - 1
-  z2%chr = "scalar pdt"
-
-  call foo (z)
-  call bar (z)
-  call foobar (z2)
-contains
-  elemental subroutine foo (arg)
-    type(mytype(8,*)), intent(in) :: arg
-    if (arg%i .eq. 1) then
-      if (trim (arg%chr) .ne. "hello pdt") error stop
-      if (int (sum (arg%d)) .ne. 136) error stop
-    else if (arg%i .eq. 2 ) then
-      if (trim (arg%chr) .ne. "goodbye pdt") error stop
-      if (int (sum (arg%d)) .ne. 1360) error stop
-    else
-      error stop
-    end if
-  end subroutine
-  subroutine bar (arg)
-    type(mytype(b=4)) :: arg(:)
-    if (int (sum (arg(1)%d)) .ne. 136) call abort
-    if (trim (arg(2)%chr) .ne. "goodbye pdt") call abort
-  end subroutine
-  subroutine foobar (arg)
-    type(mytype(ftype, pdt_len)) :: arg
-    if (int (sum (arg%d)) .ne. 1344) call abort
-    if (trim (arg%chr) .ne. "scalar pdt") call abort
-  end subroutine
-end