Re: [Patch, Fortran] PR41629: [OOP] gimplification error on valid code

[Janus Weil <janus at gcc dot gnu dot org>]

Paul,


> What is wrong with the patch below?

nothing, AFAICS. I'm not 100% sure yet that this will not get us into
trouble somehow, but at least it fixes the test case and regtests
fine. Plus ...


>?It seems a lot simpler to me and it compiles your testcase correctly.

it's much more elegant than my approach, indeed.


> In addition, I prefer to see the container created as early as
> possible so that all the natural checks for derived types are
> preserved.

Well, I'm not so sure about that. Actually a lot of these 'natural
checks' are not all that natural with the CLASS container already in
place, since some of the attributes are shifted into the $data
component etc.

In fact, with my patch, some CLASS-specific treatment can be removed
again, like here:

@@ -1868,20 +1866,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_fl
 	  if (m != MATCH_YES)
 	    return m;
 	}
-      else if (component->ts.type == BT_CLASS
-	       && component->ts.u.derived->components->as != NULL
-	       && !component->attr.proc_pointer)
-	{
-	  tail = extend_ref (primary, tail);
-	  tail->type = REF_ARRAY;

-	  m = gfc_match_array_ref (&tail->u.ar,
-				   component->ts.u.derived->components->as,
-				   equiv_flag);
-	  if (m != MATCH_YES)
-	    return m;
-	}
-
       if ((component->ts.type != BT_DERIVED && component->ts.type != BT_CLASS)
 	  || gfc_match_char ('%') != MATCH_YES)
 	break;


There are more examples of this e.g. in gfc_match_allocate and
gfc_match_deallocate (and probably other places where I did not remove
the extra code yet). But anyway ...


If you can add some equally elegant code to also fix PR41618 (which my
patch did, as Dominique noted), your patch is fine with me.

Cheers,
Janus



> +++ gcc/fortran/decl.c ?(working copy)
> @@ -5685,14 +5685,29 @@
> ? ? ? ?}
> ? ? }
>
> - ?/* Update symbol table. ?DIMENSION attribute is set
> - ? ? in gfc_set_array_spec(). ?*/
> - ?if (current_attr.dimension == 0
> - ? ? ?&& gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
> + ?/* Update symbol table. ?DIMENSION attribute is set in
> + ? ? gfc_set_array_spec(). ?For CLASS variables, this must be applied
> + ? ? to the first component, or '$data' field. ?*/
> + ?if (sym->ts.type == BT_CLASS && sym->ts.u.derived)
> ? ? {
> - ? ? ?m = MATCH_ERROR;
> - ? ? ?goto cleanup;
> + ? ? ?gfc_component *comp;
> + ? ? ?comp = gfc_find_component (sym->ts.u.derived, "$data", true, true);
> + ? ? ?if (comp == NULL || gfc_copy_attr (&comp->attr, &current_attr,
> + ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?&var_locus) == FAILURE)
> + ? ? ? {
> + ? ? ? ? m = MATCH_ERROR;
> + ? ? ? ? goto cleanup;
> + ? ? ? }
> ? ? }
> + ?else
> + ? ?{
> + ? ? ?if (current_attr.dimension == 0
> + ? ? ? ? ? && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
> + ? ? ? {
> + ? ? ? ? m = MATCH_ERROR;
> + ? ? ? ? goto cleanup;
> + ? ? ? }
> + ? ?}
>
> ? if (gfc_set_array_spec (sym, as, &var_locus) == FAILURE)
> ? ? {
>