Re: semi-patch for pr 20845

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

Steve,

> +     /* 4th constraint in section 11.3:  "If an object of a type for which
> +	component-initialization is specified (R429) appears in the
> +	specification-part of a module and does not have the ALLOCATABLE
> +	or POINTER attribute, the object shall have the SAVE attribute."  */
> +
> +      if (sym->ns->proc_name
> +	  && sym->ns->proc_name->attr.flavor == FL_MODULE
> +	  && sym->ts.type == BT_DERIVED && !(sym->value || flag)
> +	  && !sym->ns->save_all && !sym->attr.save
> +	  && !sym->attr.pointer && !sym->attr.allocatable)
> +	{
> +	  gfc_error("Object '%s' at %L must have the SAVE attribute %s",
> + 	 	     sym->name, &sym->declared_at,
> +		     "for default initialization of a component");
> +	  return;
> +	}
> +
>       /* Assign default initializer.  */
>       if (sym->ts.type == BT_DERIVED && !(sym->value || flag)
>           && !sym->attr.pointer)
>
>
> This appears to work with detecting the missing SAVE, but there are a
> few test suite regressions.  First, my patch suggest that der_pointer_4.f90
> is invalid code and I've verified this via Lahey's code checker.  The
> regressions are derived_recursion.f90, host_used_types_1.f90,
> used_dummy_types_1.f90, used_dummy_types_4.f90, used_types_1.f90, and
> defined_types_2.f90.  I don't see why my patch is causing the regression,
> so I'm hoping that someone (pault, tobi?) has some insight.
The patch never tests if there is a default initializer coming and so 
catches all module derived types. Without having tried it, I think you 
need to do the likes of:

+     /* 4th constraint in section 11.3:  "If an object of a type for which
+	component-initialization is specified (R429) appears in the
+	specification-part of a module and does not have the ALLOCATABLE
+	or POINTER attribute, the object shall have the SAVE attribute."  */
+
+      if (sym->ts.type == BT_DERIVED && !(sym->value || flag)
+        constructor_expr = gfc_default_initializer (&sym->ts);   /*decl needed somewhere*/
+
+      if (sym->ns->proc_name
+	  && sym->ns->proc_name->attr.flavor == FL_MODULE
+	  && constructor_expr != NULL
+	  && !sym->ns->save_all && !sym->attr.save
+	  && !sym->attr.pointer && !sym->attr.allocatable)
+	{
+	  gfc_error("Object '%s' at %L must have the SAVE attribute %s",
+ 	 	     sym->name, &sym->declared_at,
+		     "for default initialization of a component");
+	  return;
+	}
+
      /* Assign default initializer.  */
      if (constructor_expr != NULL)
        sym->value = constructor_expr;

Best regards

Paul