public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly   copy the value from SOURCE
@ 2009-10-25 11:49 Janus Weil
  2009-10-25 15:11 ` Paul Richard Thomas
  0 siblings, 1 reply; 15+ messages in thread
From: Janus Weil @ 2009-10-25 11:49 UTC (permalink / raw)
  To: gfortran, gcc-patches, salvatore.filippone

[-- 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

^ permalink raw reply	[flat|nested] 15+ messages in thread
end of thread, other threads:[~2009-10-26  9:29 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2009-10-25 11:49 [Patch, Fortran] PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE Janus Weil
2009-10-25 15:11 ` Paul Richard Thomas
2009-10-25 15:13   ` Richard Guenther
2009-10-25 15:45     ` Richard Guenther
2009-10-25 18:05       ` Janus Weil
2009-10-25 19:00         ` Richard Guenther
2009-10-25 19:12           ` Janus Weil
2009-10-25 21:42             ` Janus Weil
2009-10-25 21:46               ` Janus Weil
2009-10-25 21:58                 ` Richard Guenther
2009-10-25 22:10                   ` Janus Weil
2009-10-25 22:28                     ` Richard Guenther
2009-10-25 23:12                       ` Janus Weil
2009-10-26  9:29                         ` Janus Weil
2009-10-26  9:31                         ` Janus Weil

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).