Patchwork [Fortran] PR 49324: Deep copy array constr of DT with allocatable components

login
register
mail settings
Submitter Tobias Burnus
Date June 10, 2011, 12:12 p.m.
Message ID <4DF20A1D.2000709@net-b.de>
Download mbox | patch
Permalink /patch/99885/
State New
Headers show

Comments

Tobias Burnus - June 10, 2011, 12:12 p.m.
This patch fixes parts of the PR 49324: There was a deep copy missing 
for assigning an array constructor of a DT with allocatable components.

Whether a deep copy is done, depends on a flag. I think the flag has 
been added to avoid a deep copy and multiple evaluation for functions, 
which return DT w/ allocatable components, and for user-defined operators.

Remains to do be done:
- RESHAPE is mishandled (design error): No deep copy.
- Reallocate on assignment fails (missing NULL initialization of the 
malloced memory).

Build and regtested on x86-64-linux. OK?

Tobias
jerry DeLisle - June 10, 2011, 5:37 p.m.
On 06/10/2011 05:12 AM, Tobias Burnus wrote:
> This patch fixes parts of the PR 49324: There was a deep copy missing for
> assigning an array constructor of a DT with allocatable components.
>
> Whether a deep copy is done, depends on a flag. I think the flag has been added
> to avoid a deep copy and multiple evaluation for functions, which return DT w/
> allocatable components, and for user-defined operators.
>
> Remains to do be done:
> - RESHAPE is mishandled (design error): No deep copy.
> - Reallocate on assignment fails (missing NULL initialization of the malloced
> memory).
>
> Build and regtested on x86-64-linux. OK?
>
> Tobias

OK, thanks for patch.

Jerry

Patch

2011-06-10  Tobias Burnus

	PR fortran/49324
	* trans-expr.c (gfc_trans_assignment_1): Tell
	gfc_trans_scalar_assign to also deep-copy RHS nonvariables
	with allocatable components.
	* trans-array.c (gfc_conv_expr_descriptor): Ditto.

2011-06-10  Tobias Burnus

	PR fortran/49324
	* gfortran.dg/alloc_comp_assign_11.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c7aeadb..baf9060 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5808,7 +5808,8 @@  gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 
       lse.string_length = rse.string_length;
       tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
-				     expr->expr_type == EXPR_VARIABLE, true);
+				     expr->expr_type == EXPR_VARIABLE
+				     || expr->expr_type == EXPR_ARRAY, true);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Finish the copying loops.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index da4af1a..7383265 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6155,8 +6155,8 @@  gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 
   tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
 				 l_is_temp || init_flag,
-				 expr_is_variable (expr2) || scalar_to_array,
-				 dealloc);
+				 expr_is_variable (expr2) || scalar_to_array
+				 || expr2->expr_type == EXPR_ARRAY, dealloc);
   gfc_add_expr_to_block (&body, tmp);
 
   if (lss == gfc_ss_terminator)
--- /dev/null	2011-06-10 07:14:00.663872279 +0200
+++ gcc/gcc/testsuite/gfortran.dg/alloc_comp_assign_11.f90	2011-06-10 09:57:30.000000000 +0200
@@ -0,0 +1,41 @@ 
+! { dg-do run }
+!
+! PR fortran/49324
+!
+! Check that with array constructors a deep copy is done
+!
+implicit none
+type t
+  integer, allocatable :: A(:)
+end type t
+
+type(t) :: x, y
+type(t), allocatable :: z(:), z2(:)
+
+allocate (x%A(2))
+allocate (y%A(1))
+x%A(:) = 11
+y%A(:) = 22
+
+allocate (z(2))
+
+z = [ x, y ]
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 11) .or. z(2)%a(1) /= 22 .or. any (x%A /= 11)  &
+    .or. y%A(1) /= 22)  &
+  call abort()
+
+x%A(:) = 444
+y%A(:) = 555
+
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 11) .or. z(2)%a(1) /= 22 .or. any (x%A /= 444)  &
+    .or. y%A(1) /= 555)  &
+  call abort()
+
+z(:) = [ x, y ]
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 444) .or. z(2)%a(1) /= 555 .or. any (x%A /= 444)  &
+    .or. y%A(1) /= 555)  &
+  call abort()
+end