re PR fortran/82173 ([meta-bug] Parameterized derived type errors)

2017-09-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82173
	* decl.c (gfc_get_pdt_instance): Use the component initializer
	expression for the default, rather than the parameter value.
	* resolve.c (resolve_pdt): New function.
	(resolve_symbol): Call it. Remove false error, prohibiting
	deferred type parameters for dummy arguments.

	PR fortran/60483
	* primary.c (gfc_match_varspec): If the type of an associate
	name is unknown and yet there is a match, try resolving the
	target expression and using its type.

2017-09-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82173
	* gfortran.dg/pdt_1.f03 : Eliminate spurious error checks.
	* gfortran.dg/pdt_2.f03 : The same.
	* gfortran.dg/pdt_3.f03 : The same.
	* gfortran.dg/pdt_4.f03 : Add 'modtype' and two new errors in
	module 'bad_vars'. Add error concerning assumed parameters and
	save attribute.
	* gfortran.dg/pdt_11.f03 : New test.

	PR fortran/60483
	* gfortran.dg/associate_9.f90 : Remove XFAIL and change to run.
	* gfortran.dg/associate_25.f90 : New test.
	* gfortran.dg/pdt_12.f03 : New test.

From-SVN: r252894

1 files changed, 54 insertions, 9 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 91d05b3..89dea5f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14125,6 +14125,57 @@ resolve_fl_parameter (gfc_symbol *sym)
 }
 
 
+/* Called by resolve_symbol to chack PDTs.  */
+
+static void
+resolve_pdt (gfc_symbol* sym)
+{
+  gfc_symbol *derived = NULL;
+  gfc_actual_arglist *param;
+  gfc_component *c;
+  bool const_len_exprs = true;
+  bool assumed_len_exprs = false;
+
+  if (sym->ts.type == BT_DERIVED)
+    derived = sym->ts.u.derived;
+  else if (sym->ts.type == BT_CLASS)
+    derived = CLASS_DATA (sym)->ts.u.derived;
+  else
+    gcc_unreachable ();
+
+  gcc_assert (derived->attr.pdt_type);
+
+  for (param = sym->param_list; param; param = param->next)
+    {
+      c = gfc_find_component (derived, param->name, false, true, NULL);
+      gcc_assert (c);
+      if (c->attr.pdt_kind)
+	continue;
+
+      if (param->expr && !gfc_is_constant_expr (param->expr)
+	  && c->attr.pdt_len)
+	const_len_exprs = false;
+      else if (param->spec_type == SPEC_ASSUMED)
+	assumed_len_exprs = true;
+    }
+
+  if (!const_len_exprs
+      && (sym->ns->proc_name->attr.is_main_program
+	  || sym->ns->proc_name->attr.flavor == FL_MODULE
+	  || sym->attr.save != SAVE_NONE))
+    gfc_error ("The AUTOMATIC object %qs at %L must not have the "
+	       "SAVE attribute or be a variable declared in the "
+	       "main program, a module or a submodule(F08/C513)",
+	       sym->name, &sym->declared_at);
+
+  if (assumed_len_exprs && !(sym->attr.dummy
+      || sym->attr.select_type_temporary || sym->attr.associate_var))
+    gfc_error ("The object %qs at %L with ASSUMED type parameters "
+	       "must be a dummy or a SELECT TYPE selector(F08/4.2)",
+	       sym->name, &sym->declared_at);
+}
+
+
 /* Do anything necessary to resolve a symbol.  Right now, we just
    assume that an otherwise unknown symbol is a variable.  This sort
    of thing commonly happens for symbols in module.  */
@@ -14381,15 +14432,6 @@ resolve_symbol (gfc_symbol *sym)
       return;
     }
 
-  if (sym->attr.dummy && sym->ts.type == BT_DERIVED
-      && sym->ts.u.derived->attr.pdt_type
-      && gfc_spec_list_type (sym->param_list, NULL) == SPEC_DEFERRED)
-    {
-      gfc_error ("%qs at %L cannot have DEFERRED type parameters because "
-		 "it is a dummy argument", sym->name, &sym->declared_at);
-      return;
-    }
-
   if (sym->attr.value && sym->ts.type == BT_CHARACTER)
     {
       gfc_charlen *cl = sym->ts.u.cl;
@@ -14927,6 +14969,9 @@ resolve_symbol (gfc_symbol *sym)
       || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function))
     if (!resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name))
       return;
+
+  if (sym->param_list)
+    resolve_pdt (sym);
 }