re PR fortran/82586 ([PDT] ICE: write_symbol(): bad module symbol)

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

+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,

gcc/fortran/decl.c

@@ -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;

gcc/fortran/resolve.c

@@ -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);
 

gcc/fortran/symbol.c

@@ -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

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/pdt_16.f03

+! { 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

gcc/testsuite/gfortran.dg/pdt_17.f03

+! { 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

gcc/testsuite/gfortran.dg/pdt_18.f03

+! { 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

gcc/testsuite/gfortran.dg/pdt_4.f03

@@ -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" }

gcc/testsuite/gfortran.dg/pdt_8.f03

@@ -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