From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2153) id A7682398793E; Thu, 17 Sep 2020 16:54:06 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A7682398793E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1600361646; bh=YtaxKLjCVZALUMHkuj1nh+Y7v2ogCG2e9bcsn7kd90I=; h=From:To:Subject:Date:From; b=CyfS72fmPh2jQBv0h/DRESWSoS6oyyInzhFDxRPWE7dVETRpJaFTZf5Kmr9XDghUa pW0E+v3VKL77xXGoj5ycpq6baoGRi9a5iGCL8E2QJ0tRPGaey8zNwdhkRy6l5ne16c uODSPWLYlGTZ9KQl9vCG+XOgF3AjRMfaob3iGUsc= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Jakub Jelinek To: gcc-cvs@gcc.gnu.org Subject: [gcc(refs/vendors/redhat/heads/gcc-8-branch)] Backport form master: Fix fortran/85982 ICE in resolve_component. X-Act-Checkin: gcc X-Git-Author: Fritz Reese X-Git-Refname: refs/vendors/redhat/heads/gcc-8-branch X-Git-Oldrev: 5897e76bf306fc843ba61263a9f994915fc59a18 X-Git-Newrev: e46ce0a66f0d5ed4da4c56a6ee654217b8faf670 Message-Id: <20200917165406.A7682398793E@sourceware.org> Date: Thu, 17 Sep 2020 16:54:06 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 17 Sep 2020 16:54:06 -0000 https://gcc.gnu.org/g:e46ce0a66f0d5ed4da4c56a6ee654217b8faf670 commit e46ce0a66f0d5ed4da4c56a6ee654217b8faf670 Author: Fritz Reese Date: Thu Apr 2 13:50:11 2020 -0400 Backport form master: Fix fortran/85982 ICE in resolve_component. 2020-04-02 Fritz Reese Backport from master. 2020-04-02 Fritz Reese PR fortran/85982 * fortran/decl.c (match_attr_spec): Lump COMP_STRUCTURE/COMP_MAP into attribute checking used by TYPE. 2020-04-02 Fritz Reese Backport from master. 2020-04-02 Fritz Reese PR fortran/85982 * gfortran.dg/dec_structure_28.f90: New test. Diff: --- gcc/ChangeLog | 6 +++++ gcc/fortran/decl.c | 30 +++++++++++++++------- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/dec_structure_28.f90 | 35 ++++++++++++++++++++++++++ 4 files changed, 67 insertions(+), 9 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 775a02e4b78..33c4d7f2f60 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2020-04-02 Fritz Reese + + PR fortran/85982 + * fortran/decl.c (match_attr_spec): Lump COMP_STRUCTURE/COMP_MAP into + attribute checking used by TYPE. + 2020-03-31 Carl Love Backport of: diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 13dd7352d27..8e7327dc568 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5236,15 +5236,19 @@ match_attr_spec (void) if (d == DECL_STATIC && seen[DECL_SAVE]) continue; - if (gfc_current_state () == COMP_DERIVED + if (gfc_comp_struct (gfc_current_state ()) && d != DECL_DIMENSION && d != DECL_CODIMENSION && d != DECL_POINTER && d != DECL_PRIVATE && d != DECL_PUBLIC && d != DECL_CONTIGUOUS && d != DECL_NONE) { + bool is_derived = gfc_current_state () == COMP_DERIVED; if (d == DECL_ALLOCATABLE) { - if (!gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE " - "attribute at %C in a TYPE definition")) + if (!gfc_notify_std (GFC_STD_F2003, is_derived + ? G_("ALLOCATABLE attribute at %C in a " + "TYPE definition") + : G_("ALLOCATABLE attribute at %C in a " + "STRUCTURE definition"))) { m = MATCH_ERROR; goto cleanup; @@ -5252,8 +5256,11 @@ match_attr_spec (void) } else if (d == DECL_KIND) { - if (!gfc_notify_std (GFC_STD_F2003, "KIND " - "attribute at %C in a TYPE definition")) + if (!gfc_notify_std (GFC_STD_F2003, is_derived + ? G_("KIND attribute at %C in a " + "TYPE definition") + : G_("KIND attribute at %C in a " + "STRUCTURE definition"))) { m = MATCH_ERROR; goto cleanup; @@ -5276,8 +5283,11 @@ match_attr_spec (void) } else if (d == DECL_LEN) { - if (!gfc_notify_std (GFC_STD_F2003, "LEN " - "attribute at %C in a TYPE definition")) + if (!gfc_notify_std (GFC_STD_F2003, is_derived + ? G_("LEN attribute at %C in a " + "TYPE definition") + : G_("LEN attribute at %C in a " + "STRUCTURE definition"))) { m = MATCH_ERROR; goto cleanup; @@ -5300,8 +5310,10 @@ match_attr_spec (void) } else { - gfc_error ("Attribute at %L is not allowed in a TYPE definition", - &seen_at[d]); + gfc_error (is_derived ? G_("Attribute at %L is not allowed in a " + "TYPE definition") + : G_("Attribute at %L is not allowed in a " + "STRUCTURE definition"), &seen_at[d]); m = MATCH_ERROR; goto cleanup; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2546dc4e85d..c9315e69fd9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-04-02 Fritz Reese + + PR fortran/85982 + * gfortran.dg/dec_structure_28.f90: New test. + 2020-04-02 Mark Eggleston Backport from master diff --git a/gcc/testsuite/gfortran.dg/dec_structure_28.f90 b/gcc/testsuite/gfortran.dg/dec_structure_28.f90 new file mode 100644 index 00000000000..bab08b2d5c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_28.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-options "-fdec-structure -fdec-static" } +! +! PR fortran/85982 +! +! Test a regression wherein some component attributes were erroneously accepted +! within a DEC structure. +! + +structure /s/ + integer :: a + integer, intent(in) :: b ! { dg-error "is not allowed" } + integer, intent(out) :: c ! { dg-error "is not allowed" } + integer, intent(inout) :: d ! { dg-error "is not allowed" } + integer, dimension(1,1) :: e ! OK + integer, external, pointer :: f ! { dg-error "is not allowed" } + integer, intrinsic :: f ! { dg-error "is not allowed" } + integer, optional :: g ! { dg-error "is not allowed" } + integer, parameter :: h ! { dg-error "is not allowed" } + integer, protected :: i ! { dg-error "is not allowed" } + integer, private :: j ! { dg-error "is not allowed" } + integer, static :: k ! { dg-error "is not allowed" } + integer, automatic :: l ! { dg-error "is not allowed" } + integer, public :: m ! { dg-error "is not allowed" } + integer, save :: n ! { dg-error "is not allowed" } + integer, target :: o ! { dg-error "is not allowed" } + integer, value :: p ! { dg-error "is not allowed" } + integer, volatile :: q ! { dg-error "is not allowed" } + integer, bind(c) :: r ! { dg-error "is not allowed" } + integer, asynchronous :: t ! { dg-error "is not allowed" } + character(len=3) :: v ! OK + integer(kind=4) :: w ! OK +end structure + +end