[Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 1509 bytes --]

Hi all,

here is my patch for this PR. After my original fix in comment #1 had
been lying around for more than a week, I finally managed to get rid
of the regression (see comment #5).

Moreover I also did some cleanup. When allocating a CLASS variable,
the size of the allocated memory is used in several places: For the
actual allocation, initialization via memcpy, settig the '$size'
field, etc. There are several possible cases for this size: It can be
fixed at compile time in some cases, while in others it has to be
determined at run-time. Before this patch, the size was re-evaluated
in every place where it was used. Now I use a tree variable 'memsz',
which remembers the size, so that it can be reused, which simplifies
the code a lot.

Salvatore: I hope this already fixes some of the runtime trouble
you're seeing (it seems you use CLASS allocation with SOURCE quite a
bit, though I haven't checked if this particular case appears (SOURCE
being non-CLASS)).

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2009-10-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41714
	* trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
	call to '__builtin_memcpy' is optimized away (replaced by a direct
	assignment).
	* trans-stmt.c (gfc_trans_allocate): Do correct data initialization for
	CLASS variables with SOURCE tag, plus some cleanup.


2009-10-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41714
	* gfortran.dg/class_allocate_4.f03: New test.

[-- Attachment #2: pr41714_v3.diff --]
[-- Type: text/x-diff, Size: 5431 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 153538)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -4888,7 +4888,10 @@ gfc_build_memcpy_call (tree dst, tree src, tree le
   /* Construct call to __builtin_memcpy.  */
   tmp = build_call_expr_loc (input_location,
 			 built_in_decls[BUILT_IN_MEMCPY], 3, dst, src, len);
-  return fold_convert (void_type_node, tmp);
+  if (TREE_CODE (tmp) == NOP_EXPR)
+    return tmp;
+  else
+    return fold_convert (void_type_node, tmp);
 }
 
 
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 153538)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -3983,12 +3983,13 @@ gfc_trans_allocate (gfc_code * code)
   tree stat;
   tree pstat;
   tree error_label;
+  tree memsz;
   stmtblock_t block;
 
   if (!code->ext.alloc.list)
     return NULL_TREE;
 
-  pstat = stat = error_label = tmp = NULL_TREE;
+  pstat = stat = error_label = tmp = memsz = NULL_TREE;
 
   gfc_start_block (&block);
 
@@ -4032,19 +4033,19 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_init_se (&se_sz, NULL);
 	      gfc_conv_expr (&se_sz, sz);
 	      gfc_free_expr (sz);
-	      tmp = se_sz.expr;
+	      memsz = se_sz.expr;
 	    }
 	  else if (code->expr3 && code->expr3->ts.type != BT_CLASS)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
 	  else if (code->ext.alloc.ts.type != BT_UNKNOWN)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
 	  else
-	    tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
+	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
-	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
-	    tmp = se.string_length;
+	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
+	    memsz = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -4075,21 +4076,17 @@ gfc_trans_allocate (gfc_code * code)
       if (code->expr3)
 	{
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
-	  if (rhs->ts.type == BT_CLASS)
+	  if (al->expr->ts.type == BT_CLASS)
 	    {
-	      gfc_se dst,src,len;
-	      gfc_expr *sz;
-	      gfc_add_component_ref (rhs, "$data");
-	      sz = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (sz, "$size");
+	      gfc_se dst,src;
+	      if (rhs->ts.type == BT_CLASS)
+		gfc_add_component_ref (rhs, "$data");
 	      gfc_init_se (&dst, NULL);
 	      gfc_init_se (&src, NULL);
-	      gfc_init_se (&len, NULL);
 	      gfc_conv_expr (&dst, expr);
 	      gfc_conv_expr (&src, rhs);
-	      gfc_conv_expr (&len, sz);
-	      gfc_free_expr (sz);
-	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, len.expr);
+	      gfc_add_block_to_block (&block, &src.pre);
+	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	    }
 	  else
 	    tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
@@ -4108,8 +4105,7 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_conv_expr (&dst, expr);
 	  gfc_conv_expr (&src, init_e);
 	  gfc_add_block_to_block (&block, &src.pre);
-	  tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
-	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, tmp);
+	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
       /* Add default initializer for those derived types that need them.  */
@@ -4127,6 +4123,7 @@ gfc_trans_allocate (gfc_code * code)
       if (expr->ts.type == BT_CLASS)
 	{
 	  gfc_expr *lhs,*rhs;
+	  gfc_se lse;
 	  /* Initialize VINDEX for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$vindex");
@@ -4158,36 +4155,11 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialize SIZE for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$size");
-	  rhs = NULL;
-	  if (code->expr3 && code->expr3->ts.type == BT_CLASS)
-	    {
-	      /* Size must be determined at run time.  */
-	      rhs = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (rhs, "$size");
-	      tmp = gfc_trans_assignment (lhs, rhs, false);
-	      gfc_add_expr_to_block (&block, tmp);
-	    }
-	  else
-	    {
-	      /* Size is fixed at compile time.  */
-	      gfc_typespec *ts;
-	      gfc_se lse;
-	      gfc_init_se (&lse, NULL);
-	      gfc_conv_expr (&lse, lhs);
-	      if (code->expr3)
-		ts = &code->expr3->ts;
-	      else if (code->ext.alloc.ts.type == BT_DERIVED)
-		ts = &code->ext.alloc.ts;
-	      else if (expr->ts.type == BT_CLASS)
-		ts = &expr->ts.u.derived->components->ts;
-	      else
-		ts = &expr->ts;
-	      tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
-	      gfc_add_modify (&block, lse.expr,
-			      fold_convert (TREE_TYPE (lse.expr), tmp));
-	    }
+	  gfc_init_se (&lse, NULL);
+	  gfc_conv_expr (&lse, lhs);
+	  gfc_add_modify (&block, lse.expr,
+			  fold_convert (TREE_TYPE (lse.expr), memsz));
 	  gfc_free_expr (lhs);
-	  gfc_free_expr (rhs);
 	}
 
     }

[-- Attachment #3: class_allocate_4.f03 --]
[-- Type: application/octet-stream, Size: 424 bytes --]

! { dg-do run }
!
! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

type t
  integer :: i
end type t
type, extends(t) :: t2
  integer :: j
end type t2

class(t), allocatable :: a
allocate(a, source=t2(1,2))
print *,a%i
if(a%i /= 1) call abort()
select type (a)
  type is (t2)
     print *,a%j
     if(a%j /= 2) call abort()
end select
end

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Paul Richard Thomas]

Janus,

It looks OK to me except:

>        PR fortran/41714
>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>        assignment).

How the heck does that work?  It comes out as a NOP_EXPR and yet it's
really an assignment..... Is that documented somewhere?

Cheers

Paul

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Richard Guenther]

On Sun, Oct 25, 2009 at 3:52 PM, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Janus,
>
> It looks OK to me except:
>
>>        PR fortran/41714
>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>        assignment).
>
> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
> really an assignment..... Is that documented somewhere?

That patch looks indeed dubious.  It tests for an implementation detail
(the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
be able to unconditionally fold-convert to void_type_node as in the
original code.  Instead tree_annotate_all_with_location should be fixed.

Richard.

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Richard Guenther]

On Sun, Oct 25, 2009 at 4:10 PM, Richard Guenther
<richard.guenther@gmail.com> wrote:
> On Sun, Oct 25, 2009 at 3:52 PM, Paul Richard Thomas
> <paul.richard.thomas@gmail.com> wrote:
>> Janus,
>>
>> It looks OK to me except:
>>
>>>        PR fortran/41714
>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>        assignment).
>>
>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>> really an assignment..... Is that documented somewhere?
>
> That patch looks indeed dubious.  It tests for an implementation detail
> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
> be able to unconditionally fold-convert to void_type_node as in the
> original code.  Instead tree_annotate_all_with_location should be fixed.

Or rather the FE should not call this function - it assumes that the code
is already gimplified.

Richard.

> Richard.
>

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

>>> It looks OK to me except:
>>>
>>>>        PR fortran/41714
>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>        assignment).
>>>
>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>> really an assignment..... Is that documented somewhere?
>>
>> That patch looks indeed dubious.  It tests for an implementation detail
>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>> be able to unconditionally fold-convert to void_type_node as in the
>> original code.  Instead tree_annotate_all_with_location should be fixed.
>
> Or rather the FE should not call this function - it assumes that the code
> is already gimplified.

Ok, so you mean one should instead just do the stuff which this
function does, but without the extra checks? Like here:

Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (Revision 153538)
+++ gcc/fortran/trans.c (Arbeitskopie)
@@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
        {
          if (TREE_CODE (res) == STATEMENT_LIST)
-           tree_annotate_all_with_location (&res, input_location);
+           {
+             tree_stmt_iterator i;
+             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
+               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
+           }
          else
            SET_EXPR_LOCATION (res, input_location);


Note: Maybe one should rather use 'tree_annotate_one_with_location'
instead of SET_EXPR_LOCATION, but right now this is static in
gimplify.c.

Cheers,
Janus

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Richard Guenther]

On Sun, Oct 25, 2009 at 6:56 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>>> It looks OK to me except:
>>>>
>>>>>        PR fortran/41714
>>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>>        assignment).
>>>>
>>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>>> really an assignment..... Is that documented somewhere?
>>>
>>> That patch looks indeed dubious.  It tests for an implementation detail
>>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>>> be able to unconditionally fold-convert to void_type_node as in the
>>> original code.  Instead tree_annotate_all_with_location should be fixed.
>>
>> Or rather the FE should not call this function - it assumes that the code
>> is already gimplified.
>
> Ok, so you mean one should instead just do the stuff which this
> function does, but without the extra checks? Like here:
>
> Index: gcc/fortran/trans.c
> ===================================================================
> --- gcc/fortran/trans.c (Revision 153538)
> +++ gcc/fortran/trans.c (Arbeitskopie)
> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>        {
>          if (TREE_CODE (res) == STATEMENT_LIST)
> -           tree_annotate_all_with_location (&res, input_location);
> +           {
> +             tree_stmt_iterator i;
> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
> +           }
>          else
>            SET_EXPR_LOCATION (res, input_location);

No.  I think the above should just be dropped (as well as the other
call in the Fortran frontend).  The location should have been set
by the various stmt builders (like build_call_expr_loc in the
memcpy case).  For the folding of memcpy case
the folder will have distributed the locations appropriately.

The middle-end function can then be removed completely (the Fortran
FE is the only caller).  A patch to do so is pre-approved.

Thanks,
Richard.

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 2408 bytes --]

2009/10/25 Richard Guenther <richard.guenther@gmail.com>:
> On Sun, Oct 25, 2009 at 6:56 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>>>> It looks OK to me except:
>>>>>
>>>>>>        PR fortran/41714
>>>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>>>        assignment).
>>>>>
>>>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>>>> really an assignment..... Is that documented somewhere?
>>>>
>>>> That patch looks indeed dubious.  It tests for an implementation detail
>>>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>>>> be able to unconditionally fold-convert to void_type_node as in the
>>>> original code.  Instead tree_annotate_all_with_location should be fixed.
>>>
>>> Or rather the FE should not call this function - it assumes that the code
>>> is already gimplified.
>>
>> Ok, so you mean one should instead just do the stuff which this
>> function does, but without the extra checks? Like here:
>>
>> Index: gcc/fortran/trans.c
>> ===================================================================
>> --- gcc/fortran/trans.c (Revision 153538)
>> +++ gcc/fortran/trans.c (Arbeitskopie)
>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>        {
>>          if (TREE_CODE (res) == STATEMENT_LIST)
>> -           tree_annotate_all_with_location (&res, input_location);
>> +           {
>> +             tree_stmt_iterator i;
>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>> +           }
>>          else
>>            SET_EXPR_LOCATION (res, input_location);
>
> No.  I think the above should just be dropped (as well as the other
> call in the Fortran frontend).  The location should have been set
> by the various stmt builders (like build_call_expr_loc in the
> memcpy case).  For the folding of memcpy case
> the folder will have distributed the locations appropriately.
>
> The middle-end function can then be removed completely (the Fortran
> FE is the only caller).  A patch to do so is pre-approved.

Alright. Regtesting the attached patch now. Thanks for your help, Richard!

Cheers,
Janus

[-- Attachment #2: pr41714_v4.diff --]
[-- Type: text/x-diff, Size: 8530 bytes --]

Index: gcc/testsuite/gfortran.dg/class_allocate_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer :: i
+end type t
+type, extends(t) :: t2
+  integer :: j
+end type t2
+
+class(t), allocatable :: a
+allocate(a, source=t2(1,2))
+print *,a%i
+if(a%i /= 1) call abort()
+select type (a)
+  type is (t2)
+     print *,a%j
+     if(a%j /= 2) call abort()
+end select
+end
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(Revision 153541)
+++ gcc/fortran/trans-openmp.c	(Arbeitskopie)
@@ -1641,11 +1641,6 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_c
 
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
 	{
-	  if (TREE_CODE (res) == STATEMENT_LIST)
-	    tree_annotate_all_with_location (&res, input_location);
-	  else
-	    SET_EXPR_LOCATION (res, input_location);
-
 	  if (prev_singleunit)
 	    {
 	      if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 153541)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -3983,12 +3983,13 @@ gfc_trans_allocate (gfc_code * code)
   tree stat;
   tree pstat;
   tree error_label;
+  tree memsz;
   stmtblock_t block;
 
   if (!code->ext.alloc.list)
     return NULL_TREE;
 
-  pstat = stat = error_label = tmp = NULL_TREE;
+  pstat = stat = error_label = tmp = memsz = NULL_TREE;
 
   gfc_start_block (&block);
 
@@ -4032,19 +4033,19 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_init_se (&se_sz, NULL);
 	      gfc_conv_expr (&se_sz, sz);
 	      gfc_free_expr (sz);
-	      tmp = se_sz.expr;
+	      memsz = se_sz.expr;
 	    }
 	  else if (code->expr3 && code->expr3->ts.type != BT_CLASS)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
 	  else if (code->ext.alloc.ts.type != BT_UNKNOWN)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
 	  else
-	    tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
+	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
-	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
-	    tmp = se.string_length;
+	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
+	    memsz = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -4075,21 +4076,17 @@ gfc_trans_allocate (gfc_code * code)
       if (code->expr3)
 	{
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
-	  if (rhs->ts.type == BT_CLASS)
+	  if (al->expr->ts.type == BT_CLASS)
 	    {
-	      gfc_se dst,src,len;
-	      gfc_expr *sz;
-	      gfc_add_component_ref (rhs, "$data");
-	      sz = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (sz, "$size");
+	      gfc_se dst,src;
+	      if (rhs->ts.type == BT_CLASS)
+		gfc_add_component_ref (rhs, "$data");
 	      gfc_init_se (&dst, NULL);
 	      gfc_init_se (&src, NULL);
-	      gfc_init_se (&len, NULL);
 	      gfc_conv_expr (&dst, expr);
 	      gfc_conv_expr (&src, rhs);
-	      gfc_conv_expr (&len, sz);
-	      gfc_free_expr (sz);
-	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, len.expr);
+	      gfc_add_block_to_block (&block, &src.pre);
+	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	    }
 	  else
 	    tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
@@ -4108,8 +4105,7 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_conv_expr (&dst, expr);
 	  gfc_conv_expr (&src, init_e);
 	  gfc_add_block_to_block (&block, &src.pre);
-	  tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
-	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, tmp);
+	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
       /* Add default initializer for those derived types that need them.  */
@@ -4127,6 +4123,7 @@ gfc_trans_allocate (gfc_code * code)
       if (expr->ts.type == BT_CLASS)
 	{
 	  gfc_expr *lhs,*rhs;
+	  gfc_se lse;
 	  /* Initialize VINDEX for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$vindex");
@@ -4158,36 +4155,11 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialize SIZE for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$size");
-	  rhs = NULL;
-	  if (code->expr3 && code->expr3->ts.type == BT_CLASS)
-	    {
-	      /* Size must be determined at run time.  */
-	      rhs = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (rhs, "$size");
-	      tmp = gfc_trans_assignment (lhs, rhs, false);
-	      gfc_add_expr_to_block (&block, tmp);
-	    }
-	  else
-	    {
-	      /* Size is fixed at compile time.  */
-	      gfc_typespec *ts;
-	      gfc_se lse;
-	      gfc_init_se (&lse, NULL);
-	      gfc_conv_expr (&lse, lhs);
-	      if (code->expr3)
-		ts = &code->expr3->ts;
-	      else if (code->ext.alloc.ts.type == BT_DERIVED)
-		ts = &code->ext.alloc.ts;
-	      else if (expr->ts.type == BT_CLASS)
-		ts = &expr->ts.u.derived->components->ts;
-	      else
-		ts = &expr->ts;
-	      tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
-	      gfc_add_modify (&block, lse.expr,
-			      fold_convert (TREE_TYPE (lse.expr), tmp));
-	    }
+	  gfc_init_se (&lse, NULL);
+	  gfc_conv_expr (&lse, lhs);
+	  gfc_add_modify (&block, lse.expr,
+			  fold_convert (TREE_TYPE (lse.expr), memsz));
 	  gfc_free_expr (lhs);
-	  gfc_free_expr (rhs);
 	}
 
     }
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(Revision 153541)
+++ gcc/fortran/trans.c	(Arbeitskopie)
@@ -1279,16 +1279,9 @@ gfc_trans_code (gfc_code * code)
 
       gfc_set_backend_locus (&code->loc);
 
+      /* Add the new statement to the block.  */
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
-	{
-	  if (TREE_CODE (res) == STATEMENT_LIST)
-	    tree_annotate_all_with_location (&res, input_location);
-	  else
-	    SET_EXPR_LOCATION (res, input_location);
-	    
-	  /* Add the new statement to the block.  */
-	  gfc_add_expr_to_block (&block, res);
-	}
+	gfc_add_expr_to_block (&block, res);
     }
 
   /* Return the finished block.  */
Index: gcc/gimplify.c
===================================================================
--- gcc/gimplify.c	(Revision 153541)
+++ gcc/gimplify.c	(Arbeitskopie)
@@ -872,30 +872,7 @@ annotate_all_with_location (gimple_seq stmt_p, loc
     }
 }
 
-/* Same, but for statement or statement list in *STMT_P.  */
 
-void
-tree_annotate_all_with_location (tree *stmt_p, location_t location)
-{
-  tree_stmt_iterator i;
-
-  if (!*stmt_p)
-    return;
-
-  for (i = tsi_start (*stmt_p); !tsi_end_p (i); tsi_next (&i))
-    {
-      tree t = tsi_stmt (i);
-
-      /* Assuming we've already been gimplified, we shouldn't
-	  see nested chaining constructs anymore.  */
-      gcc_assert (TREE_CODE (t) != STATEMENT_LIST
-		  && TREE_CODE (t) != COMPOUND_EXPR);
-
-      tree_annotate_one_with_location (t, location);
-    }
-}
-
-
 /* Similar to copy_tree_r() but do not copy SAVE_EXPR or TARGET_EXPR nodes.
    These nodes model computations that should only be done once.  If we
    were to unshare something like SAVE_EXPR(i++), the gimplification
Index: gcc/gimple.h
===================================================================
--- gcc/gimple.h	(Revision 153541)
+++ gcc/gimple.h	(Arbeitskopie)
@@ -939,7 +939,6 @@ extern tree create_tmp_var (tree, const char *);
 extern tree get_initialized_tmp_var (tree, gimple_seq *, gimple_seq *);
 extern tree get_formal_tmp_var (tree, gimple_seq *);
 extern void declare_vars (tree, gimple, bool);
-extern void tree_annotate_all_with_location (tree *, location_t);
 extern void annotate_all_with_location (gimple_seq, location_t);
 
 /* Validation of GIMPLE expressions.  Note that these predicates only check

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 5475 bytes --]

>>>>>> It looks OK to me except:
>>>>>>
>>>>>>>        PR fortran/41714
>>>>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>>>>        assignment).
>>>>>>
>>>>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>>>>> really an assignment..... Is that documented somewhere?
>>>>>
>>>>> That patch looks indeed dubious.  It tests for an implementation detail
>>>>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>>>>> be able to unconditionally fold-convert to void_type_node as in the
>>>>> original code.  Instead tree_annotate_all_with_location should be fixed.
>>>>
>>>> Or rather the FE should not call this function - it assumes that the code
>>>> is already gimplified.
>>>
>>> Ok, so you mean one should instead just do the stuff which this
>>> function does, but without the extra checks? Like here:
>>>
>>> Index: gcc/fortran/trans.c
>>> ===================================================================
>>> --- gcc/fortran/trans.c (Revision 153538)
>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>        {
>>>          if (TREE_CODE (res) == STATEMENT_LIST)
>>> -           tree_annotate_all_with_location (&res, input_location);
>>> +           {
>>> +             tree_stmt_iterator i;
>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>> +           }
>>>          else
>>>            SET_EXPR_LOCATION (res, input_location);
>>
>> No.  I think the above should just be dropped (as well as the other
>> call in the Fortran frontend).  The location should have been set
>> by the various stmt builders (like build_call_expr_loc in the
>> memcpy case).  For the folding of memcpy case
>> the folder will have distributed the locations appropriately.
>>
>> The middle-end function can then be removed completely (the Fortran
>> FE is the only caller).  A patch to do so is pre-approved.
>
> Alright. Regtesting the attached patch now.

Regtesting was not successful, unfortunately:

FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 14)
FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O   (test for warnings, line 13)
FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O   (test for warnings, line 10)
FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O   (test for warnings, line 11)
FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O   (test for warnings, line 9)
FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/block-1.f90  -O   (test for errors, line 5)
FAIL: gfortran.dg/gomp/block-1.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 19)
FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 20)
FAIL: gfortran.dg/gomp/crayptr3.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 8)
FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 10)
FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 21)
FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 22)
FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 33)
FAIL: gfortran.dg/gomp/pr33439.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 12)
FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 24)
FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 25)
FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 26)
FAIL: gfortran.dg/gomp/sharing-1.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 12)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 16)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 57)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 58)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 64)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 65)
FAIL: gfortran.dg/gomp/sharing-2.f90  -O  (test for excess errors)
FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 28)
FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 30)
FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 33)
FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 34)
FAIL: gfortran.dg/gomp/sharing-3.f90  -O  (test for excess errors)


It seems removing 'tree_annotate_all_with_location' in trans-openmp.c
was no good idea.

I will commit the patch without the changes in gimple.h, gimplify.c
and trans-openmp.c (as attached) after another regtest if no one
protests.

Cheers,
Janus

[-- Attachment #2: pr41714_v5.diff --]
[-- Type: text/x-diff, Size: 6301 bytes --]

Index: gcc/testsuite/gfortran.dg/class_allocate_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer :: i
+end type t
+type, extends(t) :: t2
+  integer :: j
+end type t2
+
+class(t), allocatable :: a
+allocate(a, source=t2(1,2))
+print *,a%i
+if(a%i /= 1) call abort()
+select type (a)
+  type is (t2)
+     print *,a%j
+     if(a%j /= 2) call abort()
+end select
+end
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 153541)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -3983,12 +3983,13 @@ gfc_trans_allocate (gfc_code * code)
   tree stat;
   tree pstat;
   tree error_label;
+  tree memsz;
   stmtblock_t block;
 
   if (!code->ext.alloc.list)
     return NULL_TREE;
 
-  pstat = stat = error_label = tmp = NULL_TREE;
+  pstat = stat = error_label = tmp = memsz = NULL_TREE;
 
   gfc_start_block (&block);
 
@@ -4032,19 +4033,19 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_init_se (&se_sz, NULL);
 	      gfc_conv_expr (&se_sz, sz);
 	      gfc_free_expr (sz);
-	      tmp = se_sz.expr;
+	      memsz = se_sz.expr;
 	    }
 	  else if (code->expr3 && code->expr3->ts.type != BT_CLASS)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
 	  else if (code->ext.alloc.ts.type != BT_UNKNOWN)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
 	  else
-	    tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
+	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
-	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
-	    tmp = se.string_length;
+	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
+	    memsz = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -4075,21 +4076,17 @@ gfc_trans_allocate (gfc_code * code)
       if (code->expr3)
 	{
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
-	  if (rhs->ts.type == BT_CLASS)
+	  if (al->expr->ts.type == BT_CLASS)
 	    {
-	      gfc_se dst,src,len;
-	      gfc_expr *sz;
-	      gfc_add_component_ref (rhs, "$data");
-	      sz = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (sz, "$size");
+	      gfc_se dst,src;
+	      if (rhs->ts.type == BT_CLASS)
+		gfc_add_component_ref (rhs, "$data");
 	      gfc_init_se (&dst, NULL);
 	      gfc_init_se (&src, NULL);
-	      gfc_init_se (&len, NULL);
 	      gfc_conv_expr (&dst, expr);
 	      gfc_conv_expr (&src, rhs);
-	      gfc_conv_expr (&len, sz);
-	      gfc_free_expr (sz);
-	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, len.expr);
+	      gfc_add_block_to_block (&block, &src.pre);
+	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	    }
 	  else
 	    tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
@@ -4108,8 +4105,7 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_conv_expr (&dst, expr);
 	  gfc_conv_expr (&src, init_e);
 	  gfc_add_block_to_block (&block, &src.pre);
-	  tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
-	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, tmp);
+	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
       /* Add default initializer for those derived types that need them.  */
@@ -4127,6 +4123,7 @@ gfc_trans_allocate (gfc_code * code)
       if (expr->ts.type == BT_CLASS)
 	{
 	  gfc_expr *lhs,*rhs;
+	  gfc_se lse;
 	  /* Initialize VINDEX for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$vindex");
@@ -4158,36 +4155,11 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialize SIZE for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$size");
-	  rhs = NULL;
-	  if (code->expr3 && code->expr3->ts.type == BT_CLASS)
-	    {
-	      /* Size must be determined at run time.  */
-	      rhs = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (rhs, "$size");
-	      tmp = gfc_trans_assignment (lhs, rhs, false);
-	      gfc_add_expr_to_block (&block, tmp);
-	    }
-	  else
-	    {
-	      /* Size is fixed at compile time.  */
-	      gfc_typespec *ts;
-	      gfc_se lse;
-	      gfc_init_se (&lse, NULL);
-	      gfc_conv_expr (&lse, lhs);
-	      if (code->expr3)
-		ts = &code->expr3->ts;
-	      else if (code->ext.alloc.ts.type == BT_DERIVED)
-		ts = &code->ext.alloc.ts;
-	      else if (expr->ts.type == BT_CLASS)
-		ts = &expr->ts.u.derived->components->ts;
-	      else
-		ts = &expr->ts;
-	      tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
-	      gfc_add_modify (&block, lse.expr,
-			      fold_convert (TREE_TYPE (lse.expr), tmp));
-	    }
+	  gfc_init_se (&lse, NULL);
+	  gfc_conv_expr (&lse, lhs);
+	  gfc_add_modify (&block, lse.expr,
+			  fold_convert (TREE_TYPE (lse.expr), memsz));
 	  gfc_free_expr (lhs);
-	  gfc_free_expr (rhs);
 	}
 
     }
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(Revision 153541)
+++ gcc/fortran/trans.c	(Arbeitskopie)
@@ -1279,16 +1279,9 @@ gfc_trans_code (gfc_code * code)
 
       gfc_set_backend_locus (&code->loc);
 
+      /* Add the new statement to the block.  */
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
-	{
-	  if (TREE_CODE (res) == STATEMENT_LIST)
-	    tree_annotate_all_with_location (&res, input_location);
-	  else
-	    SET_EXPR_LOCATION (res, input_location);
-	    
-	  /* Add the new statement to the block.  */
-	  gfc_add_expr_to_block (&block, res);
-	}
+	gfc_add_expr_to_block (&block, res);
     }
 
   /* Return the finished block.  */

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

2009/10/25 Janus Weil <janus@gcc.gnu.org>:
>>>>>>> It looks OK to me except:
>>>>>>>
>>>>>>>>        PR fortran/41714
>>>>>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>>>>>        assignment).
>>>>>>>
>>>>>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>>>>>> really an assignment..... Is that documented somewhere?
>>>>>>
>>>>>> That patch looks indeed dubious.  It tests for an implementation detail
>>>>>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>>>>>> be able to unconditionally fold-convert to void_type_node as in the
>>>>>> original code.  Instead tree_annotate_all_with_location should be fixed.
>>>>>
>>>>> Or rather the FE should not call this function - it assumes that the code
>>>>> is already gimplified.
>>>>
>>>> Ok, so you mean one should instead just do the stuff which this
>>>> function does, but without the extra checks? Like here:
>>>>
>>>> Index: gcc/fortran/trans.c
>>>> ===================================================================
>>>> --- gcc/fortran/trans.c (Revision 153538)
>>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>>       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>>        {
>>>>          if (TREE_CODE (res) == STATEMENT_LIST)
>>>> -           tree_annotate_all_with_location (&res, input_location);
>>>> +           {
>>>> +             tree_stmt_iterator i;
>>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>>> +           }
>>>>          else
>>>>            SET_EXPR_LOCATION (res, input_location);
>>>
>>> No.  I think the above should just be dropped (as well as the other
>>> call in the Fortran frontend).  The location should have been set
>>> by the various stmt builders (like build_call_expr_loc in the
>>> memcpy case).  For the folding of memcpy case
>>> the folder will have distributed the locations appropriately.
>>>
>>> The middle-end function can then be removed completely (the Fortran
>>> FE is the only caller).  A patch to do so is pre-approved.
>>
>> Alright. Regtesting the attached patch now.
>
> Regtesting was not successful, unfortunately:
>
> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 14)
> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O   (test for warnings, line 13)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O   (test for warnings, line 10)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O   (test for warnings, line 11)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O   (test for warnings, line 9)
> FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/block-1.f90  -O   (test for errors, line 5)
> FAIL: gfortran.dg/gomp/block-1.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 19)
> FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 20)
> FAIL: gfortran.dg/gomp/crayptr3.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 8)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 10)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 21)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 22)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 33)
> FAIL: gfortran.dg/gomp/pr33439.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 12)
> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 24)
> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 25)
> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 26)
> FAIL: gfortran.dg/gomp/sharing-1.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 12)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 16)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 57)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 58)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 64)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 65)
> FAIL: gfortran.dg/gomp/sharing-2.f90  -O  (test for excess errors)
> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 28)
> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 30)
> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 33)
> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 34)
> FAIL: gfortran.dg/gomp/sharing-3.f90  -O  (test for excess errors)
>
>
> It seems removing 'tree_annotate_all_with_location' in trans-openmp.c
> was no good idea.

Huh. I was assuming all of the above regressions were due to the hunk
in trans-openmp.c. However, it turns out they are still present after
removing it. Which means they must be due to the removal of
'tree_annotate_all_with_location' in trans.c.

So, what to do? Are we back to

Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c (Revision 153538)
+++ gcc/fortran/trans.c (Arbeitskopie)
@@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
       {
         if (TREE_CODE (res) == STATEMENT_LIST)
-           tree_annotate_all_with_location (&res, input_location);
+           {
+             tree_stmt_iterator i;
+             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
+               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
+           }
         else
           SET_EXPR_LOCATION (res, input_location);

or is there a better option? (One alternative could be to set the
location only for OpenMP cases, since all other things seem to work?)

Cheers,
Janus

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Richard Guenther]

On Sun, Oct 25, 2009 at 10:42 PM, Janus Weil <janus@gcc.gnu.org> wrote:
> 2009/10/25 Janus Weil <janus@gcc.gnu.org>:
>>>>>>>> It looks OK to me except:
>>>>>>>>
>>>>>>>>>        PR fortran/41714
>>>>>>>>>        * trans-expr.c (gfc_build_memcpy_call): Take care of the case that the
>>>>>>>>>        call to '__builtin_memcpy' is optimized away (replaced by a direct
>>>>>>>>>        assignment).
>>>>>>>>
>>>>>>>> How the heck does that work?  It comes out as a NOP_EXPR and yet it's
>>>>>>>> really an assignment..... Is that documented somewhere?
>>>>>>>
>>>>>>> That patch looks indeed dubious.  It tests for an implementation detail
>>>>>>> (the memcpy folder returns (void *) ({ *dst = *src; dst; })).  You should
>>>>>>> be able to unconditionally fold-convert to void_type_node as in the
>>>>>>> original code.  Instead tree_annotate_all_with_location should be fixed.
>>>>>>
>>>>>> Or rather the FE should not call this function - it assumes that the code
>>>>>> is already gimplified.
>>>>>
>>>>> Ok, so you mean one should instead just do the stuff which this
>>>>> function does, but without the extra checks? Like here:
>>>>>
>>>>> Index: gcc/fortran/trans.c
>>>>> ===================================================================
>>>>> --- gcc/fortran/trans.c (Revision 153538)
>>>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>>>       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>>>        {
>>>>>          if (TREE_CODE (res) == STATEMENT_LIST)
>>>>> -           tree_annotate_all_with_location (&res, input_location);
>>>>> +           {
>>>>> +             tree_stmt_iterator i;
>>>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>>>> +           }
>>>>>          else
>>>>>            SET_EXPR_LOCATION (res, input_location);
>>>>
>>>> No.  I think the above should just be dropped (as well as the other
>>>> call in the Fortran frontend).  The location should have been set
>>>> by the various stmt builders (like build_call_expr_loc in the
>>>> memcpy case).  For the folding of memcpy case
>>>> the folder will have distributed the locations appropriately.
>>>>
>>>> The middle-end function can then be removed completely (the Fortran
>>>> FE is the only caller).  A patch to do so is pre-approved.
>>>
>>> Alright. Regtesting the attached patch now.
>>
>> Regtesting was not successful, unfortunately:
>>
>> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
>> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 14)
>> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O   (test for errors, line 20)
>> FAIL: gfortran.dg/gomp/appendix-a/a.24.1.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O   (test for warnings, line 13)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.1.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O   (test for warnings, line 10)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.3.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O   (test for warnings, line 11)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.4.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O   (test for warnings, line 9)
>> FAIL: gfortran.dg/gomp/appendix-a/a.35.6.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/block-1.f90  -O   (test for errors, line 5)
>> FAIL: gfortran.dg/gomp/block-1.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 19)
>> FAIL: gfortran.dg/gomp/crayptr3.f90  -O   (test for errors, line 20)
>> FAIL: gfortran.dg/gomp/crayptr3.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 8)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 10)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 21)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 22)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O   (test for errors, line 33)
>> FAIL: gfortran.dg/gomp/pr33439.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 12)
>> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 24)
>> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 25)
>> FAIL: gfortran.dg/gomp/sharing-1.f90  -O   (test for errors, line 26)
>> FAIL: gfortran.dg/gomp/sharing-1.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 12)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 16)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 57)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 58)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 64)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O   (test for errors, line 65)
>> FAIL: gfortran.dg/gomp/sharing-2.f90  -O  (test for excess errors)
>> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 28)
>> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 30)
>> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 33)
>> FAIL: gfortran.dg/gomp/sharing-3.f90  -O   (test for errors, line 34)
>> FAIL: gfortran.dg/gomp/sharing-3.f90  -O  (test for excess errors)
>>
>>
>> It seems removing 'tree_annotate_all_with_location' in trans-openmp.c
>> was no good idea.
>
> Huh. I was assuming all of the above regressions were due to the hunk
> in trans-openmp.c. However, it turns out they are still present after
> removing it. Which means they must be due to the removal of
> 'tree_annotate_all_with_location' in trans.c.
>
> So, what to do? Are we back to
>
> Index: gcc/fortran/trans.c
> ===================================================================
> --- gcc/fortran/trans.c (Revision 153538)
> +++ gcc/fortran/trans.c (Arbeitskopie)
> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>       {
>         if (TREE_CODE (res) == STATEMENT_LIST)
> -           tree_annotate_all_with_location (&res, input_location);
> +           {
> +             tree_stmt_iterator i;
> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
> +           }
>         else
>           SET_EXPR_LOCATION (res, input_location);
>
> or is there a better option? (One alternative could be to set the
> location only for OpenMP cases, since all other things seem to work?)

I suggest to find out which expressions miss a proper location and fix
it where they are generated.

Richard.

> Cheers,
> Janus
>

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

>> So, what to do? Are we back to
>>
>> Index: gcc/fortran/trans.c
>> ===================================================================
>> --- gcc/fortran/trans.c (Revision 153538)
>> +++ gcc/fortran/trans.c (Arbeitskopie)
>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>       {
>>         if (TREE_CODE (res) == STATEMENT_LIST)
>> -           tree_annotate_all_with_location (&res, input_location);
>> +           {
>> +             tree_stmt_iterator i;
>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>> +           }
>>         else
>>           SET_EXPR_LOCATION (res, input_location);
>>
>> or is there a better option? (One alternative could be to set the
>> location only for OpenMP cases, since all other things seem to work?)
>
> I suggest to find out which expressions miss a proper location and fix
> it where they are generated.

Ok. What about using the above patchlet (or something similar) as an
ad-hoc solution (for the sake of getting this PR fixed), and opening a
new PR for the issue of setting correct input locations (which is in
no way connected to the original intention of this PR)? I promise to
have a look at the location issue myself (later) ...

Cheers,
Janus

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Richard Guenther]

On Sun, Oct 25, 2009 at 10:58 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>> So, what to do? Are we back to
>>>
>>> Index: gcc/fortran/trans.c
>>> ===================================================================
>>> --- gcc/fortran/trans.c (Revision 153538)
>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>       {
>>>         if (TREE_CODE (res) == STATEMENT_LIST)
>>> -           tree_annotate_all_with_location (&res, input_location);
>>> +           {
>>> +             tree_stmt_iterator i;
>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>> +           }
>>>         else
>>>           SET_EXPR_LOCATION (res, input_location);
>>>
>>> or is there a better option? (One alternative could be to set the
>>> location only for OpenMP cases, since all other things seem to work?)
>>
>> I suggest to find out which expressions miss a proper location and fix
>> it where they are generated.
>
> Ok. What about using the above patchlet (or something similar) as an
> ad-hoc solution (for the sake of getting this PR fixed), and opening a
> new PR for the issue of setting correct input locations (which is in
> no way connected to the original intention of this PR)? I promise to
> have a look at the location issue myself (later) ...

It should never happen to be a STATEMENT_LIST in the above hunk
(at least not resulting from foldings).  Thus, can you check just retaining
the original SET_EXPR_LOCATION (res, input_location)?

Richard.

> Cheers,
> Janus
>

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

[-- Attachment #1: Type: text/plain, Size: 2282 bytes --]

2009/10/25 Richard Guenther <richard.guenther@gmail.com>:
> On Sun, Oct 25, 2009 at 10:58 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>>> So, what to do? Are we back to
>>>>
>>>> Index: gcc/fortran/trans.c
>>>> ===================================================================
>>>> --- gcc/fortran/trans.c (Revision 153538)
>>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>>       {
>>>>         if (TREE_CODE (res) == STATEMENT_LIST)
>>>> -           tree_annotate_all_with_location (&res, input_location);
>>>> +           {
>>>> +             tree_stmt_iterator i;
>>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>>> +           }
>>>>         else
>>>>           SET_EXPR_LOCATION (res, input_location);
>>>>
>>>> or is there a better option? (One alternative could be to set the
>>>> location only for OpenMP cases, since all other things seem to work?)
>>>
>>> I suggest to find out which expressions miss a proper location and fix
>>> it where they are generated.
>>
>> Ok. What about using the above patchlet (or something similar) as an
>> ad-hoc solution (for the sake of getting this PR fixed), and opening a
>> new PR for the issue of setting correct input locations (which is in
>> no way connected to the original intention of this PR)? I promise to
>> have a look at the location issue myself (later) ...
>
> It should never happen to be a STATEMENT_LIST in the above hunk
> (at least not resulting from foldings).  Thus, can you check just retaining
> the original SET_EXPR_LOCATION (res, input_location)?

Good point. That seems to work much better. Also removing the stuff in
trans-openmp.c seems to work, which means one can indeed remove
'tree_annotate_all_with_location' completely, and with it
'tree_annotate_one_with_location' and 'tree_should_carry_location_p'.

Will do a full boostrap + regtest of the attached patch, and probably
commit tomorrow if successful.

Afterwards, I will open a PR to check what prevents the removal of the
remaining SET_EXPR_LOCATION in trans.c.

Cheers,
Janus

[-- Attachment #2: pr41714_v6.diff --]
[-- Type: text/x-diff, Size: 9580 bytes --]

Index: gcc/testsuite/gfortran.dg/class_allocate_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
+++ gcc/testsuite/gfortran.dg/class_allocate_4.f03	(Revision 0)
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer :: i
+end type t
+type, extends(t) :: t2
+  integer :: j
+end type t2
+
+class(t), allocatable :: a
+allocate(a, source=t2(1,2))
+print *,a%i
+if(a%i /= 1) call abort()
+select type (a)
+  type is (t2)
+     print *,a%j
+     if(a%j /= 2) call abort()
+end select
+end
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(Revision 153542)
+++ gcc/fortran/trans-openmp.c	(Arbeitskopie)
@@ -1641,11 +1641,6 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_c
 
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
 	{
-	  if (TREE_CODE (res) == STATEMENT_LIST)
-	    tree_annotate_all_with_location (&res, input_location);
-	  else
-	    SET_EXPR_LOCATION (res, input_location);
-
 	  if (prev_singleunit)
 	    {
 	      if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 153542)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -3983,12 +3983,13 @@ gfc_trans_allocate (gfc_code * code)
   tree stat;
   tree pstat;
   tree error_label;
+  tree memsz;
   stmtblock_t block;
 
   if (!code->ext.alloc.list)
     return NULL_TREE;
 
-  pstat = stat = error_label = tmp = NULL_TREE;
+  pstat = stat = error_label = tmp = memsz = NULL_TREE;
 
   gfc_start_block (&block);
 
@@ -4032,19 +4033,19 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_init_se (&se_sz, NULL);
 	      gfc_conv_expr (&se_sz, sz);
 	      gfc_free_expr (sz);
-	      tmp = se_sz.expr;
+	      memsz = se_sz.expr;
 	    }
 	  else if (code->expr3 && code->expr3->ts.type != BT_CLASS)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
 	  else if (code->ext.alloc.ts.type != BT_UNKNOWN)
-	    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
 	  else
-	    tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
+	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
 
-	  if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
-	    tmp = se.string_length;
+	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
+	    memsz = se.string_length;
 
-	  tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
+	  tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
 	  tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
 			     fold_convert (TREE_TYPE (se.expr), tmp));
 	  gfc_add_expr_to_block (&se.pre, tmp);
@@ -4075,21 +4076,17 @@ gfc_trans_allocate (gfc_code * code)
       if (code->expr3)
 	{
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
-	  if (rhs->ts.type == BT_CLASS)
+	  if (al->expr->ts.type == BT_CLASS)
 	    {
-	      gfc_se dst,src,len;
-	      gfc_expr *sz;
-	      gfc_add_component_ref (rhs, "$data");
-	      sz = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (sz, "$size");
+	      gfc_se dst,src;
+	      if (rhs->ts.type == BT_CLASS)
+		gfc_add_component_ref (rhs, "$data");
 	      gfc_init_se (&dst, NULL);
 	      gfc_init_se (&src, NULL);
-	      gfc_init_se (&len, NULL);
 	      gfc_conv_expr (&dst, expr);
 	      gfc_conv_expr (&src, rhs);
-	      gfc_conv_expr (&len, sz);
-	      gfc_free_expr (sz);
-	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, len.expr);
+	      gfc_add_block_to_block (&block, &src.pre);
+	      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	    }
 	  else
 	    tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
@@ -4108,8 +4105,7 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_conv_expr (&dst, expr);
 	  gfc_conv_expr (&src, init_e);
 	  gfc_add_block_to_block (&block, &src.pre);
-	  tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
-	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, tmp);
+	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
       /* Add default initializer for those derived types that need them.  */
@@ -4127,6 +4123,7 @@ gfc_trans_allocate (gfc_code * code)
       if (expr->ts.type == BT_CLASS)
 	{
 	  gfc_expr *lhs,*rhs;
+	  gfc_se lse;
 	  /* Initialize VINDEX for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$vindex");
@@ -4158,36 +4155,11 @@ gfc_trans_allocate (gfc_code * code)
 	  /* Initialize SIZE for CLASS objects.  */
 	  lhs = gfc_expr_to_initialize (expr);
 	  gfc_add_component_ref (lhs, "$size");
-	  rhs = NULL;
-	  if (code->expr3 && code->expr3->ts.type == BT_CLASS)
-	    {
-	      /* Size must be determined at run time.  */
-	      rhs = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (rhs, "$size");
-	      tmp = gfc_trans_assignment (lhs, rhs, false);
-	      gfc_add_expr_to_block (&block, tmp);
-	    }
-	  else
-	    {
-	      /* Size is fixed at compile time.  */
-	      gfc_typespec *ts;
-	      gfc_se lse;
-	      gfc_init_se (&lse, NULL);
-	      gfc_conv_expr (&lse, lhs);
-	      if (code->expr3)
-		ts = &code->expr3->ts;
-	      else if (code->ext.alloc.ts.type == BT_DERIVED)
-		ts = &code->ext.alloc.ts;
-	      else if (expr->ts.type == BT_CLASS)
-		ts = &expr->ts.u.derived->components->ts;
-	      else
-		ts = &expr->ts;
-	      tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
-	      gfc_add_modify (&block, lse.expr,
-			      fold_convert (TREE_TYPE (lse.expr), tmp));
-	    }
+	  gfc_init_se (&lse, NULL);
+	  gfc_conv_expr (&lse, lhs);
+	  gfc_add_modify (&block, lse.expr,
+			  fold_convert (TREE_TYPE (lse.expr), memsz));
 	  gfc_free_expr (lhs);
-	  gfc_free_expr (rhs);
 	}
 
     }
Index: gcc/fortran/trans.c
===================================================================
--- gcc/fortran/trans.c	(Revision 153542)
+++ gcc/fortran/trans.c	(Arbeitskopie)
@@ -1281,9 +1281,7 @@ gfc_trans_code (gfc_code * code)
 
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
 	{
-	  if (TREE_CODE (res) == STATEMENT_LIST)
-	    tree_annotate_all_with_location (&res, input_location);
-	  else
+	  if (TREE_CODE (res) != STATEMENT_LIST)
 	    SET_EXPR_LOCATION (res, input_location);
 	    
 	  /* Add the new statement to the block.  */
Index: gcc/gimplify.c
===================================================================
--- gcc/gimplify.c	(Revision 153542)
+++ gcc/gimplify.c	(Arbeitskopie)
@@ -777,24 +777,7 @@ should_carry_location_p (gimple gs)
   return true;
 }
 
-/* Same, but for a tree.  */
 
-static bool
-tree_should_carry_location_p (const_tree stmt)
-{
-  /* Don't emit a line note for a label.  We particularly don't want to
-     emit one for the break label, since it doesn't actually correspond
-     to the beginning of the loop/switch.  */
-  if (TREE_CODE (stmt) == LABEL_EXPR)
-    return false;
-
-  /* Do not annotate empty statements, since it confuses gcov.  */
-  if (!TREE_SIDE_EFFECTS (stmt))
-    return false;
-
-  return true;
-}
-
 /* Return true if a location should not be emitted for this statement
    by annotate_one_with_location.  */
 
@@ -826,17 +809,7 @@ annotate_one_with_location (gimple gs, location_t
     gimple_set_location (gs, location);
 }
 
-/* Same, but for tree T.  */
 
-static void
-tree_annotate_one_with_location (tree t, location_t location)
-{
-  if (CAN_HAVE_LOCATION_P (t)
-      && ! EXPR_HAS_LOCATION (t) && tree_should_carry_location_p (t))
-    SET_EXPR_LOCATION (t, location);
-}
-
-
 /* Set LOCATION for all the statements after iterator GSI in sequence
    SEQ.  If GSI is pointing to the end of the sequence, start with the
    first statement in SEQ.  */
@@ -872,30 +845,7 @@ annotate_all_with_location (gimple_seq stmt_p, loc
     }
 }
 
-/* Same, but for statement or statement list in *STMT_P.  */
 
-void
-tree_annotate_all_with_location (tree *stmt_p, location_t location)
-{
-  tree_stmt_iterator i;
-
-  if (!*stmt_p)
-    return;
-
-  for (i = tsi_start (*stmt_p); !tsi_end_p (i); tsi_next (&i))
-    {
-      tree t = tsi_stmt (i);
-
-      /* Assuming we've already been gimplified, we shouldn't
-	  see nested chaining constructs anymore.  */
-      gcc_assert (TREE_CODE (t) != STATEMENT_LIST
-		  && TREE_CODE (t) != COMPOUND_EXPR);
-
-      tree_annotate_one_with_location (t, location);
-    }
-}
-
-
 /* Similar to copy_tree_r() but do not copy SAVE_EXPR or TARGET_EXPR nodes.
    These nodes model computations that should only be done once.  If we
    were to unshare something like SAVE_EXPR(i++), the gimplification
Index: gcc/gimple.h
===================================================================
--- gcc/gimple.h	(Revision 153542)
+++ gcc/gimple.h	(Arbeitskopie)
@@ -939,7 +939,6 @@ extern tree create_tmp_var (tree, const char *);
 extern tree get_initialized_tmp_var (tree, gimple_seq *, gimple_seq *);
 extern tree get_formal_tmp_var (tree, gimple_seq *);
 extern void declare_vars (tree, gimple, bool);
-extern void tree_annotate_all_with_location (tree *, location_t);
 extern void annotate_all_with_location (gimple_seq, location_t);
 
 /* Validation of GIMPLE expressions.  Note that these predicates only check

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

2009/10/25 Janus Weil <janus@gcc.gnu.org>:
> 2009/10/25 Richard Guenther <richard.guenther@gmail.com>:
>> On Sun, Oct 25, 2009 at 10:58 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>>>> So, what to do? Are we back to
>>>>>
>>>>> Index: gcc/fortran/trans.c
>>>>> ===================================================================
>>>>> --- gcc/fortran/trans.c (Revision 153538)
>>>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>>>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>>>       {
>>>>>         if (TREE_CODE (res) == STATEMENT_LIST)
>>>>> -           tree_annotate_all_with_location (&res, input_location);
>>>>> +           {
>>>>> +             tree_stmt_iterator i;
>>>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>>>> +           }
>>>>>         else
>>>>>           SET_EXPR_LOCATION (res, input_location);
>>>>>
>>>>> or is there a better option? (One alternative could be to set the
>>>>> location only for OpenMP cases, since all other things seem to work?)
>>>>
>>>> I suggest to find out which expressions miss a proper location and fix
>>>> it where they are generated.
>>>
>>> Ok. What about using the above patchlet (or something similar) as an
>>> ad-hoc solution (for the sake of getting this PR fixed), and opening a
>>> new PR for the issue of setting correct input locations (which is in
>>> no way connected to the original intention of this PR)? I promise to
>>> have a look at the location issue myself (later) ...
>>
>> It should never happen to be a STATEMENT_LIST in the above hunk
>> (at least not resulting from foldings).  Thus, can you check just retaining
>> the original SET_EXPR_LOCATION (res, input_location)?
>
> Good point. That seems to work much better. Also removing the stuff in
> trans-openmp.c seems to work, which means one can indeed remove
> 'tree_annotate_all_with_location' completely, and with it
> 'tree_annotate_one_with_location' and 'tree_should_carry_location_p'.
>
> Will do a full boostrap + regtest of the attached patch, and probably
> commit tomorrow if successful.

Committed as r153547. Thanks for the reviews and the help with getting
that location stuff straight.

Cheers,
Janus

Re: [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE

[Janus Weil]

2009/10/25 Janus Weil <janus@gcc.gnu.org>:
> 2009/10/25 Richard Guenther <richard.guenther@gmail.com>:
>> On Sun, Oct 25, 2009 at 10:58 PM, Janus Weil <janus@gcc.gnu.org> wrote:
>>>>> So, what to do? Are we back to
>>>>>
>>>>> Index: gcc/fortran/trans.c
>>>>> ===================================================================
>>>>> --- gcc/fortran/trans.c (Revision 153538)
>>>>> +++ gcc/fortran/trans.c (Arbeitskopie)
>>>>> @@ -1282,7 +1282,11 @@ gfc_trans_code (gfc_code * code)
>>>>>      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
>>>>>       {
>>>>>         if (TREE_CODE (res) == STATEMENT_LIST)
>>>>> -           tree_annotate_all_with_location (&res, input_location);
>>>>> +           {
>>>>> +             tree_stmt_iterator i;
>>>>> +             for (i = tsi_start (res); !tsi_end_p (i); tsi_next (&i))
>>>>> +               SET_EXPR_LOCATION (tsi_stmt (i), input_location);
>>>>> +           }
>>>>>         else
>>>>>           SET_EXPR_LOCATION (res, input_location);
>>>>>
>>>>> or is there a better option? (One alternative could be to set the
>>>>> location only for OpenMP cases, since all other things seem to work?)
>>>>
>>>> I suggest to find out which expressions miss a proper location and fix
>>>> it where they are generated.
>>>
>>> Ok. What about using the above patchlet (or something similar) as an
>>> ad-hoc solution (for the sake of getting this PR fixed), and opening a
>>> new PR for the issue of setting correct input locations (which is in
>>> no way connected to the original intention of this PR)? I promise to
>>> have a look at the location issue myself (later) ...
>>
>> It should never happen to be a STATEMENT_LIST in the above hunk
>> (at least not resulting from foldings).  Thus, can you check just retaining
>> the original SET_EXPR_LOCATION (res, input_location)?
>
> Good point. That seems to work much better. Also removing the stuff in
> trans-openmp.c seems to work, which means one can indeed remove
> 'tree_annotate_all_with_location' completely, and with it
> 'tree_annotate_one_with_location' and 'tree_should_carry_location_p'.
>
> Will do a full boostrap + regtest of the attached patch, and probably
> commit tomorrow if successful.
>
> Afterwards, I will open a PR to check what prevents the removal of the
> remaining SET_EXPR_LOCATION in trans.c.

This is now ...

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=41827

Cheers,
Janus