re PR fortran/82586 ([PDT] ICE: write_symbol(): bad module symbol)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 21 Oct 2017 09:02:17 +0000 (09:02 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 21 Oct 2017 09:02:17 +0000 (09:02 +0000)
2017-10-21  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/82586
* decl.c (gfc_get_pdt_instance): Remove the error message that
the parameter does not have a corresponding component since
this is now taken care of when the derived type is resolved. Go
straight to error return instead.
(gfc_match_formal_arglist): Make the PDT relevant errors
immediate so that parsing of the derived type can continue.
(gfc_match_derived_decl): Do not check the match status on
return from gfc_match_formal_arglist for the same reason.
* resolve.c (resolve_fl_derived0): Check that each type
parameter has a corresponding component.

PR fortran/82587
* resolve.c (resolve_generic_f): Check that the derived type
can be used before resolving the struture constructor.

PR fortran/82589
* symbol.c (check_conflict): Add the conflicts involving PDT
KIND and LEN attributes.

2017-10-21  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/82586
* gfortran.dg/pdt_16.f03 : New test.
* gfortran.dg/pdt_4.f03 : Catch the changed messages.
* gfortran.dg/pdt_8.f03 : Ditto.

PR fortran/82587
* gfortran.dg/pdt_17.f03 : New test.

PR fortran/82589
* gfortran.dg/pdt_18.f03 : New test.

From-SVN: r253970

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/resolve.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pdt_16.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pdt_17.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pdt_18.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pdt_4.f03
gcc/testsuite/gfortran.dg/pdt_8.f03

index 962dbe888f6379b739062671c8a8199337380093..6bf4f1d566d4a08055c62c5d0925b6925d463369 100644 (file)
@@ -1,3 +1,25 @@
+2017-10-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/82586
+       * decl.c (gfc_get_pdt_instance): Remove the error message that
+       the parameter does not have a corresponding component since
+       this is now taken care of when the derived type is resolved. Go
+       straight to error return instead.
+       (gfc_match_formal_arglist): Make the PDT relevant errors
+       immediate so that parsing of the derived type can continue.
+       (gfc_match_derived_decl): Do not check the match status on
+       return from gfc_match_formal_arglist for the same reason.
+       * resolve.c (resolve_fl_derived0): Check that each type
+       parameter has a corresponding component.
+
+       PR fortran/82587
+       * resolve.c (resolve_generic_f): Check that the derived type
+       can be used before resolving the struture constructor.
+
+       PR fortran/82589
+       * symbol.c (check_conflict): Add the conflicts involving PDT
+       KIND and LEN attributes.
+
 2017-10-19  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>
 
        * interface.c (check_sym_interfaces, check_uop_interfaces,
index 5bf56c4d4b04d655d8f8befb82a5fdbe2fd13827..1a2d8f004cac519af366172624b4828cfa9b12e7 100644 (file)
@@ -3242,13 +3242,10 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
       param = type_param_name_list->sym;
 
       c1 = gfc_find_component (pdt, param->name, false, true, NULL);
+      /* An error should already have been thrown in resolve.c
+        (resolve_fl_derived0).  */
       if (!pdt->attr.use_assoc && !c1)
-       {
-         gfc_error ("The type parameter name list at %L contains a parameter "
-                    "'%qs' , which is not declared as a component of the type",
-                    &pdt->declared_at, param->name);
-         goto error_return;
-       }
+       goto error_return;
 
       kind_expr = NULL;
       if (!name_seen)
@@ -5984,7 +5981,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
       /* The name of a program unit can be in a different namespace,
         so check for it explicitly.  After the statement is accepted,
         the name is checked for especially in gfc_get_symbol().  */
-      if (gfc_new_block != NULL && sym != NULL
+      if (gfc_new_block != NULL && sym != NULL && !typeparam
          && strcmp (sym->name, gfc_new_block->name) == 0)
        {
          gfc_error ("Name %qs at %C is the name of the procedure",
@@ -5999,7 +5996,11 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
       m = gfc_match_char (',');
       if (m != MATCH_YES)
        {
-         gfc_error ("Unexpected junk in formal argument list at %C");
+         if (typeparam)
+           gfc_error_now ("Expected parameter list in type declaration "
+                          "at %C");
+         else
+           gfc_error ("Unexpected junk in formal argument list at %C");
          goto cleanup;
        }
     }
@@ -6016,8 +6017,12 @@ ok:
          for (q = p->next; q; q = q->next)
            if (p->sym == q->sym)
              {
-               gfc_error ("Duplicate symbol %qs in formal argument list "
-                          "at %C", p->sym->name);
+               if (typeparam)
+                 gfc_error_now ("Duplicate name %qs in parameter "
+                                "list at %C", p->sym->name);
+               else
+                 gfc_error ("Duplicate symbol %qs in formal argument "
+                            "list at %C", p->sym->name);
 
                m = MATCH_ERROR;
                goto cleanup;
@@ -9814,9 +9819,9 @@ gfc_match_derived_decl (void)
 
   if (parameterized_type)
     {
-      m = gfc_match_formal_arglist (sym, 0, 0, true);
-      if (m != MATCH_YES)
-       return m;
+      /* Ignore error or mismatches to avoid the component declarations
+        causing problems later.  */
+      gfc_match_formal_arglist (sym, 0, 0, true);
       m = gfc_match_eos ();
       if (m != MATCH_YES)
        return m;
index 04d4e8ab6cb5eb2aea637b15d91324f515300624..5062bcb755a15d00d3a4d71aa97b608635c4ab5a 100644 (file)
@@ -2694,6 +2694,8 @@ generic:
       if (!gfc_convert_to_structure_constructor (expr, intr->sym, NULL,
                                                 NULL, false))
        return false;
+      if (!gfc_use_derived (expr->ts.u.derived))
+       return false;
       return resolve_structure_cons (expr, 0);
     }
 
@@ -13937,6 +13939,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 {
   gfc_symbol* super_type;
   gfc_component *c;
+  gfc_formal_arglist *f;
   bool success;
 
   if (sym->attr.unlimited_polymorphic)
@@ -13989,6 +13992,22 @@ resolve_fl_derived0 (gfc_symbol *sym)
       && !ensure_not_abstract (sym, super_type))
     return false;
 
+  /* Check that there is a component for every PDT parameter.  */
+  if (sym->attr.pdt_template)
+    {
+      for (f = sym->formal; f; f = f->next)
+       {
+         c = gfc_find_component (sym, f->sym->name, true, true, NULL);
+         if (c == NULL)
+           {
+             gfc_error ("Parameterized type %qs does not have a component "
+                        "corresponding to parameter %qs at %L", sym->name,
+                        f->sym->name, &sym->declared_at);
+             break;
+           }
+       }
+    }
+
   /* Add derived type to the derived type list.  */
   add_dt_to_dt_list (sym);
 
index 36abba5a4881e2d498ac69b0299b919350942e4d..11b6f600103ab5a39ffb3b9174e816f8bb3ed312 100644 (file)
@@ -426,7 +426,8 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
     *is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
     *proc_pointer = "PROCEDURE POINTER", *abstract = "ABSTRACT",
     *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION",
-    *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC";
+    *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC",
+    *pdt_len = "LEN", *pdt_kind = "KIND";
   static const char *threadprivate = "THREADPRIVATE";
   static const char *omp_declare_target = "OMP DECLARE TARGET";
   static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK";
@@ -707,6 +708,23 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (entry, oacc_declare_deviceptr)
   conf (entry, oacc_declare_device_resident)
 
+  conf (pdt_kind, allocatable)
+  conf (pdt_kind, pointer)
+  conf (pdt_kind, dimension)
+  conf (pdt_kind, codimension)
+
+  conf (pdt_len, allocatable)
+  conf (pdt_len, pointer)
+  conf (pdt_len, dimension)
+  conf (pdt_len, codimension)
+
+  if (attr->access == ACCESS_PRIVATE)
+    {
+      a1 = privat;
+      conf2 (pdt_kind);
+      conf2 (pdt_len);
+    }
+
   a1 = gfc_code2string (flavors, attr->flavor);
 
   if (attr->in_namelist
index 9e0b48d23b8e8cee05c42e947ba080006f53b524..12f9f6d98c4dc452b23168f605e78d909da06e17 100644 (file)
@@ -1,3 +1,16 @@
+2017-10-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/82586
+       * gfortran.dg/pdt_16.f03 : New test.
+       * gfortran.dg/pdt_4.f03 : Catch the changed messages.
+       * gfortran.dg/pdt_8.f03 : Ditto.
+
+       PR fortran/82587
+       * gfortran.dg/pdt_17.f03 : New test.
+
+       PR fortran/82589
+       * gfortran.dg/pdt_18.f03 : New test.
+
 2017-10-20  Igor Tsimbalist  <igor.v.tsimbalist@intel.com>
 
        * c-c++-common/fcf-protection-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/pdt_16.f03 b/gcc/testsuite/gfortran.dg/pdt_16.f03
new file mode 100644 (file)
index 0000000..067d87d
--- /dev/null
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! Test the fix for all three errors in PR82586
+!
+! Contributed by G Steinmetz  <gscfq@t-online.de>
+!
+module m
+   type t(a)                 ! { dg-error "does not have a component" }
+   end type
+end
+
+program p
+   type t(a                  ! { dg-error "Expected parameter list" }
+      integer, kind :: a
+      real(a) :: x
+   end type
+   type u(a, a)              ! { dg-error "Duplicate name" }
+      integer, kind :: a     ! { dg-error "already declared" }
+      integer, len :: a      ! { dg-error "already declared" }
+   end type
+end
diff --git a/gcc/testsuite/gfortran.dg/pdt_17.f03 b/gcc/testsuite/gfortran.dg/pdt_17.f03
new file mode 100644 (file)
index 0000000..1b0a30d
--- /dev/null
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! Test the fix for PR82587
+!
+! Contributed by G Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t(a)                   ! { dg-error "does not have a component" }
+      integer(kind=t()) :: x   ! { dg-error "used before it is defined" }
+   end type
+end
diff --git a/gcc/testsuite/gfortran.dg/pdt_18.f03 b/gcc/testsuite/gfortran.dg/pdt_18.f03
new file mode 100644 (file)
index 0000000..896a727
--- /dev/null
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! Test the fix for PR82589
+!
+! Contributed by G Steinmetz  <gscfq@t-online.de>
+!
+module m
+   type t(a)
+      integer, KIND, private :: a        ! { dg-error "attribute conflicts with" }
+      integer, KIND, allocatable :: a    ! { dg-error "attribute conflicts with" }
+      integer, KIND, POINTER :: a        ! { dg-error "attribute conflicts with" }
+      integer, KIND, dimension(2) :: a   ! { dg-error "attribute conflicts with" }
+      integer, len, private :: a         ! { dg-error "attribute conflicts with" }
+      integer, len, allocatable :: a     ! { dg-error "attribute conflicts with" }
+      integer, len, POINTER :: a         ! { dg-error "attribute conflicts with" }
+      integer, len, dimension(2) :: a    ! { dg-error "attribute conflicts with" }
+      integer, kind :: a
+   end type
+end
index 13c00af79f1fb44d06038ee423ed8dcc9fd508c3..15cb6417ca7666b352793ef036de7d9c6a934b5c 100644 (file)
@@ -26,7 +26,7 @@ end module
   integer, kind :: bad_kind    ! { dg-error "not allowed outside a TYPE definition" }
   integer, len :: bad_len      ! { dg-error "not allowed outside a TYPE definition" }
 
-  type :: bad_pdt (a,b, c, d)
+  type :: bad_pdt (a,b, c, d)  ! { dg-error "does not have a component" }
     real, kind :: a            ! { dg-error "must be INTEGER" }
     INTEGER(8), kind :: b      ! { dg-error "be default integer kind" }
     real, LEN :: c             ! { dg-error "must be INTEGER" }
index d5e393e5e0c625b820d30d7b90ef18ac8684a702..aeec407fb4bea637992d7342011a91faaecd004f 100644 (file)
@@ -15,9 +15,10 @@ type :: t(i,a,x)         ! { dg-error "does not|has neither" }
   real, kind :: x        ! { dg-error "must be INTEGER" }
 end type
 
-type :: t1(k,y)          ! { dg-error "not declared as a component of the type" }
+type :: t1(k,y)          ! { dg-error "does not have a component" }
   integer, kind :: k
 end type
 
-type(t1(4,4)) :: z
+! This is a knock-on from the previous error
+type(t1(4,4)) :: z       ! { dg-error "Invalid character in name" }
 end