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 --git a/gcc/ChangeLog b/gcc/ChangeLog
index fc9f15e0ce3f45d57d5683614682e9e2a9f53470..a64777282a6e30a3c0c78f49a7817ad99e99843f 100644 (file)
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,12 @@
+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  Richard Biener  <rguenther@suse.de>
 
        Backport from mainline

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0291e248bb36bf3aa1cf80be02bf251568d87d02..78ea32a37709ef663e4158b20141cfba377db5e2 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5339,15 +5339,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;
@@ -5355,8 +5359,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;
@@ -5379,8 +5386,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;
@@ -5403,8 +5413,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 75e711eb07ff2e36324c7cf6889259bd02acf7e0..da06792dc1860e0516c41071b0041f7deccb9139 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.
+
 2020-04-02  Richard Biener  <rguenther@suse.de>
 
        Backport from mainline

diff --git a/gcc/testsuite/gfortran.dg/dec_structure_28.f90 b/gcc/testsuite/gfortran.dg/dec_structure_28.f90
new file mode 100644 (file)
index 0000000..bab08b2
--- /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