* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out)
@ 2013-06-09 10:46 Dominique Dhumieres
2013-06-12 13:18 ` Tobias Burnus
0 siblings, 1 reply; 7+ messages in thread
From: Dominique Dhumieres @ 2013-06-09 10:46 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, hjl.tools, mikael.morin, burnus
Dear Tobias,
The test gfortran.dg/finalize_10.f90 fails in 32 bit mode (see
http://gcc.gnu.org/ml/gcc-testresults/2013-06/msg00842.html
FAIL: gfortran.dg/finalize_10.f90 -O scan-tree-dump-times original "__builtin_memcpy \\\\(\\\\(void .\\\\) y->_data, \\\\(void .\\\\) y->_vptr->_def_init, \\\\(unsigned long\\\\) y->_vptr->_size\\\\);" 1)
because "unsigned long" is replaced with "unsigned int".
The following patch fixes it
--- ../_clean/gcc/testsuite/gfortran.dg/finalize_10.f90 2013-06-08 21:50:32.000000000 +0200
+++ gcc/testsuite/gfortran.dg/finalize_10.f90 2013-06-09 11:33:12.000000000 +0200
@@ -26,7 +26,8 @@ end subroutine foo
! Finalize CLASS + set default init
! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" { target lp64 } } }
+! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned int\\) y->_vptr->_size\\);" 1 "original" { target ilp32 } } }
! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } }
I have tried to weaken the test by not using any target and using a regexp
of the kind "(int|long)", but I did not succeeded.
CAVEAT: I don't know if the targets work for x32.
TIA
Dominique
^ permalink raw reply [flat|nested] 7+ messages in thread* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-06-09 10:46 *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) Dominique Dhumieres @ 2013-06-12 13:18 ` Tobias Burnus 2013-06-12 13:29 ` Tobias Burnus 0 siblings, 1 reply; 7+ messages in thread From: Tobias Burnus @ 2013-06-12 13:18 UTC (permalink / raw) To: Dominique Dhumieres; +Cc: fortran, gcc-patches, hjl.tools, mikael.morin [-- Attachment #1: Type: text/plain, Size: 482 bytes --] Thanks Dominique and Andreas for reporting this issue. Dominique Dhumieres wrote: > The test gfortran.dg/finalize_10.f90 fails in 32 bit mode [...] > The following patch fixes it > [...] > > I have tried to weaken the test by not using any target and using a regexp > of the kind "(int|long)", but I did not succeeded. Seemingly, dg-tree-dump-times does not work with regular expressions. I have replaces it by dg-tree-dump + regular expression. Committed as 200003. Tobias [-- Attachment #2: committed.diff --] [-- Type: text/x-patch, Size: 1405 bytes --] Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 200002) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,8 @@ +2013-06-12 Tobias Burnus <burnus@net-b.de> + Dominique d'Humieres <dominiq@lps.ens.fr> + + * gfortran.dg/finalize_10.f90: Update dg-dump. + 2013-06-12 Jakub Jelinek <jakub@redhat.com> PR target/56564 Index: gcc/testsuite/gfortran.dg/finalize_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/finalize_10.f90 (Revision 200002) +++ gcc/testsuite/gfortran.dg/finalize_10.f90 (Arbeitskopie) @@ -26,7 +26,7 @@ ! Finalize CLASS + set default init ! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" } } +! { dg-final { scan-tree-dump "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned (long|int)\\) y->_vptr->_size\\);" "original" } } ! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } } ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-06-12 13:18 ` Tobias Burnus @ 2013-06-12 13:29 ` Tobias Burnus 0 siblings, 0 replies; 7+ messages in thread From: Tobias Burnus @ 2013-06-12 13:29 UTC (permalink / raw) To: Dominique Dhumieres; +Cc: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 376 bytes --] Tobias Burnus wrote: > Dominique Dhumieres wrote: >> I have tried to weaken the test by not using any target and using a >> regexp >> of the kind "(int|long)", but I did not succeeded. Ups, I missed that Dominique's and Andreas' 32bit dumps are different ("unsigned int" vs. "character(kind=4)"). Thus, the new pattern accepts either version. Committed as 200006. Tobias [-- Attachment #2: committed.diff --] [-- Type: text/x-patch, Size: 1585 bytes --] Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 200003) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,7 +1,11 @@ 2013-06-12 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/finalize_10.f90: Update scan-tree-dump. + +2013-06-12 Tobias Burnus <burnus@net-b.de> Dominique d'Humieres <dominiq@lps.ens.fr> - * gfortran.dg/finalize_10.f90: Update dg-dump. + * gfortran.dg/finalize_10.f90: Update scan-tree-dump. 2013-06-12 Jakub Jelinek <jakub@redhat.com> Index: gcc/testsuite/gfortran.dg/finalize_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/finalize_10.f90 (Revision 200003) +++ gcc/testsuite/gfortran.dg/finalize_10.f90 (Arbeitskopie) @@ -26,7 +26,7 @@ ! Finalize CLASS + set default init ! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } } -! { dg-final { scan-tree-dump "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned (long|int)\\) y->_vptr->_size\\);" "original" } } +! { dg-final { scan-tree-dump "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\((unsigned long|unsigned int|character\\(kind=4\\))\\) y->_vptr->_size\\);" "original" } } ! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } } ! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } } ^ permalink raw reply [flat|nested] 7+ messages in thread
* [Patch, Fortran] Finalize nonallocatables with INTENT(out) @ 2013-05-31 16:39 Tobias Burnus 2013-06-06 8:35 ` *PING* / " Tobias Burnus 0 siblings, 1 reply; 7+ messages in thread From: Tobias Burnus @ 2013-05-31 16:39 UTC (permalink / raw) To: gcc patches, gfortran [-- Attachment #1: Type: text/plain, Size: 827 bytes --] This patch adds finalization support for INTENT(out) for nonallocatable dummy arguments. Additionally, it addresses a missed optimization: The previous code tried to deallocate allocatable components even if the dummy argument was already an allocatable. That's a missed optimization as gfortran deallocates allocatables in the caller. OK for the trunk? Note: This patch depends on http://gcc.gnu.org/ml/fortran/2013-05/msg00134.html Tobias PS: There are many more places where finalization should happen, e.g. intrinsic assignment (LHS + RHS func/constructor finalization), end-of-scope of nonallocatables. And some issues related coarrays, elemental+optional, etc. However, I stop here for the moment as I run out of time - and writing on-top patches of not reviewed/committed patches starts to become a chore. [-- Attachment #2: final-intentout-v2.diff --] [-- Type: text/x-patch, Size: 5586 bytes --] 2013-05-31 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * trans-decl.c (init_intent_out_dt): Call finalizer when approriate. 2013-05-31 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * gfortran.dg/finalize_10.f90: New. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 100ec18..7521dee 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3501,38 +3503,56 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) { - if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) + tmp = NULL_TREE; + + /* Note: Allocatables are excluded as they are already handled + by the caller. */ + if (!f->sym->attr.allocatable + && gfc_is_finalizable (f->sym->ts.u.derived, NULL)) { - tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, - f->sym->backend_decl, - f->sym->as ? f->sym->as->rank : 0); + stmtblock_t block; + gfc_expr *e; + + f->sym->attr.referenced = 1; + e = gfc_lval_expr_from_sym (f->sym); + gfc_add_finalizer_call (&block, e); + gfc_free_expr (e); + tmp = gfc_finish_block (&block); + } - if (f->sym->attr.optional - || f->sym->ns->proc_name->attr.entry_master) - { - present = gfc_conv_expr_present (f->sym); - tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), - present, tmp, - build_empty_stmt (input_location)); - } + if (tmp == NULL_TREE && !f->sym->attr.allocatable + && f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) + tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, + f->sym->backend_decl, + f->sym->as ? f->sym->as->rank : 0); - gfc_add_expr_to_block (&init, tmp); + if (tmp != NULL_TREE && (f->sym->attr.optional + || f->sym->ns->proc_name->attr.entry_master)) + { + present = gfc_conv_expr_present (f->sym); + tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), + present, tmp, build_empty_stmt (input_location)); } - else if (f->sym->value) + + if (tmp != NULL_TREE) + gfc_add_expr_to_block (&init, tmp); + else if (f->sym->value && !f->sym->attr.allocatable) gfc_init_default_dt (f->sym, &init, true); } else if (f->sym && f->sym->attr.intent == INTENT_OUT && f->sym->ts.type == BT_CLASS && !CLASS_DATA (f->sym)->attr.class_pointer - && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp) + && !CLASS_DATA (f->sym)->attr.allocatable) { - tmp = gfc_class_data_get (f->sym->backend_decl); - if (CLASS_DATA (f->sym)->as == NULL) - tmp = build_fold_indirect_ref_loc (input_location, tmp); - tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived, - tmp, - CLASS_DATA (f->sym)->as ? - CLASS_DATA (f->sym)->as->rank : 0); + stmtblock_t block; + gfc_expr *e; + + gfc_init_block (&block); + f->sym->attr.referenced = 1; + e = gfc_lval_expr_from_sym (f->sym); + gfc_add_finalizer_call (&block, e); + gfc_free_expr (e); + tmp = gfc_finish_block (&block); if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master) { --- /dev/null 2013-05-31 08:03:29.909107813 +0200 +++ gcc/gcc/testsuite/gfortran.dg/finalize_10.f90 2013-05-31 16:23:06.377019214 +0200 @@ -0,0 +1,39 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/37336 +! +! Finalize nonallocatable INTENT(OUT) +! +module m + type t + end type t + type t2 + contains + final :: fini + end type t2 +contains + elemental subroutine fini(var) + type(t2), intent(inout) :: var + end subroutine fini +end module m + +subroutine foo(x,y,aa,bb) + use m + class(t), intent(out) :: x(:),y + type(t2), intent(out) :: aa(:),bb +end subroutine foo + +! Finalize CLASS + set default init +! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } } + +! FINALIZE TYPE: +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void \\*\\) &\\(\\*aa.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg!final { scan-tree-dump-times "__final_m_T2 (&parm.\[0-9\]+, 0, 0);" 1 "original" } } +! { dg!final { scan-tree-dump-times "desc.\[0-9\]+.data = \\(void \\* restrict\\) bb;" 1 "original" } } +! { dg!final { scan-tree-dump-times "__final_m_T2 (&desc.\[0-9\]+, 0, 0);" 1 "original" } } + +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 index d261973..04ee7f2 100644 --- a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 +++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 @@ -11,11 +11,12 @@ type :: t integer, allocatable :: i(:) end type +block ! New block as the main program implies SAVE type(t) :: a call init(a) call init(a) - +end block contains subroutine init(x) @@ -25,5 +26,6 @@ contains end program -! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } ^ permalink raw reply [flat|nested] 7+ messages in thread
* *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-05-31 16:39 Tobias Burnus @ 2013-06-06 8:35 ` Tobias Burnus 2013-06-08 11:11 ` Mikael Morin 2013-06-09 11:35 ` Andreas Schwab 0 siblings, 2 replies; 7+ messages in thread From: Tobias Burnus @ 2013-06-06 8:35 UTC (permalink / raw) To: fortran; +Cc: gcc patches [-- Attachment #1: Type: text/plain, Size: 1050 bytes --] * PING * Attached is a rediff - including the later posted additional test case (http://gcc.gnu.org/ml/fortran/2013-05/msg00141.html) On May 31, 2013 18:39, Tobias Burnus wrote: > This patch adds finalization support for INTENT(out) for > nonallocatable dummy arguments. > > Additionally, it addresses a missed optimization: The previous code > tried to deallocate allocatable components even if the dummy argument > was already an allocatable. That's a missed optimization as gfortran > deallocates allocatables in the caller. > > OK for the trunk? > > Note: This patch depends on > http://gcc.gnu.org/ml/fortran/2013-05/msg00134.html > > Tobias > > PS: There are many more places where finalization should happen, e.g. > intrinsic assignment (LHS + RHS func/constructor finalization), > end-of-scope of nonallocatables. And some issues related coarrays, > elemental+optional, etc. > However, I stop here for the moment as I run out of time - and writing > on-top patches of not reviewed/committed patches starts to become a > chore. [-- Attachment #2: final-intentout-v3.diff --] [-- Type: text/x-patch, Size: 10961 bytes --] 2013-06-06 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * trans-decl.c (init_intent_out_dt): Call finalizer when approriate. 2013-06-06 Tobias Burnus <burnus@net-b.de> PR fortran/37336 * gfortran.dg/finalize_10.f90: New. * gfortran.dg/auto_dealloc_2.f90: Update tree-dump. * gfortran.dg/finalize_15.f90: New. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b0e3ffc..72bb23f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3501,38 +3503,57 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block) && !f->sym->attr.pointer && f->sym->ts.type == BT_DERIVED) { - if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) + tmp = NULL_TREE; + + /* Note: Allocatables are excluded as they are already handled + by the caller. */ + if (!f->sym->attr.allocatable + && gfc_is_finalizable (f->sym->ts.u.derived, NULL)) { - tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, - f->sym->backend_decl, - f->sym->as ? f->sym->as->rank : 0); + stmtblock_t block; + gfc_expr *e; + + gfc_init_block (&block); + f->sym->attr.referenced = 1; + e = gfc_lval_expr_from_sym (f->sym); + gfc_add_finalizer_call (&block, e); + gfc_free_expr (e); + tmp = gfc_finish_block (&block); + } - if (f->sym->attr.optional - || f->sym->ns->proc_name->attr.entry_master) - { - present = gfc_conv_expr_present (f->sym); - tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), - present, tmp, - build_empty_stmt (input_location)); - } + if (tmp == NULL_TREE && !f->sym->attr.allocatable + && f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value) + tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived, + f->sym->backend_decl, + f->sym->as ? f->sym->as->rank : 0); - gfc_add_expr_to_block (&init, tmp); + if (tmp != NULL_TREE && (f->sym->attr.optional + || f->sym->ns->proc_name->attr.entry_master)) + { + present = gfc_conv_expr_present (f->sym); + tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), + present, tmp, build_empty_stmt (input_location)); } - else if (f->sym->value) + + if (tmp != NULL_TREE) + gfc_add_expr_to_block (&init, tmp); + else if (f->sym->value && !f->sym->attr.allocatable) gfc_init_default_dt (f->sym, &init, true); } else if (f->sym && f->sym->attr.intent == INTENT_OUT && f->sym->ts.type == BT_CLASS && !CLASS_DATA (f->sym)->attr.class_pointer - && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp) + && !CLASS_DATA (f->sym)->attr.allocatable) { - tmp = gfc_class_data_get (f->sym->backend_decl); - if (CLASS_DATA (f->sym)->as == NULL) - tmp = build_fold_indirect_ref_loc (input_location, tmp); - tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived, - tmp, - CLASS_DATA (f->sym)->as ? - CLASS_DATA (f->sym)->as->rank : 0); + stmtblock_t block; + gfc_expr *e; + + gfc_init_block (&block); + f->sym->attr.referenced = 1; + e = gfc_lval_expr_from_sym (f->sym); + gfc_add_finalizer_call (&block, e); + gfc_free_expr (e); + tmp = gfc_finish_block (&block); if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master) { --- /dev/null 2013-06-06 09:52:08.544104880 +0200 +++ gcc/gcc/testsuite/gfortran.dg/finalize_10.f90 2013-06-03 12:32:38.763008261 +0200 @@ -0,0 +1,39 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/37336 +! +! Finalize nonallocatable INTENT(OUT) +! +module m + type t + end type t + type t2 + contains + final :: fini + end type t2 +contains + elemental subroutine fini(var) + type(t2), intent(inout) :: var + end subroutine fini +end module m + +subroutine foo(x,y,aa,bb) + use m + class(t), intent(out) :: x(:),y + type(t2), intent(out) :: aa(:),bb +end subroutine foo + +! Finalize CLASS + set default init +! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(&x->_data, x->_vptr->_size, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_copy \\(x->_vptr->_def_init, &x->_data\\);" 1 "original" } } + +! FINALIZE TYPE: +! { dg-final { scan-tree-dump-times "parm.\[0-9\]+.data = \\(void \\*\\) &\\(\\*aa.\[0-9\]+\\)\\\[0\\\];" 1 "original" } } +! { dg!final { scan-tree-dump-times "__final_m_T2 (&parm.\[0-9\]+, 0, 0);" 1 "original" } } +! { dg!final { scan-tree-dump-times "desc.\[0-9\]+.data = \\(void \\* restrict\\) bb;" 1 "original" } } +! { dg!final { scan-tree-dump-times "__final_m_T2 (&desc.\[0-9\]+, 0, 0);" 1 "original" } } + +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 index d261973..04ee7f2 100644 --- a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 +++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 @@ -25,5 +26,6 @@ contains end program -! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } } +! { dg-final { scan-tree-dump-times "x->_vptr->_final \\(" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } --- /dev/null 2013-06-06 09:52:08.544104880 +0200 +++ gcc/gcc/testsuite/gfortran.dg/finalize_15.f90 2013-05-31 22:29:58.958076041 +0200 @@ -0,0 +1,238 @@ +! { dg-do run } +! +! PR fortran/37336 +! +! Check the scalarizer/array packing with strides +! in the finalization wrapper +! +module m + implicit none + + type t1 + integer :: i + contains + final :: fini_elem + end type t1 + + type, extends(t1) :: t1e + integer :: j + contains + final :: fini_elem2 + end type t1e + + type t2 + integer :: i + contains + final :: fini_shape + end type t2 + + type, extends(t2) :: t2e + integer :: j + contains + final :: fini_shape2 + end type t2e + + type t3 + integer :: i + contains + final :: fini_explicit + end type t3 + + type, extends(t3) :: t3e + integer :: j + contains + final :: fini_explicit2 + end type t3e + + integer :: cnt1, cnt1e, cnt2, cnt2e, cnt3, cnt3e + +contains + + impure elemental subroutine fini_elem(x) + type(t1), intent(inout) :: x + integer :: i, j, i2, j2 + + if (cnt1e /= 5*4) call abort () + j = mod (cnt1,5)+1 + i = cnt1/5 + 1 + i2 = (i-1)*3 + 1 + j2 = (j-1)*2 + 1 + if (x%i /= j2 + 100*i2) call abort () + x%i = x%i * (-13) + cnt1 = cnt1 + 1 + end subroutine fini_elem + + impure elemental subroutine fini_elem2(x) + type(t1e), intent(inout) :: x + integer :: i, j, i2, j2 + + j = mod (cnt1e,5)+1 + i = cnt1e/5 + 1 + i2 = (i-1)*3 + 1 + j2 = (j-1)*2 + 1 + if (x%i /= j2 + 100*i2) call abort () + if (x%j /= (j2 + 100*i2)*100) call abort () + x%j = x%j * (-13) + cnt1e = cnt1e + 1 + end subroutine fini_elem2 + + subroutine fini_shape(x) + type(t2) :: x(:,:) + if (cnt2e /= 1 .or. cnt2 /= 0) call abort () + call check_var_sec(x%i, 1) + x%i = x%i * (-13) + cnt2 = cnt2 + 1 + end subroutine fini_shape + + subroutine fini_shape2(x) + type(t2e) :: x(:,:) + call check_var_sec(x%i, 1) + call check_var_sec(x%j, 100) + x%j = x%j * (-13) + cnt2e = cnt2e + 1 + end subroutine fini_shape2 + + subroutine fini_explicit(x) + type(t3) :: x(5,4) + if (cnt3e /= 1 .or. cnt3 /= 0) call abort () + call check_var_sec(x%i, 1) + x%i = x%i * (-13) + cnt3 = cnt3 + 1 + end subroutine fini_explicit + + subroutine fini_explicit2(x) + type(t3e) :: x(5,4) + call check_var_sec(x%i, 1) + call check_var_sec(x%j, 100) + x%j = x%j * (-13) + cnt3e = cnt3e + 1 + end subroutine fini_explicit2 + + subroutine fin_test_1(x) + class(t1), intent(out) :: x(5,4) + end subroutine fin_test_1 + + subroutine fin_test_2(x) + class(t2), intent(out) :: x(:,:) + end subroutine fin_test_2 + + subroutine fin_test_3(x) + class(t3), intent(out) :: x(:,:) + if (any (shape(x) /= [5,4])) call abort () + end subroutine fin_test_3 + + subroutine check_var_sec(x, factor) + integer :: x(:,:) + integer, value :: factor + integer :: i, j, i2, j2 + + do i = 1, 4 + i2 = (i-1)*3 + 1 + do j = 1, 5 + j2 = (j-1)*2 + 1 + if (x(j,i) /= (j2 + 100*i2)*factor) call abort () + end do + end do + end subroutine check_var_sec +end module m + + +program test + use m + implicit none + + class(t1), allocatable :: x(:,:) + class(t2), allocatable :: y(:,:) + class(t3), allocatable :: z(:,:) + integer :: i, j + + cnt1 = 0; cnt1e = 0; cnt2 = 0; cnt2e = 0; cnt3 = 0; cnt3e = 0 + + allocate (t1e :: x(10,10)) + allocate (t2e :: y(10,10)) + allocate (t3e :: z(10,10)) + + select type(x) + type is (t1e) + do i = 1, 10 + do j = 1, 10 + x(j,i)%i = j + 100*i + x(j,i)%j = (j + 100*i)*100 + end do + end do + end select + + select type(y) + type is (t2e) + do i = 1, 10 + do j = 1, 10 + y(j,i)%i = j + 100*i + y(j,i)%j = (j + 100*i)*100 + end do + end do + end select + + select type(z) + type is (t3e) + do i = 1, 10 + do j = 1, 10 + z(j,i)%i = j + 100*i + z(j,i)%j = (j + 100*i)*100 + end do + end do + end select + + if (cnt1 + cnt1e + cnt2 + cnt2e + cnt3 + cnt3e /= 0) call abort() + + call fin_test_1(x(::2,::3)) + if (cnt1 /= 5*4) call abort () + if (cnt1e /= 5*4) call abort () + cnt1 = 0; cnt1e = 0 + if (cnt2 + cnt2e + cnt3 + cnt3e /= 0) call abort() + + call fin_test_2(y(::2,::3)) + if (cnt2 /= 1) call abort () + if (cnt2e /= 1) call abort () + cnt2 = 0; cnt2e = 0 + if (cnt1 + cnt1e + cnt3 + cnt3e /= 0) call abort() + + call fin_test_3(z(::2,::3)) + if (cnt3 /= 1) call abort () + if (cnt3e /= 1) call abort () + cnt3 = 0; cnt3e = 0 + if (cnt1 + cnt1e + cnt2 + cnt2e /= 0) call abort() + + select type(x) + type is (t1e) + call check_val(x%i, 1) + call check_val(x%j, 100) + end select + + select type(y) + type is (t2e) + call check_val(y%i, 1) + call check_val(y%j, 100) + end select + + select type(z) + type is (t3e) + call check_val(z%i, 1) + call check_val(z%j, 100) + end select + +contains + subroutine check_val(x, factor) + integer :: x(:,:) + integer, value :: factor + integer :: i, j + do i = 1, 10 + do j = 1, 10 + if (mod (j-1, 2) == 0 .and. mod (i-1, 3) == 0) then + if (x(j,i) /= (j + 100*i)*factor*(-13)) call abort () + else + if (x(j,i) /= (j + 100*i)*factor) call abort () + end if + end do + end do + end subroutine check_val +end program test ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-06-06 8:35 ` *PING* / " Tobias Burnus @ 2013-06-08 11:11 ` Mikael Morin 2013-06-08 12:40 ` Tobias Burnus 2013-06-09 11:35 ` Andreas Schwab 1 sibling, 1 reply; 7+ messages in thread From: Mikael Morin @ 2013-06-08 11:11 UTC (permalink / raw) To: Tobias Burnus; +Cc: fortran, gcc patches Hello, Le 06/06/2013 10:35, Tobias Burnus a écrit : > * PING * > > Attached is a rediff - including the later posted additional test case > (http://gcc.gnu.org/ml/fortran/2013-05/msg00141.html) > > > On May 31, 2013 18:39, Tobias Burnus wrote: >> This patch adds finalization support for INTENT(out) for >> nonallocatable dummy arguments. >> >> Additionally, it addresses a missed optimization: The previous code >> tried to deallocate allocatable components even if the dummy argument >> was already an allocatable. That's a missed optimization as gfortran >> deallocates allocatables in the caller. >> Is there any reason to handle them in the caller? The patch is OK. Mikael ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-06-08 11:11 ` Mikael Morin @ 2013-06-08 12:40 ` Tobias Burnus 0 siblings, 0 replies; 7+ messages in thread From: Tobias Burnus @ 2013-06-08 12:40 UTC (permalink / raw) To: Mikael Morin; +Cc: fortran, gcc patches Hello Mikael, thanks for your patch reviews! Regarding your question: Mikael Morin worte: > Le 06/06/2013 10:35, Tobias Burnus a écrit : >> On May 31, 2013 18:39, Tobias Burnus wrote: >>> This patch adds finalization support for INTENT(out) for >>> nonallocatable dummy arguments. >>> >>> Additionally, it addresses a missed optimization: The previous code >>> tried to deallocate allocatable components even if the dummy argument >>> was already an allocatable. That's a missed optimization as gfortran >>> deallocates allocatables in the caller. >>> > Is there any reason to handle them in the caller? I don't think that there is real reason - and I don't know why Erik Edelmann and Paul have chosen to do so for GCC 4.2. In principle, either location is fine. I think I had placed it into the callee, but now we cannot change it anymore without breaking the ABI. For TS29113 (i.e. for bind(C)), the Fortran procedure has to handle the deallocate for allocatable dummys with intent(out). Thus, in that case, one needs to have the deallocation code both in the caller and in the callee. (TS29113 only permits interoperable types with ALLOCATABLE or INTENT(OUT) - noninteroperable vars (i.e. extensible types, allocatable components, finalizers etc.) can be used in BIND(C) procedures - but only with the dummy argument TYPE(*) - and hence without ALLOCATABLE and INTENT(OUT)). Tobias PS: Pending patches: * 4.8/4.9 regression: http://gcc.gnu.org/ml/fortran/2013-06/msg00047.html * CLASS as result var: http://gcc.gnu.org/ml/fortran/2013-06/msg00053.html ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) 2013-06-06 8:35 ` *PING* / " Tobias Burnus 2013-06-08 11:11 ` Mikael Morin @ 2013-06-09 11:35 ` Andreas Schwab 1 sibling, 0 replies; 7+ messages in thread From: Andreas Schwab @ 2013-06-09 11:35 UTC (permalink / raw) To: Tobias Burnus; +Cc: fortran, gcc patches Tobias Burnus <burnus@net-b.de> writes: > --- /dev/null 2013-06-06 09:52:08.544104880 +0200 > +++ gcc/gcc/testsuite/gfortran.dg/finalize_10.f90 2013-06-03 12:32:38.763008261 +0200 > @@ -0,0 +1,39 @@ > +! { dg-do compile } > +! { dg-options "-fdump-tree-original" } > +! > +! PR fortran/37336 > +! > +! Finalize nonallocatable INTENT(OUT) > +! > +module m > + type t > + end type t > + type t2 > + contains > + final :: fini > + end type t2 > +contains > + elemental subroutine fini(var) > + type(t2), intent(inout) :: var > + end subroutine fini > +end module m > + > +subroutine foo(x,y,aa,bb) > + use m > + class(t), intent(out) :: x(:),y > + type(t2), intent(out) :: aa(:),bb > +end subroutine foo > + > +! Finalize CLASS + set default init > +! { dg-final { scan-tree-dump-times "y->_vptr->_final \\(&desc.\[0-9\]+, y->_vptr->_size, 0\\);" 1 "original" } } > +! { dg-final { scan-tree-dump-times "__builtin_memcpy \\(\\(void .\\) y->_data, \\(void .\\) y->_vptr->_def_init, \\(unsigned long\\) y->_vptr->_size\\);" 1 "original" } } That doesn't match. (void) __builtin_memcpy ((void *) y->_data, (void *) y->_vptr->_def_init, (character(kind=4)) y->_vptr->_size); Appears to be a 32/64 bit issue. Andreas. -- Andreas Schwab, schwab@linux-m68k.org GPG Key fingerprint = 58CA 54C7 6D53 942B 1756 01D3 44D5 214B 8276 4ED5 "And now for something completely different." ^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2013-06-12 13:29 UTC | newest] Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2013-06-09 10:46 *PING* / Re: [Patch, Fortran] Finalize nonallocatables with INTENT(out) Dominique Dhumieres 2013-06-12 13:18 ` Tobias Burnus 2013-06-12 13:29 ` Tobias Burnus -- strict thread matches above, loose matches on Subject: below -- 2013-05-31 16:39 Tobias Burnus 2013-06-06 8:35 ` *PING* / " Tobias Burnus 2013-06-08 11:11 ` Mikael Morin 2013-06-08 12:40 ` Tobias Burnus 2013-06-09 11:35 ` Andreas Schwab
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).