Re: [PATCH, Fortran, v2] Fix deallocation of nested derived typed components

[Andre Vehreschild <vehre at gmx dot de>]

Hi all,

@Dominique: Thanks for checking. And also for pointing out that the initial
version of the patch ICEd on some already closed PRs. The objective of those
PRs does not seem to be covered by the current testsuite. I therefore
additionally propose to add attached testcase. Ok for trunk?

Of course with appropriate Changelog-entry.

Regards,
	Andre


On Sat, 3 Dec 2016 18:34:56 +0100
Dominique d'Humières <dominiq@lps.ens.fr> wrote:

> > I also have addressed the ICEs with proc_pointer components.  
> 
> Confirmed, the patch LGTM.
> 
> Thanks,
> 
> Dominique
> 
> 


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

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_47.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_47.f90
new file mode 100644
index 0000000..1d52100
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_47.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+MODULE distribution_types
+  ABSTRACT INTERFACE
+     FUNCTION dist_map_blk_to_proc_func ( row, col, nrow_tot, ncol_tot, proc_grid ) RESULT( reslt )
+       INTEGER, INTENT( IN ) :: row, col, nrow_tot, ncol_tot
+       INTEGER, DIMENSION( : ), INTENT( IN ) :: proc_grid
+       INTEGER, DIMENSION( : ), ALLOCATABLE :: reslt
+     END FUNCTION dist_map_blk_to_proc_func
+  END INTERFACE
+  TYPE, PUBLIC :: dist_type
+     INTEGER, DIMENSION( : ), ALLOCATABLE :: task_coords
+     PROCEDURE( dist_map_blk_to_proc_func ), NOPASS, POINTER :: map_blk_to_proc => NULL( )
+  END TYPE dist_type
+END MODULE distribution_types
+
+MODULE sparse_matrix_types
+  USE distribution_types,  ONLY : dist_type
+  TYPE, PUBLIC :: sm_type
+     TYPE( dist_type ) :: dist
+  END TYPE sm_type
+END MODULE sparse_matrix_types
+
+PROGRAM comp_proc_ptr_test
+  USE sparse_matrix_types,      ONLY : sm_type
+
+ call  sm_multiply_a ()
+CONTAINS
+  SUBROUTINE sm_multiply_a (  )
+    INTEGER :: n_push_tot, istat
+    TYPE( sm_type ), DIMENSION( : ), ALLOCATABLE :: matrices_a, matrices_b
+    n_push_tot =2
+    ALLOCATE( matrices_a( n_push_tot + 1 ), matrices_b( n_push_tot + 1), STAT=istat )
+    if (istat /= 0) call abort()
+    if (.not. allocated(matrices_a)) call abort()
+    if (.not. allocated(matrices_b)) call abort()
+    if (associated(matrices_a(1)%dist%map_blk_to_proc)) call abort()
+  END SUBROUTINE sm_multiply_a
+END PROGRAM comp_proc_ptr_test
+