Fwd: Subject: Re: [Patch, fortran] PR46897 - [OOP] type-bound defined ASSIGNMENT(=) not used for derived type component in intrinsic assign

[Paul Richard Thomas]

Dear All,

It is only now that I see that my mail to Mikael and the release
managers, to say that I would commit, bounced because of excess MIME
content.  I apologise for that.  I can only say in mitigation that
fortran is not release critical and regressions are unlikely because
of the conditions that the patch hides behind.

Thanks for the reviews Mikael!

Committed as revision 194016.

Paul




--
The knack of flying is learning how to throw yourself at the ground and miss.
   --Hitchhikers Guide to the Galaxy

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

[Tobias Burnus]

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
module m
type t
end type t
end module m

module m2
use m
private
type, extends(t), public :: t2
contains
   procedure :: assign1
   generic :: assignment(=)=assign1
end type t2
contains
  subroutine assign1(lhs,rhs)
class(t2),intent(out) :: lhs
class(t2),intent(in) :: rhs
print *, 'Hello World'
  end subroutine assign1
end module m2

module m3
  use m
  type t3
class(t), allocatable :: x
  end type t3
end module m3

module m4
contains
  subroutine init(y)
use m2
use m3
type(t3) :: y
allocate(t2 :: y%x)
  end subroutine init
end module m4

use m3
use m4
type(t3) :: a, b
call init(a)
b = a
end

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

[Paul Richard Thomas]

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'?

. 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

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

[Mikael Morin]

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

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

[Mikael Morin]

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

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

[Paul Richard Thomas]

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?

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

[Mikael Morin]

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
 +   

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

[Tobias Burnus]

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.)

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

[Paul Richard Thomas]

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.fanfari...@gmail.com
 Paul Thomas  pa...@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.fanfari...@gmail.com
 Paul Thomas  pa...@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.tho...@gmail.com wrote:
 Mikael,

 On 14 August 2012 10:42, Mikael Morin mikael.mo...@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

Index: gcc/fortran/gfortran.h
===
*** gcc/fortran/gfortran.h	(revision 191115)
--- gcc/fortran/gfortran.h	(working copy)
*** typedef struct
*** 786,794 
/* The symbol is a derived type with allocatable components, pointer 
   components or private components, procedure pointer components,
   possibly nested.  zero_comp is true if the derived type has no
!  component at all.  */
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
! 	   private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1;
  
/* This is a temporary selector for SELECT TYPE.  */
unsigned select_type_temporary:1;
--- 786,796 
/* The symbol is a derived type with allocatable components, pointer 
   components or private components, procedure pointer components,
   possibly nested.  zero_comp is true if the derived type has no
!  component at all.  defined_assign_comp is true if the derived
!  type or an ancestor has a typebound defined assignment.  */
unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
! 	   private_comp:1, zero_comp:1, coarray_comp:1, lock_comp:1,
! 	   defined_assign_comp:1;
  
/* This is a temporary selector for SELECT TYPE.  */
unsigned select_type_temporary:1;
*** gfc_try gfc_check_assign_symbol (gfc_sym
*** 2761,2766 
--- 2763,2769 
  bool gfc_has_default_initializer (gfc_symbol *);
  gfc_expr *gfc_default_initializer (gfc_typespec *);
  gfc_expr *gfc_get_variable_expr (gfc_symtree *);
+ void gfc_add_full_array_ref (gfc_expr *, gfc_array_spec *);
  gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
  
  gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
Index: gcc/fortran/expr.c
===
*** gcc/fortran/expr.c	(revision 191115)
--- gcc/fortran/expr.c	(working copy)
*** gfc_get_variable_expr (gfc_symtree *var)
*** 3878,3883 
--- 3878,3910 
  }
  
  
+ /* Adds a full array reference to an expression, as needed.  */
+ 
+ void
+ gfc_add_full_array_ref (gfc_expr *e, gfc_array_spec *as)
+ {
+   gfc_ref *ref;
+   for (ref = e-ref; ref; ref = ref-next)
+ if (!ref-next)
+   break;
+   if (ref)
+ {
+   

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

[Alessandro Fanfarillo]

Dear Paul,
Dear all,

I tried to compile the check_compiler_for_memory_leaks.F90 file
provided by Damian and it produces a segfault error. May be the
problem is related with add_comp_ref.

Regards

Alessandro (from Malta)

2012/8/14 Paul Richard Thomas paul.richard.tho...@gmail.com

 Dear Mikael,

  I think there are a couple of bugs not triggered by the single component
  types in the test. See below.

 Yes, you are right.  We should have tested multiple components... my
 fault!

  This could be moved to the only next caller (`previous' doesn't need to
  be updated if `this_code' is removed) to fix one usage of `this_code'
  :-).

 That's right... I'll make it so.

  ... but I have the feeling that this makes (*code) unreachable and that
  that's wrong. Shouldn't it be root-next = *code; ?

 No.  That caused the regression that I mentioned.  (*code) is
 resolved, at entry.  resolve_code steps on to (*code)-next.

  if we do it after the typebound calls, we overwrite their job so we have
  to do it before.

 This is what is done.

  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?

 Thanks for the review.  I believe, in summary, that I should handle
 'this_code' consistently so that multiple component defined
 assignments work correctly.  I should also verify that pointers do
 what they are supposed to do, although it is rather trivial.

 Cheers

 Paul




--

Dott. Alessandro Fanfarillo
Verificatore Ellisse
Cell: 339/2428012
Email: alessandro.fanfari...@gmail.com

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

[Mikael Morin]

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).

Mikael

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

[Mikael Morin]

On 14/08/2012 07:03, Paul Richard Thomas wrote:
 ... but I have the feeling that this makes (*code) unreachable and that
 that's wrong. Shouldn't it be root-next = *code; ?
 
 No.  That caused the regression that I mentioned.  (*code) is
 resolved, at entry.  resolve_code steps on to (*code)-next.
 
Yes, OK. Double pointers are really on the limits of my spirit.

Mikael

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

[Paul Richard Thomas]

Dear All,

Please find attached a patch and testcase for the above PR.  The
comment before generate_component_assignments explains the need for
the patch, which itself is fairly self explanatory.

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

Best regards

Paul and Alessandro.

2012-08-13   Alessandro Fanfarillo alessandro.fanfari...@gmail.com
 Paul Thomas  pa...@gcc.gnu.org

PR fortran/46897
* resolve.c (add_comp_ref): New function.
(generate_component_assignments): New function that calls
add_comp_ref.
(resolve_code): Call generate_component_assignments.

2012-08-13   Alessandro Fanfarillo alessandro.fanfari...@gmail.com
 Paul Thomas  pa...@gcc.gnu.org

PR fortran/46897
* gfortran.dg/defined_assignment_1.f90: New test.
Index: gcc/fortran/resolve.c
===
*** gcc/fortran/resolve.c	(revision 190338)
--- gcc/fortran/resolve.c	(working copy)
*** resolve_ordinary_assign (gfc_code *code,
*** 9485,9490 
--- 9485,9614 
  }
  
  
+ /* 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 = c-ts.u.derived;
+   (*ref)-u.c.component = c;
+   e-ts = c-ts;
+ }
+ 
+ 
+ /* 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.  */
+ 
+ static void
+ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
+ {
+   gfc_component *comp1, *comp2;
+   gfc_code *this_code, *next, *root, *previous;
+ 
+   /* Filter out continuing processing after an error.  */
+   if ((*code)-expr1-ts.type != BT_DERIVED
+   || (*code)-expr2-ts.type != BT_DERIVED)
+ return;
+ 
+   comp1 = (*code)-expr1-ts.u.derived-components;
+   comp2 = (*code)-expr2-ts.u.derived-components;
+ 
+   for (; comp1; comp1 = comp1-next, comp2 = comp2-next)
+ {
+   if (comp1-ts.type != BT_DERIVED
+ 	  || comp1-ts.u.derived == NULL
+ 	  || (comp1-attr.pointer || comp1-attr.allocatable)
+ 	  || (*code)-expr1-ts.u.derived == comp1-ts.u.derived)
+ 	continue;
+ 
+   /* Make an assigment for this component.  */
+   this_code = gfc_get_code ();
+   this_code-op = EXEC_ASSIGN;
+   this_code-next = NULL;
+   this_code-expr1 = gfc_copy_expr ((*code)-expr1);
+   this_code-expr2 = gfc_copy_expr ((*code)-expr2);
+ 
+   add_comp_ref (this_code-expr1, comp1);
+   add_comp_ref (this_code-expr2, comp2);
+ 
+   root = this_code;
+ 
+   /* Convert the assignment if there is a defined assignment for
+ 	 this type.  Otherwise, recurse into its components.  */
+   if (resolve_ordinary_assign (this_code, ns)
+ 	   this_code-op == EXEC_COMPCALL)
+ 	resolve_typebound_subroutine (this_code);
+   else if (this_code  this_code-op == EXEC_ASSIGN)
+ 	generate_component_assignments (this_code, ns);
+ 
+   previous = NULL;
+   this_code = root;
+ 
+   /* Go through the code chain eliminating all but calls to
+ 	 typebound procedures. Since we have been through
+ 	 resolve_typebound_subroutine. */
+   for (; this_code; this_code = this_code-next)
+ 	{
+ 	  if (this_code-op == EXEC_ASSIGN_CALL)
+ 	{
+ 	  gfc_symbol *fsym = this_code-symtree-n.sym-formal-sym;
+ 	  /* Check that there is a defined assignment.  If so, then
+ 	 resolve the call.  */
+ 	  if (fsym-ts.type == BT_CLASS
+ 		   CLASS_DATA (fsym)-ts.u.derived-f2k_derived
+ 		   CLASS_DATA (fsym)-ts.u.derived-f2k_derived
+ 			-tb_op[INTRINSIC_ASSIGN])
+ 		{
+ 		  resolve_call (this_code);
+ 		  goto next;
+ 		}
+ 	}
+ 
+ 	  next = this_code-next;
+ 	  if (this_code == root)
+ 	root = next;
+ 	  else
+ 	previous-next = next;
+ 
+ 	  next = this_code;
+ 	  next-next = NULL;
+ 	  gfc_free_statements (next);
+ 	next:
+ 	  previous = 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.  */
+   if (root)
+ 	{
+ 	  next = (*code)-next;
+ 	  (*code)-next = root;
+ 	  for (;root; root = root-next)
+ 	if (!root-next)
+ 	  break;
+ 	  root-next = next;
+ 	  *code = root;
+ 	}
+}
+ }
+ 

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

[Mikael Morin]

Hello Paul,

I think there are a couple of bugs not triggered by the single component
types in the test. See below.

On 13/08/2012 15:37, Paul Richard Thomas wrote:
 + 
 +   /* Go through the code chain eliminating all but calls to
 +  typebound procedures. Since we have been through
 +  resolve_typebound_subroutine. */
 +   for (; this_code; this_code = this_code-next)
 + {
 +   if (this_code-op == EXEC_ASSIGN_CALL)
 + {
 +   gfc_symbol *fsym = this_code-symtree-n.sym-formal-sym;
 +   /* Check that there is a defined assignment.  If so, then
 +  resolve the call.  */
 +   if (fsym-ts.type == BT_CLASS
 +CLASS_DATA (fsym)-ts.u.derived-f2k_derived
 +CLASS_DATA (fsym)-ts.u.derived-f2k_derived
 + -tb_op[INTRINSIC_ASSIGN])
 + {
 +   resolve_call (this_code);
 +   goto next;
 + }
 + }
 + 
 +   next = this_code-next;
 +   if (this_code == root)
 + root = next;
 +   else
 + previous-next = next;
 + 
 +   next = this_code;
 +   next-next = NULL;
 +   gfc_free_statements (next);
This frees `this_code', but `this_code' is used to iterate the loop and
below.

 + next:
 +   previous = this_code;
This could be moved to the only next caller (`previous' doesn't need to
be updated if `this_code' is removed) to fix one usage of `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.  */
This tells me that you know what you do...

 +   if (root)
 + {
 +   next = (*code)-next;
 +   (*code)-next = root;
 +   for (;root; root = root-next)
 + if (!root-next)
 +   break;
 +   root-next = next;
 +   *code = root;
 + }
... but I have the feeling that this makes (*code) unreachable and that
that's wrong. Shouldn't it be root-next = *code; ?
Maybe you want to remove (*code) at the first iteration (as it contains
the whole structure assignment), but in the next iteration, it contains
the first typebound call, etc, doesn't it?

By the way I'm not sure we can keep the whole structure assignment to
handle default assignment:
if we do it after the typebound calls, we overwrite their job so we have
to do it before.
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).

Thoughts?
Mikael

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

[Paul Richard Thomas]

Dear Mikael,

 I think there are a couple of bugs not triggered by the single component
 types in the test. See below.

Yes, you are right.  We should have tested multiple components... my fault!

 This could be moved to the only next caller (`previous' doesn't need to
 be updated if `this_code' is removed) to fix one usage of `this_code' :-).

That's right... I'll make it so.

 ... but I have the feeling that this makes (*code) unreachable and that
 that's wrong. Shouldn't it be root-next = *code; ?

No.  That caused the regression that I mentioned.  (*code) is
resolved, at entry.  resolve_code steps on to (*code)-next.

 if we do it after the typebound calls, we overwrite their job so we have
 to do it before.

This is what is done.

 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?

Thanks for the review.  I believe, in summary, that I should handle
'this_code' consistently so that multiple component defined
assignments work correctly.  I should also verify that pointers do
what they are supposed to do, although it is rather trivial.

Cheers

Paul