This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH, fortran] PR fortran/85982 -- Fix ICE on invalid attributes inside DEC structures


All,

The simple patch below (and attached) fixes PR 85982. The issue is an
omission of the macro gfc_comp_struct() which would include DEC
structures in certain attribute checks that are performed for
derived-TYPE declarations in decl.c. In the case described in the PR
(https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85982) there is an ICE
because the presence of an invalid EXTERNAL attribute leaks through to
resolve_component, invalidating some invariants for objects which are
supposed to be EXTERNAL.

This is fairly obvious so I would commit to trunk and backport to
7-branch and 8-branch if nobody sees any issues this week or so.
(Nb. the test case is named dec_structure_28.f90 so as not to conflict
with the pending patch for PR fortran/87919 which adds
dec_structure_{24-27}.f90.)

--
Fritz

>From dc5a072017af29ca1e84b85b0e3a1e6af49a6928 Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzoreese@gmail.com>
Date: Mon, 12 Nov 2018 15:19:39 -0500

Fix ICE due to erroneously accepted component attributes in DEC structures.

gcc/fortran/
    * decl.c (match_attr_spec): Lump COMP_STRUCTURE/COMP_MAP into attribute
    checking used by TYPE.

gcc/testsuite/
    * gfortran.dg/dec_structure_28.f90: New test.
---
 gcc/fortran/decl.c                             | 17 ++++++++-----
 gcc/testsuite/gfortran.dg/dec_structure_28.f90 | 35 ++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/dec_structure_28.f90
index 87c736fb2db..2b294fdf65f 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5184,15 +5184,18 @@ 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)
        {
+         const char* const state_name = (gfc_current_state () == COMP_DERIVED
+                                         ? "TYPE" : "STRUCTURE");
          if (d == DECL_ALLOCATABLE)
            {
              if (!gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE "
-                                  "attribute at %C in a TYPE definition"))
+                                  "attribute at %C in a %s definition",
+                                  state_name))
                {
                  m = MATCH_ERROR;
                  goto cleanup;
@@ -5201,7 +5204,8 @@ match_attr_spec (void)
          else if (d == DECL_KIND)
            {
              if (!gfc_notify_std (GFC_STD_F2003, "KIND "
-                                  "attribute at %C in a TYPE definition"))
+                                  "attribute at %C in a %s definition",
+                                  state_name))
                {
                  m = MATCH_ERROR;
                  goto cleanup;
@@ -5225,7 +5229,8 @@ match_attr_spec (void)
          else if (d == DECL_LEN)
            {
              if (!gfc_notify_std (GFC_STD_F2003, "LEN "
-                                  "attribute at %C in a TYPE definition"))
+                                  "attribute at %C in a %s definition",
+                                  state_name))
                {
                  m = MATCH_ERROR;
                  goto cleanup;
@@ -5248,8 +5253,8 @@ match_attr_spec (void)
            }
          else
            {
-             gfc_error ("Attribute at %L is not allowed in a TYPE definition",
-                        &seen_at[d]);
+             gfc_error ("Attribute at %L is not allowed in a %s definition",
+                        &seen_at[d], state_name);
              m = MATCH_ERROR;
              goto cleanup;
            }
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
From dc5a072017af29ca1e84b85b0e3a1e6af49a6928 Mon Sep 17 00:00:00 2001
From: Fritz Reese <fritzoreese@gmail.com>
Date: Mon, 12 Nov 2018 15:19:39 -0500
Subject: [PATCH] PR fortran/85982

Fix ICE due to erroneously accepted component attributes in DEC structures.

gcc/fortran/
	* decl.c (match_attr_spec): Lump COMP_STRUCTURE/COMP_MAP into attribute
	checking used by TYPE.

gcc/testsuite/
	* gfortran.dg/dec_structure_28.f90: New test.
---
 gcc/fortran/decl.c                             | 17 ++++++++-----
 gcc/testsuite/gfortran.dg/dec_structure_28.f90 | 35 ++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/dec_structure_28.f90

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 87c736fb2db..2b294fdf65f 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5184,15 +5184,18 @@ 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)
 	{
+	  const char* const state_name = (gfc_current_state () == COMP_DERIVED
+					  ? "TYPE" : "STRUCTURE");
 	  if (d == DECL_ALLOCATABLE)
 	    {
 	      if (!gfc_notify_std (GFC_STD_F2003, "ALLOCATABLE "
-				   "attribute at %C in a TYPE definition"))
+				   "attribute at %C in a %s definition",
+				   state_name))
 		{
 		  m = MATCH_ERROR;
 		  goto cleanup;
@@ -5201,7 +5204,8 @@ match_attr_spec (void)
 	  else if (d == DECL_KIND)
 	    {
 	      if (!gfc_notify_std (GFC_STD_F2003, "KIND "
-				   "attribute at %C in a TYPE definition"))
+				   "attribute at %C in a %s definition",
+				   state_name))
 		{
 		  m = MATCH_ERROR;
 		  goto cleanup;
@@ -5225,7 +5229,8 @@ match_attr_spec (void)
 	  else if (d == DECL_LEN)
 	    {
 	      if (!gfc_notify_std (GFC_STD_F2003, "LEN "
-				   "attribute at %C in a TYPE definition"))
+				   "attribute at %C in a %s definition",
+				   state_name))
 		{
 		  m = MATCH_ERROR;
 		  goto cleanup;
@@ -5248,8 +5253,8 @@ match_attr_spec (void)
 	    }
 	  else
 	    {
-	      gfc_error ("Attribute at %L is not allowed in a TYPE definition",
-			 &seen_at[d]);
+	      gfc_error ("Attribute at %L is not allowed in a %s definition",
+			 &seen_at[d], state_name);
 	      m = MATCH_ERROR;
 	      goto cleanup;
 	    }
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
-- 
2.12.2


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]