public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type
@ 2015-04-18 10:55 Andre Vehreschild
  2015-04-25 14:42 ` Paul Richard Thomas
  0 siblings, 1 reply; 4+ messages in thread
From: Andre Vehreschild @ 2015-04-18 10:55 UTC (permalink / raw)
  To: GCC-Patches-ML, GCC-Fortran-ML

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

Hi all,

this patch fixes a deep copy issue, when allocatable components of an entity
were not allocated. Before the patch the deep copy was run without
checking if the component is actually allocated and the program crashed because
a null pointer was dereferenced. Furthermore, was the code to copy a structure
component not checking the correct ref to determine whether a component was
allocated, when allocatable components were nested. Example:

type InnerT
  integer, allocatable :: inner_I
end type
type T
  type(InnerT), allocatable :: in
end type

The pseudo pseudo code generated for this was something like:

subroutine copy(src,dst)
  dst = src
  if (allocated (src.in.inner_I)) // crash
    allocate (dst.in)
  end if

  dst.in.inner_I = src.in.inner_I // crash
end subroutine

The patch fixes this by generating:

subroutine copy(src,dst)
  dst = src
  if (allocated (src.in))
    allocate (dst.in)
    dst.in= src.in
    if (allocated (src.in.inner_I))
      allocate (dst.in.inner_I)
      dst.in.inner_I = src.in.inner_I
    end
  end
end subroutine

Of course is this pseudo pseudo code shortened dramatically to show just the
necessary bits.

Bootstraps and regtests ok on x86_64-linux-gnu/F21.

Ok, for trunk?

Thanks to Dominique for identifying the pr addressed by this patch.

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr59678_1.clog --]
[-- Type: application/octet-stream, Size: 835 bytes --]

gcc/testsuite/ChangeLog:

2015-04-18  Andre Vehreschild  <vehre@gmx.de>

	* gfortran.dg/alloc_comp_deep_copy_1.f03: New test.


gcc/fortran/ChangeLog:

2015-04-18  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/59678
	* trans-array.c (duplicate_allocatable): Fixed deep copy of
	allocatable components, which are liable for copy only, when
	they are allocated.
	(gfc_duplicate_allocatable): Add deep-copy code into if
	component allocated block. Needed interface change for that.
	(gfc_copy_allocatable_data): Supplying NULL_TREE for code to
	add into if-block for checking whether a component was
	allocated.
	(gfc_duplicate_allocatable_nocopy): Likewise.
	(structure_alloc_comps): Likewise.
	* trans-array.h: Likewise.
	* trans-expr.c (gfc_trans_alloc_subarray_assign): Likewise.
	* trans-openmp.c (gfc_walk_alloc_comps): Likewise.


[-- Attachment #3: pr59678_1.patch --]
[-- Type: text/x-patch, Size: 18702 bytes --]

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1cb639d..08c8861 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7574,7 +7574,8 @@ gfc_full_array_size (stmtblock_t *block, tree decl, int rank)
 
 static tree
 duplicate_allocatable (tree dest, tree src, tree type, int rank,
-		       bool no_malloc, bool no_memcpy, tree str_sz)
+		       bool no_malloc, bool no_memcpy, tree str_sz,
+		       tree add_when_allocated)
 {
   tree tmp;
   tree size;
@@ -7654,6 +7655,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 	}
     }
 
+  gfc_add_expr_to_block (&block, add_when_allocated);
   tmp = gfc_finish_block (&block);
 
   /* Null the destination if the source is null; otherwise do
@@ -7673,10 +7675,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 /* Allocate dest to the same size as src, and copy data src -> dest.  */
 
 tree
-gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
+gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank,
+			   tree add_when_allocated)
 {
   return duplicate_allocatable (dest, src, type, rank, false, false,
-				NULL_TREE);
+				NULL_TREE, add_when_allocated);
 }
 
 
@@ -7686,7 +7689,7 @@ tree
 gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
 {
   return duplicate_allocatable (dest, src, type, rank, true, false,
-				NULL_TREE);
+				NULL_TREE, NULL_TREE);
 }
 
 /* Allocate dest to the same size as src, but don't copy anything.  */
@@ -7694,7 +7697,8 @@ gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
 tree
 gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank)
 {
-  return duplicate_allocatable (dest, src, type, rank, false, true, NULL_TREE);
+  return duplicate_allocatable (dest, src, type, rank, false, true,
+				NULL_TREE, NULL_TREE);
 }
 
 
@@ -7726,27 +7730,32 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
   tree ctype;
   tree vref, dref;
   tree null_cond = NULL_TREE;
+  tree add_when_allocated;
   bool called_dealloc_with_status;
 
   gfc_init_block (&fnblock);
 
   decl_type = TREE_TYPE (decl);
 
-  if ((POINTER_TYPE_P (decl_type) && rank != 0)
+  if ((POINTER_TYPE_P (decl_type))
 	|| (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
+    {
+      decl = build_fold_indirect_ref_loc (input_location, decl);
+      /* Deref dest in sync with decl, but only when it is not NULL.  */
+      if (dest)
+	dest = build_fold_indirect_ref_loc (input_location, dest);
+    }
 
-  /* Just in case in gets dereferenced.  */
+  /* Just in case it gets dereferenced.  */
   decl_type = TREE_TYPE (decl);
 
-  /* If this an array of derived types with allocatable components
+  /* If this is an array of derived types with allocatable components
      build a loop and recursively call this function.  */
   if (TREE_CODE (decl_type) == ARRAY_TYPE
       || (GFC_DESCRIPTOR_TYPE_P (decl_type) && rank != 0))
     {
       tmp = gfc_conv_array_data (decl);
-      var = build_fold_indirect_ref_loc (input_location,
-				     tmp);
+      var = build_fold_indirect_ref_loc (input_location, tmp);
 
       /* Get the number of elements - 1 and set the counter.  */
       if (GFC_DESCRIPTOR_TYPE_P (decl_type))
@@ -7767,7 +7776,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       else
 	{
 	  /*  Otherwise use the TYPE_DOMAIN information.  */
-	  tmp =  array_type_nelts (decl_type);
+	  tmp = array_type_nelts (decl_type);
 	  tmp = fold_convert (gfc_array_index_type, tmp);
 	}
 
@@ -7780,19 +7789,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
       vref = gfc_build_array_ref (var, index, NULL);
 
-      if (purpose == COPY_ALLOC_COMP)
-        {
-	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
-	    {
-	      tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-	    }
-	  tmp = build_fold_indirect_ref_loc (input_location,
-					 gfc_conv_array_data (dest));
-	  dref = gfc_build_array_ref (tmp, index, NULL);
-	  tmp = structure_alloc_comps (der_type, vref, dref, rank, purpose);
-	}
-      else if (purpose == COPY_ONLY_ALLOC_COMP)
+      if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
         {
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 gfc_conv_array_data (dest));
@@ -7815,7 +7812,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       gfc_add_block_to_block (&fnblock, &loop.pre);
 
       tmp = gfc_finish_block (&fnblock);
-      if (null_cond != NULL_TREE)
+      /* When copying allocateable components, the above implements the
+	 deep copy.  Nevertheless is a deep copy only allowed, when the current
+	 component is allocated, for which code will be generated in
+	 gfc_duplicate_allocatable (), where the deep copy code is just added
+	 into the if's body, by adding tmp (the deep copy code) as last
+	 argument to gfc_duplicate_allocatable ().  */
+      if (purpose == COPY_ALLOC_COMP
+	  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+	tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank,
+					 tmp);
+      else if (null_cond != NULL_TREE)
 	tmp = build3_v (COND_EXPR, null_cond, tmp,
 			build_empty_stmt (input_location));
 
@@ -8100,6 +8107,22 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      continue;
 	    }
 
+	  /* To implement guarded deep copy, i.e., deep copy only allocatable
+	     components that are really allocated, the deep copy code has to
+	     be generated first and then added to the if-block in
+	     gfc_duplicate_allocatable ().  */
+	  if (cmp_has_alloc_comps)
+	    {
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = fold_convert (TREE_TYPE (dcmp), comp);
+	      gfc_add_modify (&fnblock, dcmp, tmp);
+	      add_when_allocated = structure_alloc_comps (c->ts.u.derived,
+							  comp, dcmp,
+							  rank, purpose);
+	    }
+	  else
+	    add_when_allocated = NULL_TREE;
+
 	  if (gfc_deferred_strlen (c, &tmp))
 	    {
 	      tree len, size;
@@ -8114,30 +8137,29 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				     TREE_TYPE (len), len, tmp);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	      size = size_of_string_in_bytes (c->ts.kind, len);
+	      /* This component can not have allocatable components,
+		 therefore add_when_allocated of duplicate_allocatable ()
+		 is always NULL.  */
 	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
-					   false, false, size);
+					   false, false, size, NULL_TREE);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.proc_pointer
-		   && !cmp_has_alloc_comps)
+		   && (!(cmp_has_alloc_comps && c->as)
+		       || c->attr.codimension))
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      if (c->attr.codimension)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
 	      else
-		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,
+						 add_when_allocated);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
+	  else
+	    if (cmp_has_alloc_comps)
+	      gfc_add_expr_to_block (&fnblock, add_when_allocated);
 
-          if (cmp_has_alloc_comps)
-	    {
-	      rank = c->as ? c->as->rank : 0;
-	      tmp = fold_convert (TREE_TYPE (dcmp), comp);
-	      gfc_add_modify (&fnblock, dcmp, tmp);
-	      tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
-					   rank, purpose);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-	    }
 	  break;
 
 	default:
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 389a644..2132f84 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -46,7 +46,7 @@ tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *);
 
 tree gfc_full_array_size (stmtblock_t *, tree, int);
 
-tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank);
+tree gfc_duplicate_allocatable (tree, tree, tree, int, tree);
 
 tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 80dfed1..395c47d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6725,13 +6725,13 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 	{
 	  tmp = TREE_TYPE (dest);
 	  tmp = gfc_duplicate_allocatable (dest, se.expr,
-					   tmp, expr->rank);
+					   tmp, expr->rank, NULL_TREE);
 	}
     }
   else
     tmp = gfc_duplicate_allocatable (dest, se.expr,
 				     TREE_TYPE(cm->backend_decl),
-				     cm->as->rank);
+				     cm->as->rank, NULL_TREE);
 
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &se.post);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 9642a7d..dd19a9c 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -391,9 +391,11 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var,
 	  if (GFC_DESCRIPTOR_TYPE_P (ftype)
 	      && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
 	    tem = gfc_duplicate_allocatable (destf, declf, ftype,
-					     GFC_TYPE_ARRAY_RANK (ftype));
+					     GFC_TYPE_ARRAY_RANK (ftype),
+					     NULL_TREE);
 	  else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
-	    tem = gfc_duplicate_allocatable (destf, declf, ftype, 0);
+	    tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
+					     NULL_TREE);
 	  break;
 	}
       if (tem)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
new file mode 100644
index 0000000..98a7da3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
@@ -0,0 +1,264 @@
+program alloc_comp_copy_test
+
+  type InnerT
+    integer :: ii
+    integer, allocatable :: ai
+    integer, allocatable :: v(:)
+  end type InnerT
+
+  type T
+    integer :: i
+    integer, allocatable :: a_i
+    type(InnerT), allocatable :: it
+    type(InnerT), allocatable :: vec(:)
+  end type T
+
+  type(T) :: o1, o2
+  class(T), allocatable :: o3, o4
+  o1%i = 42
+
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (allocated(o2%a_i)) call abort()
+  if (allocated(o2%it)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%a_i, source=2)
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (allocated(o2%it)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it)
+  o1%it%ii = 3
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (allocated(o2%it%ai)) call abort()
+  if (allocated(o2%it%v)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it%ai)
+  o1%it%ai = 4
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (allocated(o2%it%v)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it%v(3), source= 5)
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (any (o2%it%v /= 5) .or. size (o2%it%v) /= 3) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%vec(2))
+  o1%vec(:)%ii = 6
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai) .or. allocated(o2%vec(2)%ai)) call abort()
+  if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
+
+  allocate (o1%vec(2)%ai)
+  o1%vec(2)%ai = 7
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai)) call abort()
+  if (.not. allocated(o2%vec(2)%ai)) call abort()
+  if (o2%vec(2)%ai /= 7) call abort()
+  if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
+
+  allocate (o1%vec(1)%v(3))
+  o1%vec(1)%v = [8, 9, 10]
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai)) call abort()
+  if (.not. allocated(o2%vec(2)%ai)) call abort()
+  if (o2%vec(2)%ai /= 7) call abort()
+  if (.not. allocated(o2%vec(1)%v)) call abort()
+  if (any (o2%vec(1)%v /= [8,9,10])) call abort()
+  if (allocated(o2%vec(2)%v)) call abort()
+
+  ! Now all the above for class objects.
+  allocate (o3, o4)
+  o3%i = 42
+
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (allocated(o4%a_i)) call abort()
+  if (allocated(o4%it)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%a_i, source=2)
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (allocated(o4%it)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it)
+  o3%it%ii = 3
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (allocated(o4%it%ai)) call abort()
+  if (allocated(o4%it%v)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it%ai)
+  o3%it%ai = 4
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (allocated(o4%it%v)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it%v(3), source= 5)
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (any (o4%it%v /= 5) .or. size (o4%it%v) /= 3) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%vec(2))
+  o3%vec(:)%ii = 6
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai) .or. allocated(o4%vec(2)%ai)) call abort()
+  if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
+
+  allocate (o3%vec(2)%ai)
+  o3%vec(2)%ai = 7
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai)) call abort()
+  if (.not. allocated(o4%vec(2)%ai)) call abort()
+  if (o4%vec(2)%ai /= 7) call abort()
+  if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
+
+  allocate (o3%vec(1)%v(3))
+  o3%vec(1)%v = [8, 9, 10]
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai)) call abort()
+  if (.not. allocated(o4%vec(2)%ai)) call abort()
+  if (o4%vec(2)%ai /= 7) call abort()
+  if (.not. allocated(o4%vec(1)%v)) call abort()
+  if (any (o4%vec(1)%v /= [8,9,10])) call abort()
+  if (allocated(o4%vec(2)%v)) call abort()
+
+contains
+
+  subroutine copyO(src, dst)
+    type(T), intent(in) :: src
+    type(T), intent(out) :: dst
+
+    dst = src
+  end subroutine copyO
+
+end program alloc_comp_copy_test
+

^ permalink raw reply	[flat|nested] 4+ messages in thread
end of thread, other threads:[~2015-04-27 17:40 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-04-18 10:55 [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type Andre Vehreschild
2015-04-25 14:42 ` Paul Richard Thomas
2015-04-25 14:46   ` Paul Richard Thomas
2015-04-27 17:40   ` Andre Vehreschild

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