2017-12-01 Paul Thomas <[email protected]>

	PR fortran/82605
	* resolve.c (get_pdt_constructor): Initialize 'cons' to NULL.
	(resolve_pdt): Correct typo in prior comment. Emit an error if
	any parameters are deferred and the object is neither pointer
	nor allocatable.

	PR fortran/82606
	* decl.c (gfc_get_pdt_instance): Continue if the parameter sym
	is not present or has no name. Select the parameter by name
	of component, rather than component order. Remove all the other
	manipulations of 'tail' when building the pdt instance.
	(gfc_match_formal_arglist): Emit and error if a star is picked
	up in a PDT decl parameter list.

	PR fortran/82622
	* trans-array.c (set_loop_bounds): If a GFC_SS_COMPONENT has an
	info->end, use it rather than falling through to
	gcc_unreachable.
	(structure_alloc_comps): Check that param->name is non-null
	before comparing with the component name.
	* trans-decl.c (gfc_get_symbol_decl): Do not use the static
	initializer for PDT symbols.
	(gfc_init_default_dt): Do nothing for PDT symbols.
	* trans-io.c (transfer_array_component): Parameterized array
	components use the descriptor ubound since the shape is not
	available.

	PR fortran/82719
	PR fortran/82720
	* trans-expr.c (gfc_conv_component_ref): Do not use the charlen
	backend_decl of pdt strings. Use the hidden component instead.
	* trans-io.c (transfer_expr): Do not do IO on "hidden" string
	lengths. Use the hidden string length for pdt string transfers
	by adding it to the se structure. When finished nullify the
	se string length.

	PR fortran/82866
	* decl.c (gfc_match_formal_arglist): If a name is not found or
	star is found, while reading a type parameter list, emit an
	immediate error.
	(gfc_match_derived_decl): On reading a PDT parameter list, on
	failure to match call gfc_error_recovery.

	PR fortran/82978
	* decl.c (build_struct): Character kind defaults to 1, so use
	kind_expr whatever is the set value.
	(gfc_get_pdt_instance): Ditto.
	* trans-array.c (structure_alloc_comps): Copy the expression
	for the PDT string length before parameter substitution. Use
	this expression for evaluation and free it after use.

2017-12-01  Paul Thomas  <[email protected]>

	PR fortran/82605
	* gfortran.dg/pdt_4.f03 : Incorporate the new error.

	PR fortran/82606
	* gfortran.dg/pdt_19.f03 : New test.
	* gfortran.dg/pdt_21.f03 : New test.

	PR fortran/82622
	* gfortran.dg/pdt_20.f03 : New test.
	* gfortran.dg/pdt_22.f03 : New test.

	PR fortran/82719
	PR fortran/82720
	* gfortran.dg/pdt_23.f03 : New test.

	PR fortran/82866
	* gfortran.dg/pdt_24.f03 : New test.

	PR fortran/82978
	* gfortran.dg/pdt_10.f03 : Correct for error in coding the for
	kind 4 component and change the kind check appropriately.
	* gfortran.dg/pdt_25.f03 : New test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@255311 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog

@@ -1,3 +1,56 @@
+2017-12-01  Paul Thomas  <[email protected]>
+
+	PR fortran/82605
+	* resolve.c (get_pdt_constructor): Initialize 'cons' to NULL.
+	(resolve_pdt): Correct typo in prior comment. Emit an error if
+	any parameters are deferred and the object is neither pointer
+	nor allocatable.
+
+	PR fortran/82606
+	* decl.c (gfc_get_pdt_instance): Continue if the parameter sym
+	is not present or has no name. Select the parameter by name
+	of component, rather than component order. Remove all the other
+	manipulations of 'tail' when building the pdt instance.
+	(gfc_match_formal_arglist): Emit and error if a star is picked
+	up in a PDT decl parameter list.
+
+	PR fortran/82622
+	* trans-array.c (set_loop_bounds): If a GFC_SS_COMPONENT has an
+	info->end, use it rather than falling through to
+	gcc_unreachable.
+	(structure_alloc_comps): Check that param->name is non-null
+	before comparing with the component name.
+	* trans-decl.c (gfc_get_symbol_decl): Do not use the static
+	initializer for PDT symbols.
+	(gfc_init_default_dt): Do nothing for PDT symbols.
+	* trans-io.c (transfer_array_component): Parameterized array
+	components use the descriptor ubound since the shape is not
+	available.
+
+	PR fortran/82719
+	PR fortran/82720
+	* trans-expr.c (gfc_conv_component_ref): Do not use the charlen
+	backend_decl of pdt strings. Use the hidden component instead.
+	* trans-io.c (transfer_expr): Do not do IO on "hidden" string
+	lengths. Use the hidden string length for pdt string transfers
+	by adding it to the se structure. When finished nullify the
+	se string length.
+
+	PR fortran/82866
+	* decl.c (gfc_match_formal_arglist): If a name is not found or
+	star is found, while reading a type parameter list, emit an
+	immediate error.
+	(gfc_match_derived_decl): On reading a PDT parameter list, on
+	failure to match call gfc_error_recovery.
+
+	PR fortran/82978
+	* decl.c (build_struct): Character kind defaults to 1, so use
+	kind_expr whatever is the set value.
+	(gfc_get_pdt_instance): Ditto.
+	* trans-array.c (structure_alloc_comps): Copy the expression
+	for the PDT string length before parameter substitution. Use
+	this expression for evaluation and free it after use.
+
 2017-12-01  Jakub Jelinek  <[email protected]>
 
 	PR c/79153

gcc/fortran/decl.c

@@ -1971,7 +1971,8 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
     c->ts.u.cl = cl;
 
   if (c->ts.type != BT_CLASS && c->ts.type != BT_DERIVED
-      && c->ts.kind == 0 && saved_kind_expr != NULL)
+      && (c->ts.kind == 0 || c->ts.type == BT_CHARACTER)
+      && saved_kind_expr != NULL)
     c->kind_expr = gfc_copy_expr (saved_kind_expr);
 
   c->attr = current_attr;
@@ -3250,6 +3251,9 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	name_seen = true;
       param = type_param_name_list->sym;
 
+      if (!param || !param->name)
+	continue;
+
       c1 = gfc_find_component (pdt, param->name, false, true, NULL);
       /* An error should already have been thrown in resolve.c
 	 (resolve_fl_derived0).  */
@@ -3406,9 +3410,19 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
   for (; c1; c1 = c1->next)
     {
       gfc_add_component (instance, c1->name, &c2);
+
       c2->ts = c1->ts;
       c2->attr = c1->attr;
 
+      /* The order of declaration of the type_specs might not be the
+	 same as that of the components.  */
+      if (c1->attr.pdt_kind || c1->attr.pdt_len)
+	{
+	  for (tail = type_param_spec_list; tail; tail = tail->next)
+	    if (strcmp (c1->name, tail->name) == 0)
+	      break;
+	}
+
       /* Deal with type extension by recursively calling this function
 	 to obtain the instance of the extended type.  */
       if (gfc_current_state () != COMP_DERIVED
@@ -3453,17 +3467,12 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 	    }
 	  instance->attr.extension = c2->ts.u.derived->attr.extension + 1;
 
-	  /* Advance the position in the spec list by the number of
-	     parameters in the extended type.  */
-	  tail = type_param_spec_list;
-	  for (f = c1->ts.u.derived->formal; f && f->next; f = f->next)
-	    tail = tail->next;
-
 	  continue;
 	}
 
       /* Set the component kind using the parameterized expression.  */
-      if (c1->ts.kind == 0 && c1->kind_expr != NULL)
+      if ((c1->ts.kind == 0 || c1->ts.type == BT_CHARACTER)
+	   && c1->kind_expr != NULL)
 	{
 	  gfc_expr *e = gfc_copy_expr (c1->kind_expr);
 	  gfc_insert_kind_parameter_exprs (e);
@@ -3509,8 +3518,6 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
 
 	  if (!c2->initializer && c1->initializer)
 	    c2->initializer = gfc_copy_expr (c1->initializer);
-
-	  tail = tail->next;
 	}
 
       /* Copy the array spec.  */
@@ -5944,18 +5951,24 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag,
       if (gfc_match_char ('*') == MATCH_YES)
 	{
 	  sym = NULL;
-	  if (!gfc_notify_std (GFC_STD_F95_OBS, "Alternate-return argument "
-			       "at %C"))
+	  if (!typeparam && !gfc_notify_std (GFC_STD_F95_OBS,
+			     "Alternate-return argument at %C"))
 	    {
 	      m = MATCH_ERROR;
 	      goto cleanup;
 	    }
+	  else if (typeparam)
+	    gfc_error_now ("A parameter name is required at %C");
 	}
       else
 	{
 	  m = gfc_match_name (name);
 	  if (m != MATCH_YES)
-	    goto cleanup;
+	    {
+	      if(typeparam)
+		gfc_error_now ("A parameter name is required at %C");
+	      goto cleanup;
+	    }
 
 	  if (!typeparam && gfc_get_symbol (name, NULL, &sym))
 	    goto cleanup;
@@ -9828,9 +9841,11 @@ gfc_match_derived_decl (void)
 
   if (parameterized_type)
     {
-      /* Ignore error or mismatches to avoid the component declarations
-	 causing problems later.  */
-      gfc_match_formal_arglist (sym, 0, 0, true);
+      /* Ignore error or mismatches by going to the end of the statement
+	 in order to avoid the component declarations causing problems.  */
+      m = gfc_match_formal_arglist (sym, 0, 0, true);
+      if (m != MATCH_YES)
+	gfc_error_recovery ();
       m = gfc_match_eos ();
       if (m != MATCH_YES)
 	return m;

gcc/fortran/resolve.c

@@ -1174,7 +1174,7 @@ static bool
 get_pdt_constructor (gfc_expr *expr, gfc_constructor **constr,
 		     gfc_symbol *derived)
 {
-  gfc_constructor *cons;
+  gfc_constructor *cons = NULL;
   gfc_component *comp;
   bool t = true;
 
@@ -14010,6 +14010,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
     {
       for (f = sym->formal; f; f = f->next)
 	{
+	  if (!f->sym)
+	    continue;
 	  c = gfc_find_component (sym, f->sym->name, true, true, NULL);
 	  if (c == NULL)
 	    {
@@ -14283,7 +14285,7 @@ resolve_fl_parameter (gfc_symbol *sym)
 }
 
 
-/* Called by resolve_symbol to chack PDTs.  */
+/* Called by resolve_symbol to check PDTs.  */
 
 static void
 resolve_pdt (gfc_symbol* sym)
@@ -14293,11 +14295,18 @@ resolve_pdt (gfc_symbol* sym)
   gfc_component *c;
   bool const_len_exprs = true;
   bool assumed_len_exprs = false;
+  symbol_attribute *attr;
 
   if (sym->ts.type == BT_DERIVED)
-    derived = sym->ts.u.derived;
+    {
+      derived = sym->ts.u.derived;
+      attr = &(sym->attr);
+    }
   else if (sym->ts.type == BT_CLASS)
-    derived = CLASS_DATA (sym)->ts.u.derived;
+    {
+      derived = CLASS_DATA (sym)->ts.u.derived;
+      attr = &(CLASS_DATA (sym)->attr);
+    }
   else
     gcc_unreachable ();
 
@@ -14315,6 +14324,14 @@ resolve_pdt (gfc_symbol* sym)
 	const_len_exprs = false;
       else if (param->spec_type == SPEC_ASSUMED)
 	assumed_len_exprs = true;
+
+      if (param->spec_type == SPEC_DEFERRED
+	  && !attr->allocatable && !attr->pointer)
+	gfc_error ("The object %qs at %L has a deferred LEN "
+		   "parameter %qs and is neither allocatable "
+		   "nor a pointer", sym->name, &sym->declared_at,
+		   param->name);
+
     }
 
   if (!const_len_exprs

gcc/fortran/trans-array.c

@@ -5043,6 +5043,17 @@ set_loop_bounds (gfc_loopinfo *loop)
 		break;
 	      }
 
+	    case GFC_SS_COMPONENT:
+	      {
+		if (info->end[dim] != NULL_TREE)
+		  {
+		    loop->to[n] = info->end[dim];
+		    break;
+		  }
+		else
+		  gcc_unreachable ();
+	      }
+
 	    default:
 	      gcc_unreachable ();
 	    }
@@ -8975,7 +8986,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_actual_arglist *param = pdt_param_list;
 	      gfc_init_se (&tse, NULL);
 	      for (; param; param = param->next)
-		if (!strcmp (c->name, param->name))
+		if (param->name && !strcmp (c->name, param->name))
 		  c_expr = param->expr;
 
 	      if (!c_expr)
@@ -8992,21 +9003,24 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	    {
 	      gfc_se tse;
 	      gfc_init_se (&tse, NULL);
-	      tree strlen;
+	      tree strlen = NULL_TREE;
+	      gfc_expr *e = gfc_copy_expr (c->ts.u.cl->length);
 	      /* Convert the parameterized string length to its value. The
 		 string length is stored in a hidden field in the same way as
 		 deferred string lengths.  */
-	      gfc_insert_parameter_exprs (c->ts.u.cl->length, pdt_param_list);
+	      gfc_insert_parameter_exprs (e, pdt_param_list);
 	      if (gfc_deferred_strlen (c, &strlen) && strlen != NULL_TREE)
 		{
-		  gfc_conv_expr_type (&tse, c->ts.u.cl->length,
+		  gfc_conv_expr_type (&tse, e,
 				      TREE_TYPE (strlen));
 		  strlen = fold_build3_loc (input_location, COMPONENT_REF,
 					    TREE_TYPE (strlen),
 					    decl, strlen, NULL_TREE);
 		  gfc_add_modify (&fnblock, strlen, tse.expr);
 		  c->ts.u.cl->backend_decl = strlen;
 		}
+	      gfc_free_expr (e);
+
 	      /* Scalar parameterizied strings can be allocated now.  */
 	      if (!c->as)
 		{

gcc/fortran/trans-decl.c

@@ -1809,7 +1809,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  || !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
 	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
       && (flag_coarray != GFC_FCOARRAY_LIB
-	  || !sym->attr.codimension || sym->attr.allocatable))
+	  || !sym->attr.codimension || sym->attr.allocatable)
+      && !(sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
+      && !(sym->ts.type == BT_CLASS
+	   && CLASS_DATA (sym)->ts.u.derived->attr.pdt_type))
     {
       /* Add static initializer. For procedures, it is only needed if
 	 SAVE is specified otherwise they need to be reinitialized
@@ -4004,6 +4007,10 @@ gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc)
 
   gcc_assert (block);
 
+  /* Initialization of PDTs is done elsewhere.  */
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
+    return;
+
   gcc_assert (!sym->attr.allocatable);
   gfc_set_sym_referenced (sym);
   e = gfc_lval_expr_from_sym (sym);

gcc/fortran/trans-expr.c

@@ -2401,7 +2401,8 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
   /* Allocatable deferred char arrays are to be handled by the gfc_deferred_
      strlen () conditional below.  */
   if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
-      && !(c->attr.allocatable && c->ts.deferred))
+      && !(c->attr.allocatable && c->ts.deferred)
+      && !c->attr.pdt_string)
     {
       tmp = c->ts.u.cl->backend_decl;
       /* Components must always be constant length.  */