public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
From: Jakub Jelinek <jakub@gcc.gnu.org>
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.
Date: Thu, 17 Sep 2020 16:54:06 +0000 (GMT)	[thread overview]
Message-ID: <20200917165406.A7682398793E@sourceware.org> (raw)

https://gcc.gnu.org/g:e46ce0a66f0d5ed4da4c56a6ee654217b8faf670

commit e46ce0a66f0d5ed4da4c56a6ee654217b8faf670
Author: Fritz Reese <foreese@gcc.gnu.org>
Date:   Thu Apr 2 13:50:11 2020 -0400

    Backport form master: Fix fortran/85982 ICE in resolve_component.
    
    2020-04-02  Fritz Reese  <foreese@gcc.gnu.org>
    
            Backport from master.
            2020-04-02  Fritz Reese  <foreese@gcc.gnu.org>
    
            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  <foreese@gcc.gnu.org>
    
            Backport from master.
            2020-04-02  Fritz Reese  <foreese@gcc.gnu.org>
    
            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  <foreese@gcc.gnu.org>
+
+	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  <cel@us.ibm.com>
 
 	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  <foreese@gcc.gnu.org>
+
+	PR fortran/85982
+	* gfortran.dg/dec_structure_28.f90: New test.
+
 2020-04-02  Mark Eggleston <markeggleston@gcc.gnu.org>
 
 	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


                 reply	other threads:[~2020-09-17 16:54 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20200917165406.A7682398793E@sourceware.org \
    --to=jakub@gcc.gnu.org \
    --cc=gcc-cvs@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).