[fortran] PR46897 - [OOP] type-bound defined ASSIGNMENT(=) not used for derived type component in intrinsic assign

Dear All,

Please find attached a new attempt at the patch for PR46897.  It now
uses temporaries to overcome the side effects that Mikael pointed out.
 The resulting code can be quite profligate:

  infant0 = new_child()

produces

  ASSIGN main:da@0 new_child[[()]]
  ASSIGN main:da@1 main:infant0
  ASSIGN main:da@2 main:infant0
  ASSIGN main:infant0 main:da@0
  ASSIGN main:da@3 main:da@1 % parent
  ASSIGN main:da@4 main:da@1 % parent
  CALL assign0 ((main:da@3 % foo) (main:da@0 % parent % foo))
  ASSIGN main:da@1 % parent % foo main:da@3 % foo
  ASSIGN main:infant0 % parent main:da@1 % parent

It could be simplified, I suspect but I do not believe that it is
worth any more effort for what is, after all, well off the beaten
track.

The comments in resolve.c explain how the patch works.

Bootstrapped and regtested on FC9/x86_64 - OK for trunk?

Cheers

Paul

2012-09-10   Alessandro Fanfarillo <alessandro.fanfarillo@gmail.com>
	     Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46897
	* gfortran.h : Add bit field 'defined_assign_comp' to
	symbol_attribute structure.
	Add primitive for gfc_add_full_array_ref.
	* expr.c (gfc_add_full_array_ref): New function.
	(gfc_lval_expr_from_sym): Call new function.
	* resolve.c (add_comp_ref): New function.
	(build_assignment): New function.
	(get_temp_from_expr): New function
	(add_code_to_chain): New function
	(generate_component_assignments): New function that calls all
	the above new functions.
	(resolve_code): Call generate_component_assignments.

2012-09-10   Alessandro Fanfarillo <alessandro.fanfarillo@gmail.com>
	     Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46897
	* gfortran.dg/defined_assignment_1.f90: New test.
	* gfortran.dg/defined_assignment_2.f90: New test.
	* gfortran.dg/defined_assignment_3.f90: New test.



On 14/08/2012, Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Mikael,
>
> On 14 August 2012 10:42, Mikael Morin <mikael.morin@sfr.fr> wrote:
>> On 14/08/2012 07:03, Paul Richard Thomas wrote:
>>>> However, if we do it before, we also overwrite components to be
>>>> assigned
>>>> with a typebound call, and this can have some side effects as the LHS's
>>>> argument can be INTENT(INOUT).
>>>
>>> This might be so but it is what the standard dictates should
>>> happen.... isn't it?
>>>
>> It dictates that the components should be assigned one by one (by either
>> defined or intrinsic assignment), which I don't see as strictly
>> equivalent to a whole structure assignment followed by typebound calls
>> (for components needing it).
>
> Hmmm.  That's true.  ***sigh***
>
> I'll put it right.
>
> Cheers
>
> Paul
>

Am 10.09.2012 20:58, schrieb Paul Richard Thomas:
> Bootstrapped and regtested on FC9/x86_64 - OK for trunk?

The following test case doesn't work; it should print "Overloaded" - and 
does so with crayftn. But with your patch, it doesn't.

Tobias

module a_mod
   type :: a
    contains
      procedure :: a_ass
      generic :: assignment(=) => a_ass
   end type a

   type c
     type(a) :: ta
   end type c

   type :: b
     type(c) :: tc
   end type b

contains
   impure elemental subroutine a_ass(out, in)
     class(a), intent(out) :: out
     type(a), intent(in)  :: in
     print *, "Overloaded"
   end subroutine a_ass
end module a_mod

program assign
   use a_mod
   type(b) :: tt
   type(b) :: tb1
   tt = tb1
end program assign


+ build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2, + 
gfc_component *comp1, gfc_component *comp2, locus loc)

For comp1/comp2, I am wondering whether one shouldn't add a
   gcc_assert ((comp1 && comp2) || (!comp1 && !comp2));


+ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)

Not that we make so much use of it, but its symbol could be a candidate 
for attr.artificial. (I don't know whether it should.)

Dear Tobias,

> The following test case doesn't work; it should print "Overloaded" - and
> does so with crayftn. But with your patch, it doesn't.

For some reason, I guess, the attribute defined_assign_comp is not
getting passed along to type 'b'.

> + build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2, +
> gfc_component *comp1, gfc_component *comp2, locus loc)
>
> For comp1/comp2, I am wondering whether one shouldn't add a
>   gcc_assert ((comp1 && comp2) || (!comp1 && !comp2));

I guess that it will do no harm and might be advised if this function
is called from elsewhere.
>
>
> + get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
>
> Not that we make so much use of it, but its symbol could be a candidate for
> attr.artificial. (I don't know whether it should.)

I don't know either.  I don't recall even noticing the artificial
attribute.  I will follow it up to see what use is made of it and see
if it applies here.  Presumably this couples directly to
DECL_ARTIFICIAL?

Thanks for the review.

Paul

PS I really, really want to get used to this PR!
PPS I presume that the reason for two temporaries is clear to you?

Hello,

On 10/09/2012 20:58, Paul Richard Thomas wrote:
> Dear All,
> 
> Please find attached a new attempt at the patch for PR46897.  It now
> uses temporaries to overcome the side effects that Mikael pointed out.

And here comes the next round of comments.


> Index: gcc/fortran/resolve.c
> ===================================================================
> *** gcc/fortran/resolve.c	(revision 191115)
> --- gcc/fortran/resolve.c	(working copy)
> *************** resolve_ordinary_assign (gfc_code *code,
> *** 9516,9521 ****
> --- 9516,9791 ----
>   }
>   
>   
> + /* Add a component reference onto an expression.  */
> + 
> + static void
> + add_comp_ref (gfc_expr *e, gfc_component *c)
> + {
> +   gfc_ref **ref;
> +   ref = &(e->ref);
> +   while (*ref)
> +     ref = &((*ref)->next);
> +   *ref = gfc_get_ref();
> +   (*ref)->type = REF_COMPONENT;
> +   (*ref)->u.c.sym = e->ts.u.derived;
> +   (*ref)->u.c.component = c;
> +   e->ts = c->ts;
> + 
> +   /* Add a full array ref, as necessary.  */
> +   e->rank = c && c->as ? c->as->rank : 0;
This is bogus if  e->rank was != 0 previously (think of the case
array(:)%scalar_comp).
The c == NULL case should be handled at the beginning (if at all).

> +   if (e->rank)
the condition should be on c->as (for the case array(:)%scalar_comp again).

> +     gfc_add_full_array_ref (e, c->as);
> + }
> + 
> + 
> + /* Build an assignment.  */
> + 
> + static gfc_code *
> + build_assignment (gfc_exec_op op, gfc_expr *expr1, gfc_expr *expr2,
> + 		  gfc_component *comp1, gfc_component *comp2, locus loc)
> + {
> +   gfc_code *this_code;
> + 
> +   this_code = gfc_get_code ();
> +   this_code->op = op;
all calls are with op == EXEC_ASSIGN, you may as well hardcode it.

> +   this_code->next = NULL;
> +   this_code->expr1 = gfc_copy_expr (expr1);
> +   this_code->expr2 = gfc_copy_expr (expr2);
> +   this_code->loc = loc;
> +   if (comp1 && comp2)
> +     {
> +       add_comp_ref (this_code->expr1, comp1);
> +       add_comp_ref (this_code->expr2, comp2);
> +     }
> + 
> +   return this_code;
> + }
> + 
> + 
> + /* Makes a temporary variable expression based on the characteristics of
> +    a given expression.  */
> + 
> + static gfc_expr*
> + get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
> + {
> +   static int serial = 0;
> +   char name[GFC_MAX_SYMBOL_LEN];
> +   gfc_symtree *tmp;
> +   gfc_ref *ref = NULL, *eref;
> + 
> +   gcc_assert (e->expr_type == EXPR_VARIABLE
> + 	      || e->expr_type == EXPR_FUNCTION);
As far as I know anything can be used, not only variables and functions.
The derived type cases are a bit specific but at least array/structure
constructors are missing.  There could be also typebound function calls
(I never know whether they are EXPR_FUNCTION or something else).

> +   sprintf (name, "da@%d", serial++);
> +   gfc_get_sym_tree (name, ns, &tmp, false);
> +   gfc_add_type (tmp->n.sym, &e->ts, NULL);
> + 
> +   for (eref = e->ref; eref; eref = eref->next)
> +     if (eref->type == REF_COMPONENT)
> +       ref = eref;
> + 
> +   if (!ref)
> +     {
> +       tmp->n.sym->attr = e->symtree->n.sym->attr;
> +       if (e->symtree->n.sym->as)
> + 	tmp->n.sym->as
> + 		= gfc_copy_array_spec (e->symtree->n.sym->as);
> +     }
> +   else
> +     {
> +       tmp->n.sym->attr = ref->u.c.component->attr;
> +       if (ref->u.c.component->as)
> + 	tmp->n.sym->as
> + 		= gfc_copy_array_spec (ref->u.c.component->as);
> +     }
> + 
> +   gfc_set_sym_referenced (tmp->n.sym);
> +   gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL);
> +   return gfc_lval_expr_from_sym (tmp->n.sym);
> + }
> + 
> + 
> + /* Add one line of code to the code chain, making sure that 'head' and
> +    'tail' are appropriately updated.  */
> + 
> + static void
> + add_code_to_chain (gfc_code **this_code, gfc_code **head, gfc_code **tail)
> + {
> +   gcc_assert (this_code);
> +   if (*head == NULL)
> +     *head = *tail = *this_code;
> +   else
> +     *tail = gfc_append_code (*tail, *this_code);
> +   *this_code = NULL;
> + }
> + 
> + 
> + /* Implement 7.2.1.3 of the F08 standard:
> +    "An intrinsic assignment where the variable is of derived type is
> +    performed as if each component of the variable were assigned from the
> +    corresponding component of expr using pointer assignment (7.2.2) for
> +    each pointer component, defined assignment for each nonpointer
> +    nonallocatable component of a type that has a type-bound defined
> +    assignment consistent with the component, intrinsic assignment for
> +    each other nonpointer nonallocatable component, ..." 
> + 
> +    The pointer assignments are taken care of by the intrinsic
> +    assignment of the structure itself.  This function recursively adds
> +    defined assignments where required.
> + 
> +    Since the lhs in a defined assignment can have intent INOUT, the code
> +    to do this gets a bit messy.  In pseudo-code:
> + 
> +    ! Only call function lhs once.
> +       if (lhs is a function)
> + 	temp_x = expr2
> +       expr2 = expr(temp_x)
> +    ! Need two temporaries for lhs.
> +       t1 = expr1
> +       t2 = expr2
> +    ! Do the intrinsic assignment
> +       expr1 = expr2
> +    ! Now do the defined assignments
> +       do over components with typebound defined assignment [%cmp]
> + 	expr2%cmp {defined=} t1%cmp
I guess it should be `t1%cmp {defined=} expr2%cmp'?

> + 	expr1%cmp = t1%cmp           ! Store in the result
> +         t1%cmp = t2%cmp              ! Restore the original value
It seems to me that the last assignment isn't useful: once one component
has been taken care of, we proceed with the next one, so `t1' can have
garbage in the previous one without any impact.
Then if it can be removed, `t2' is useless and then `temp_x' as well, so
we could do with the simpler [still most of `t1' is useless]:
   t1 = expr1
   expr1 = expr2
   t1%cmp {defined=} expr1%cmp
   expr1%cmp = t1%cmp

It would be nice too if the temporaries were avoided in the case there
is no defined assignment with intent(inout) lhs, but I leave the
decision to do it to you.


> +       */
> + 
> + static void
> + generate_component_assignments (gfc_code **code, gfc_namespace *ns)
> + {
> +   gfc_component *comp1, *comp2;
> +   gfc_code *this_code = NULL, *head = NULL, *tail = NULL;
> +   gfc_expr *t1, *t2;
> + 
> +   /* Filter out continuing processing after an error.  */
> +   if ((*code)->expr1->ts.type != BT_DERIVED
> +       || (*code)->expr2->ts.type != BT_DERIVED)
> +     return;
> + 
> +   /* Create a temporary so that functions get called once.  */
> +   if ((*code)->expr2->expr_type != EXPR_VARIABLE)
> +     {
> +       gfc_expr *tmp_expr;
> +       
> +       /* Assign the rhs to the temporary.  */
> +       tmp_expr = get_temp_from_expr ((*code)->expr1, ns);
> +       this_code = build_assignment (EXEC_ASSIGN,
> + 				    tmp_expr, (*code)->expr2,
> + 				    NULL, NULL, (*code)->loc);
> + 
> +       /* Add the code and substitute the rhs expression. */
> +       add_code_to_chain (&this_code, &head, &tail);
> +       gfc_free_expr ((*code)->expr2);
> +       (*code)->expr2 = tmp_expr;
> +     }
> + 
> +   /* Build the two temporaries required for the assignment.  */
> +   t1 = get_temp_from_expr ((*code)->expr1, ns);
> +   this_code = build_assignment (EXEC_ASSIGN,
> + 				t1, (*code)->expr1,
> + 				NULL, NULL, (*code)->loc);
> +   add_code_to_chain (&this_code, &head, &tail);
> +   t2 = get_temp_from_expr ((*code)->expr1, ns);
> +   this_code = build_assignment (EXEC_ASSIGN,
> + 				t2, (*code)->expr1,
> + 				NULL, NULL, (*code)->loc);
> +   add_code_to_chain (&this_code, &head, &tail);
> + 
> +   /* Do the intrinsic assignment. This is not needed if the lhs is one
> +      of the temporaries generated here, since the intrinsic assignment
> +      to the final result already does this.  */
> +   if ((*code)->expr1->symtree->n.sym->name[2] != '@')
> +     {
> +       this_code = build_assignment (EXEC_ASSIGN,
> + 				    (*code)->expr1, (*code)->expr2,
> + 				    NULL, NULL, (*code)->loc);
> +       add_code_to_chain (&this_code, &head, &tail);
> +     }
> + 
> +   comp1 = (*code)->expr1->ts.u.derived->components;
> +   comp2 = (*code)->expr2->ts.u.derived->components;
> + 
> +   for (; comp1; comp1 = comp1->next, comp2 = comp2->next)
> +     {
> +       /* The intrinsic assignment does the right thing for pointers
> + 	 of all kinds and allocatable components.  */
> +       if (comp1->ts.type != BT_DERIVED
> + 	  || comp1->attr.pointer
> + 	  || comp1->attr.allocatable
> + 	  || comp1->attr.proc_pointer_comp
That one doesn't look right.

> + 	  || comp1->attr.class_pointer
> + 	  || comp1->attr.proc_pointer)
> + 	continue;
> + 
> +       if (this_code)
> + 	add_code_to_chain (&this_code, &head, &tail);
> + 
> +       /* Make an assigment for this component.  */
> +       this_code = gfc_get_code ();
> +       this_code = build_assignment (EXEC_ASSIGN,
> + 				    t1, (*code)->expr2,
> + 				    comp1, comp2, (*code)->loc);
> + 
> +       /* Convert the assignment if there is a defined assignment for
> + 	 this type.  Otherwise, using the call from resolve_code,	
> + 	 recurse into its components.  */
> +       resolve_code (this_code, ns);
> + 
> +       if (this_code->op == EXEC_ASSIGN_CALL)
> + 	{
> + 	  /* Check that there is a typebound defined assignment.  If not,
> + 	     then this must be a module defined assignment.  We cannot
> + 	     use the defined_assign_comp attribute here because it must
> + 	     be this derived type that has the defined assignment and not
> + 	     a parent type.  */
> + 	  if (!(comp1->ts.u.derived->f2k_derived
> + 	        && comp1->ts.u.derived->f2k_derived
> + 					->tb_op[INTRINSIC_ASSIGN]))
> + 	    {
> + 	      gfc_free_statements (this_code);
`this_code' should be cleared, otherwise it is used in the next iteration.

> + 	      continue;
> + 	    }
> + 	}
> +       else if (this_code->op == EXEC_ASSIGN && !this_code->next)
> + 	{
> + 	  /* Don't add intrinsic assignments since they are already
> + 	     effected by the intrinsic assignment of the structure.  */
> + 	  gfc_free_statements (this_code);
Same.

> + 	  continue;
> + 	}
> + 
> +       add_code_to_chain (&this_code, &head, &tail);
> + 
> +       /* Transfer the value to the final result.  */
> +       this_code = build_assignment (EXEC_ASSIGN,
> + 				    (*code)->expr1, t1,
> + 				    comp1, comp2, (*code)->loc);
> +       add_code_to_chain (&this_code, &head, &tail);
> + 
> +       /* Restore the value of t1.  This code is added to the chain at
> + 	 the start of the loop if more defined assignments.  */
> +       this_code = build_assignment (EXEC_ASSIGN,
> + 				    t1, t2,
> + 				    comp1, comp2, (*code)->loc);
> +     }
> + 
> +   if (this_code)
> +     gfc_free_statements (this_code);
> +     
> +   /* Now attach the remaining code chain to the input code. Step on
> +      to the end of the new code since resolution is complete.  */
> +   gcc_assert ((*code)->op == EXEC_ASSIGN);
> +   tail->next = (*code)->next;
> +   /* Overwrite 'code' because this would place the intrinsic assignment
> +      before the temporary for the lhs is created.  */
> +   gfc_free_expr ((*code)->expr1);
> +   gfc_free_expr ((*code)->expr2);
> +   **code = *head;

free (head); ?

> +   *code = tail;
> + }
> + 
> + 
>   /* Given a block of code, recursively resolve everything pointed to by this
>      code block.  */
>   
> *************** resolve_code (gfc_code *code, gfc_namesp
> *** 9678,9683 ****
> --- 9948,9959 ----
>   	      else
>   		goto call;
>   	    }
> + 
> + 	  /* F03 7.4.1.3 for non-allocatable, non-pointer components.  */
> + 	  if (code->expr1->ts.type == BT_DERIVED
> + 	      && code->expr1->ts.u.derived->attr.defined_assign_comp)
> + 	    generate_component_assignments (&code, ns);
> + 
>   	  break;
>   
>   	case EXEC_LABEL_ASSIGN:
> *************** resolve_fl_derived0 (gfc_symbol *sym)
> *** 12282,12289 ****
> --- 12558,12574 ----
>   					   || c->attr.proc_pointer
>   					   || c->attr.allocatable)) == FAILURE)
>   	return FAILURE;
> + 
> +       if (c->ts.type == BT_DERIVED
> + 	  && c->ts.u.derived->f2k_derived
> + 	  && c->ts.u.derived->f2k_derived->tb_op[INTRINSIC_ASSIGN])
> + 	sym->attr.defined_assign_comp = 1;
>       }
>   
> +   if (super_type)
> +     sym->attr.defined_assign_comp
> + 			= super_type->attr.defined_assign_comp;
I guess Tobias' reported bug is here.  The flag shouldn't be cleared
here if it was set just before.


> + 
>     /* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
>        all DEFERRED bindings are overridden.  */
>     if (super_type && super_type->attr.abstract && !sym->attr.abstract


To finish, I would like to draw your attention on the scalarizer not
supporting multiple arrays in the reference chain.  The initial
expressions are guaranteed to have at most one array in the chain, but
as we add subfield references, that condition can not remain true.  We
could try adding multiple references support in the scalarizer, but I
don't know how difficult it would be.  Or maybe better fix it at the
front-end AST level by using elemental functions to split the
scalarization work.  Or something else.  What do you think?

Mikael

On 17/09/2012 20:45, Mikael Morin wrote:
>> *************** resolve_fl_derived0 (gfc_symbol *sym)
>> *** 12282,12289 ****
>> --- 12558,12574 ----
>>   					   || c->attr.proc_pointer
>>   					   || c->attr.allocatable)) == FAILURE)
>>   	return FAILURE;
>> + 
>> +       if (c->ts.type == BT_DERIVED
>> + 	  && c->ts.u.derived->f2k_derived
>> + 	  && c->ts.u.derived->f2k_derived->tb_op[INTRINSIC_ASSIGN])
>> + 	sym->attr.defined_assign_comp = 1;
>>       }
>>   
>> +   if (super_type)
>> +     sym->attr.defined_assign_comp
>> + 			= super_type->attr.defined_assign_comp;
> I guess Tobias' reported bug is here.  The flag shouldn't be cleared
> here if it was set just before.

Or maybe it is just before, as it doesn't check
c->ts.u.derived->attr.defined_assign_comp

Dear Mikael,

Thanks for the usually thorough review.

....snip....
> And here comes the next round of comments.
....snip....
>> +   e->rank = c && c->as ? c->as->rank : 0;
> This is bogus if  e->rank was != 0 previously (think of the case
> array(:)%scalar_comp).

mistaken maybe but not bogus!

> The c == NULL case should be handled at the beginning (if at all).
>
>> +   if (e->rank)
> the condition should be on c->as (for the case array(:)%scalar_comp again).

OK point taken.
....snip...
>> +   this_code->op = op;
> all calls are with op == EXEC_ASSIGN, you may as well hardcode it.

I thought to leave it general so that the function could be reused for
other purposes.

....snip...
.
>> +   gcc_assert (e->expr_type == EXPR_VARIABLE
>> + 	      || e->expr_type == EXPR_FUNCTION);
> As far as I know anything can be used, not only variables and functions.
> The derived type cases are a bit specific but at least array/structure
> constructors are missing.  There could be also typebound function calls
> (I never know whether they are EXPR_FUNCTION or something else).

The reason for this assert is the later use of e->symtree.  I'll see
what I can do to generalise it.
....snip....

> I guess it should be `t1%cmp {defined=} expr2%cmp'?

mmmm..... it might just be

>> + 	  || comp1->attr.proc_pointer_comp
> That one doesn't look right.

Why not?

> `this_code' should be cleared, otherwise it is used in the next iteration.
I'll check that this is not done in gfc_free_statements (no source to
hand at the moment) - I believe that it is.

....snip...

>> + 			= super_type->attr.defined_assign_comp;
> I guess Tobias' reported bug is here.  The flag shouldn't be cleared
> here if it was set just before.
>

I am sure that it is in this vicinity.... :-)

>
> To finish, I would like to draw your attention on the scalarizer not
> supporting multiple arrays in the reference chain.  The initial
> expressions are guaranteed to have at most one array in the chain, but
> as we add subfield references, that condition can not remain true.  We
> could try adding multiple references support in the scalarizer, but I
> don't know how difficult it would be.  Or maybe better fix it at the
> front-end AST level by using elemental functions to split the
> scalarization work.  Or something else.  What do you think?

resolve_expr punts on this, does it not?  I'll check.

I cannot conceivably come back to this for a week or so because
daytime and private life are overwhelmingly hectic (wife and daughter
moving back to UK).

Thanks again

Paul

On 19/09/2012 20:46, Paul Richard Thomas wrote:
>>> + 	  || comp1->attr.proc_pointer_comp
>> That one doesn't look right.
> 
> Why not?
It skips any component containing a procedure pointer subcomponent.
Actually, from looking at parse.c where the flag is set, it seems that
the flag is only set for derived types, not for components, so it's not
that bad; the condition never triggers.

> 
>> `this_code' should be cleared, otherwise it is used in the next iteration.
> I'll check that this is not done in gfc_free_statements (no source to
> hand at the moment) - I believe that it is.
To be clear, the _pointer_ should be cleared:
  this_code = NULL;

Mikael

Dear Mikael,

Thank you for the last review of my patch for this PR.  Since then, I
have had difficulty to find time for gfortran for both personal and
professional reasons.  Anyway, the attached is my attempt to remedy
the problems that you identified.

In a moment of madness, I clicked on "remove trailing white space"...
well, you can see the result!  Fortunately, all the meat of the patch
in a contiguous chunk so you just have to search for "add_comp_ref"
and you are there.

I THINK that this is pretty complete but you all proved me wrong last
time, so I am just awaiting the contradictions to that statement :-(

Array sections on the lhs are not handled as well as might be hoped,
when an lhs temporary is needed; the temporary comprises the full
array and the section is explicitly referenced.  Fortunately, it is
rare that memory is a problem these days so I have let it be.  Should
need arise, the temporary could be made allocatable and ALLOCATE
called explicitly (my attempts to use the reallocate on assign
mechanism failed for reasons that I could not see.  I'll try again
some other time.)

Note that I have had to punt on defined assignments when there is more
than one part reference involved.  The warning message suggests making
the loops explicit to make the defined assignment work.

I have made responses to your review below.  I also fixed the testcase
that Tobias posted in the subsequent correspondence.

Bootstrapped and regtested on x86_64/FC17 - OK for trunk?

Cheers

Paul

2012-11-18   Alessandro Fanfarillo <alessandro.fanfarillo@gmail.com>
             Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46897
	* gfortran.h : Add bit field 'defined_assign_comp' to
	symbol_attribute structure.
	Add primitive for gfc_add_full_array_ref.
	* expr.c (gfc_add_full_array_ref): New function.
	(gfc_lval_expr_from_sym): Call new function.
	* resolve.c (add_comp_ref): New function.
	(build_assignment): New function.
	(get_temp_from_expr): New function
	(add_code_to_chain): New function
	(generate_component_assignments): New function that calls all
	the above new functions.
	(resolve_code): Call generate_component_assignments.
	(check_defined_assignments): New function.
	(resolve_fl_derived0): Call check_defined_assignments.
	(gfc_resolve): Reset component_assignment_level in case it is
	left in a bad state by errors.


	* resolve.c (is_sym_host_assoc, resolve_procedure_interface,
	resolve_contained_fntype, resolve_procedure_expression,
	resolve_elemental_actual, resolve_global_procedure,
	is_scalar_expr_ptr, gfc_iso_c_func_interface, resolve_function,
	set_name_and_label, gfc_iso_c_sub_interface,
	resolve_specific_s0, resolve_operator, compare_bound_mpz_t,
	gfc_resolve_character_operator, resolve_typebound_function,
	gfc_resolve_expr, forall_index, remove_last_array_ref,
	conformable_arrays, resolve_allocate_expr,
	resolve_allocate_deallocate, resolve_select_type,
	resolve_transfer, resolve_where,
	gfc_resolve_where_code_in_forall, gfc_resolve_forall_body,
	gfc_count_forall_iterators, resolve_values,
	resolve_bind_c_comms, resolve_bind_c_derived_types,
	gfc_verify_binding_labels, apply_default_init,
	build_default_init_expr, apply_default_init_local,
	resolve_fl_var_and_proc, resolve_fl_procedure,
	gfc_resolve_finalizers, check_generic_tbp_ambiguity,
	resolve_typebound_intrinsic_op, resolve_typebound_procedure,
	resolve_typebound_procedures, ensure_not_abstract,
	resolve_fl_derived0, resolve_fl_parameter, resolve_symbol,
	resolve_equivalence_derived): Remove trailing white space.
	* gfortran.h : Remove trailing white space.

2012-01-18   Alessandro Fanfarillo <alessandro.fanfarillo@gmail.com>
             Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46897
	* gfortran.dg/defined_assignment_1.f90: New test.
	* gfortran.dg/defined_assignment_2.f90: New test.
	* gfortran.dg/defined_assignment_3.f90: New test.
	* gfortran.dg/defined_assignment_4.f90: New test.
	* gfortran.dg/defined_assignment_5.f90: New test.


On 17 September 2012 20:45, Mikael Morin <mikael.morin@sfr.fr> wrote:
> Hello,
....
> And here comes the next round of comments.
>
....
>> +   /* Add a full array ref, as necessary.  */
>> +   e->rank = c && c->as ? c->as->rank : 0;
> This is bogus if  e->rank was != 0 previously (think of the case
> array(:)%scalar_comp).
> The c == NULL case should be handled at the beginning (if at all).
>
>> +   if (e->rank)
> the condition should be on c->as (for the case array(:)%scalar_comp again).

eliminated
....
> all calls are with op == EXEC_ASSIGN, you may as well hardcode it.

see comment - I was contemplating more general use of this code.
....
>> +   gcc_assert (e->expr_type == EXPR_VARIABLE
>> +           || e->expr_type == EXPR_FUNCTION);
> As far as I know anything can be used, not only variables and functions.
> The derived type cases are a bit specific but at least array/structure
> constructors are missing.  There could be also typebound function calls
> (I never know whether they are EXPR_FUNCTION or something else).

eliminated
....

>> +    ! Now do the defined assignments
>> +       do over components with typebound defined assignment [%cmp]
>> +     expr2%cmp {defined=} t1%cmp
> I guess it should be `t1%cmp {defined=} expr2%cmp'?
>
>> +     expr1%cmp = t1%cmp           ! Store in the result
>> +         t1%cmp = t2%cmp              ! Restore the original value
> It seems to me that the last assignment isn't useful: once one component
> has been taken care of, we proceed with the next one, so `t1' can have
> garbage in the previous one without any impact.
> Then if it can be removed, `t2' is useless and then `temp_x' as well, so
> we could do with the simpler [still most of `t1' is useless]:
>    t1 = expr1
>    expr1 = expr2
>    t1%cmp {defined=} expr1%cmp
>    expr1%cmp = t1%cmp
>
> It would be nice too if the temporaries were avoided in the case there
> is no defined assignment with intent(inout) lhs, but I leave the
> decision to do it to you.
>

This has all been corrected.
....
>> +       || comp1->attr.pointer
>> +       || comp1->attr.allocatable
>> +       || comp1->attr.proc_pointer_comp
> That one doesn't look right.

It did not look right to me either - eliminating it causes a
regression - I forget which test now.
....

>> +           gfc_free_statements (this_code);
> `this_code' should be cleared, otherwise it is used in the next iteration.

It's been nulled on each occasion.

>
> free (head); ?

Done

>> +     sym->attr.defined_assign_comp
>> +                     = super_type->attr.defined_assign_comp;
> I guess Tobias' reported bug is here.  The flag shouldn't be cleared
> here if it was set just before.

This was all put right.

>> +
>>     /* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
>>        all DEFERRED bindings are overridden.  */
>>     if (super_type && super_type->attr.abstract && !sym->attr.abstract
>
>
> To finish, I would like to draw your attention on the scalarizer not
> supporting multiple arrays in the reference chain.  The initial
> expressions are guaranteed to have at most one array in the chain, but
> as we add subfield references, that condition can not remain true.  We
> could try adding multiple references support in the scalarizer, but I
> don't know how difficult it would be.  Or maybe better fix it at the
> front-end AST level by using elemental functions to split the
> scalarization work.  Or something else.  What do you think?

See the gfc_warning; If multiple array references are encountered, no
attempt is made to use the defined assignments and the user is advised
to make the (outer) loop explicit.

With best regards

Paul

Dear Paul,

thanks for the updated patch. While reading your patch, I was wondering 
whether the attached test case works or not.

Result: It does *not* print "Hello World" with neither gfortran nor 
crayftn. If one changes in "m3" the declared type of "x" from "t" to 
"t2", it shows "Hello World" with crayftn but still not with gfortran. I 
believe that it should show the message in both cases.

I think the call should be done in the generated _copy function, which 
brings me to the point about:

Paul Richard Thomas wrote:
> Note that I have had to punt on defined assignments when there is more
> than one part reference involved.  The warning message suggests making
> the loops explicit to make the defined assignment work.

If I recall correctly, Mikael was wondering whether this should be 
handled by an elemental procedure. As _copy is an elemental procedure, 
it might be used.


Tobias