From: Fritz Reese Date: Fri, 29 Jun 2018 20:29:34 +0000 (+0000) Subject: Revert r262224 (backport of r262221) as PDTs are not supported in 7-branch. X-Git-Tag: releases/gcc-7.4.0~298 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=6eb2ae214dd178511c65f8f9ff262d62f942297a;p=thirdparty%2Fgcc.git Revert r262224 (backport of r262221) as PDTs are not supported in 7-branch. gcc/fortran/ChangeLog: -2018-06-28 Fritz Reese - - 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 - - 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 ab6452984574..756a33017838 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,9 +1,3 @@ -2018-06-28 Fritz Reese - - PR fortran/82865 - Backport from trunk. - * decl.c (gfc_match_type): Refactor and check for PDT declarations. - 2018-06-25 Fritz Reese PR fortran/82972 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d2a6101d0b4b..e73f2d76f455 100644 --- 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 ". */ @@ -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 ". 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 ". Check for or a PDT declaration - like . */ - 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 9c778da41614..1752201a47d6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,9 +1,3 @@ -2018-06-28 Fritz Reese - - PR fortran/82865 - Backport from trunk. - * gfortran.dg/dec_type_print_2.f03: New testcase. - 2018-06-26 Kelvin Nilsen 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 index 31b8c3ad934a..000000000000 --- 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