* Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] @ 2022-10-18 20:41 Harald Anlauf 2022-10-18 20:48 ` Harald Anlauf 0 siblings, 1 reply; 6+ messages in thread From: Harald Anlauf @ 2022-10-18 20:41 UTC (permalink / raw) To: fortran, gcc-patches Dear all, Jose posted a patch here that was never reviewed: https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html I could not find any issues with his patch, it works as advertised and fixes the reported problem. As his testcases did not reliably fail without the patch but rather randomly due to the uninitialized descriptor, I added a check of the tree-dumps to verify that the TKR initializer is generated. Does anybody else have any comments? Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] 2022-10-18 20:41 Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] Harald Anlauf @ 2022-10-18 20:48 ` Harald Anlauf 2022-10-18 20:48 ` Harald Anlauf 2022-10-21 11:13 ` Mikael Morin 0 siblings, 2 replies; 6+ messages in thread From: Harald Anlauf @ 2022-10-18 20:48 UTC (permalink / raw) To: fortran, gcc-patches [-- Attachment #1: Type: text/plain, Size: 715 bytes --] I intended to add the updated patch but forgot, so here it is... Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran: > Dear all, > > Jose posted a patch here that was never reviewed: > > https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html > > I could not find any issues with his patch, it works as advertised > and fixes the reported problem. > > As his testcases did not reliably fail without the patch but rather > randomly due to the uninitialized descriptor, I added a check of > the tree-dumps to verify that the TKR initializer is generated. > > Does anybody else have any comments? > > Regtested on x86_64-pc-linux-gnu. OK for mainline? > > Thanks, > Harald > > > [-- Attachment #2: pr100098.diff --] [-- Type: text/x-patch, Size: 6914 bytes --] From 8d364acf33f27262ef5929a3c8d504ed6df0f943 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= <jrfsousa@gmail.com> Date: Tue, 18 Oct 2022 22:29:59 +0200 Subject: [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] gcc/fortran/ChangeLog: PR fortran/100097 PR fortran/100098 * trans-array.cc (gfc_trans_class_array): New function to initialize class descriptor's TKR information. * trans-array.h (gfc_trans_class_array): Add function prototype. * trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new function for both pointers and allocatables. gcc/testsuite/ChangeLog: PR fortran/100097 PR fortran/100098 * gfortran.dg/PR100097.f90: New test. * gfortran.dg/PR100098.f90: New test. --- gcc/fortran/trans-array.cc | 46 ++++++++++++++++++++++++++ gcc/fortran/trans-array.h | 2 ++ gcc/fortran/trans-decl.cc | 6 +++- gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +++++++++++++++++++++++++ 5 files changed, 139 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 795ce14af08..514cb057afb 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } +/* Initialize class descriptor's TKR infomation. */ + +void +gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) +{ + tree type, etype; + tree tmp; + tree descriptor; + stmtblock_t init; + locus loc; + int rank; + + /* Make sure the frontend gets these right. */ + gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable)); + + gcc_assert (VAR_P (sym->backend_decl) + || TREE_CODE (sym->backend_decl) == PARM_DECL); + + if (sym->attr.dummy) + return; + + descriptor = gfc_class_data_get (sym->backend_decl); + type = TREE_TYPE (descriptor); + + if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type)) + return; + + gfc_save_backend_locus (&loc); + gfc_set_backend_locus (&sym->declared_at); + gfc_init_block (&init); + + rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); + gcc_assert (rank>=0); + tmp = gfc_conv_descriptor_dtype (descriptor); + etype = gfc_get_element_type (type); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp, + gfc_get_dtype_rank_type (rank, etype)); + gfc_add_expr_to_block (&init, tmp); + + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); + gfc_restore_backend_locus (&loc); +} + + /* NULLIFY an allocatable/pointer array on function entry, free it on exit. Do likewise, recursively if necessary, with the allocatable components of derived types. This function is also called for assumed-rank arrays, which diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 04fee617590..cd2b3d9f2f0 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *); tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*); +/* Add initialization for class descriptors */ +void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *); /* Add initialization for deferred arrays. */ void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *); /* Generate an initializer for a static pointer or allocatable array. */ diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 4b570c3551a..63515b9072a 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4835,7 +4835,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)) - continue; + gfc_trans_class_array (sym, block); else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->attr.allocatable || (sym->attr.pointer && sym->attr.result) @@ -4919,6 +4919,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tmp = NULL_TREE; } + /* Initialize descriptor's TKR information. */ + if (sym->ts.type == BT_CLASS) + gfc_trans_class_array (sym, block); + /* Deallocate when leaving the scope. Nullifying is not needed. */ if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer diff --git a/gcc/testsuite/gfortran.dg/PR100097.f90 b/gcc/testsuite/gfortran.dg/PR100097.f90 new file mode 100644 index 00000000000..2a077d0e473 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100097.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100097 +! + +program main_p + implicit none + + class(*), pointer :: bar_p(:) + class(*), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(*), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(*), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.elem_len=.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.elem_len=.*\\}" "original" } } diff --git a/gcc/testsuite/gfortran.dg/PR100098.f90 b/gcc/testsuite/gfortran.dg/PR100098.f90 new file mode 100644 index 00000000000..55b1958aa4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100098.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100098 +! + +program main_p + implicit none + + type :: foo_t + integer :: i + end type foo_t + + class(foo_t), pointer :: bar_p(:) + class(foo_t), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(foo_t), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.elem_len=.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.elem_len=.*\\}" "original" } } -- 2.35.3 ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] 2022-10-18 20:48 ` Harald Anlauf @ 2022-10-18 20:48 ` Harald Anlauf 2022-10-21 11:13 ` Mikael Morin 1 sibling, 0 replies; 6+ messages in thread From: Harald Anlauf @ 2022-10-18 20:48 UTC (permalink / raw) To: fortran; +Cc: gcc-patches [-- Attachment #1: Type: text/plain, Size: 700 bytes --] I intended to add the updated patch but forgot, so here it is... Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran: > Dear all, > > Jose posted a patch here that was never reviewed: > > https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html > > I could not find any issues with his patch, it works as advertised > and fixes the reported problem. > > As his testcases did not reliably fail without the patch but rather > randomly due to the uninitialized descriptor, I added a check of > the tree-dumps to verify that the TKR initializer is generated. > > Does anybody else have any comments? > > Regtested on x86_64-pc-linux-gnu. OK for mainline? > > Thanks, > Harald > > > [-- Attachment #2: pr100098.diff --] [-- Type: text/x-patch, Size: 6914 bytes --] From 8d364acf33f27262ef5929a3c8d504ed6df0f943 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= <jrfsousa@gmail.com> Date: Tue, 18 Oct 2022 22:29:59 +0200 Subject: [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] gcc/fortran/ChangeLog: PR fortran/100097 PR fortran/100098 * trans-array.cc (gfc_trans_class_array): New function to initialize class descriptor's TKR information. * trans-array.h (gfc_trans_class_array): Add function prototype. * trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new function for both pointers and allocatables. gcc/testsuite/ChangeLog: PR fortran/100097 PR fortran/100098 * gfortran.dg/PR100097.f90: New test. * gfortran.dg/PR100098.f90: New test. --- gcc/fortran/trans-array.cc | 46 ++++++++++++++++++++++++++ gcc/fortran/trans-array.h | 2 ++ gcc/fortran/trans-decl.cc | 6 +++- gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +++++++++++++++++++++++++ 5 files changed, 139 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 795ce14af08..514cb057afb 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } +/* Initialize class descriptor's TKR infomation. */ + +void +gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) +{ + tree type, etype; + tree tmp; + tree descriptor; + stmtblock_t init; + locus loc; + int rank; + + /* Make sure the frontend gets these right. */ + gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable)); + + gcc_assert (VAR_P (sym->backend_decl) + || TREE_CODE (sym->backend_decl) == PARM_DECL); + + if (sym->attr.dummy) + return; + + descriptor = gfc_class_data_get (sym->backend_decl); + type = TREE_TYPE (descriptor); + + if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type)) + return; + + gfc_save_backend_locus (&loc); + gfc_set_backend_locus (&sym->declared_at); + gfc_init_block (&init); + + rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); + gcc_assert (rank>=0); + tmp = gfc_conv_descriptor_dtype (descriptor); + etype = gfc_get_element_type (type); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp, + gfc_get_dtype_rank_type (rank, etype)); + gfc_add_expr_to_block (&init, tmp); + + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); + gfc_restore_backend_locus (&loc); +} + + /* NULLIFY an allocatable/pointer array on function entry, free it on exit. Do likewise, recursively if necessary, with the allocatable components of derived types. This function is also called for assumed-rank arrays, which diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 04fee617590..cd2b3d9f2f0 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *); tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*); +/* Add initialization for class descriptors */ +void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *); /* Add initialization for deferred arrays. */ void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *); /* Generate an initializer for a static pointer or allocatable array. */ diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 4b570c3551a..63515b9072a 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4835,7 +4835,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)) - continue; + gfc_trans_class_array (sym, block); else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->attr.allocatable || (sym->attr.pointer && sym->attr.result) @@ -4919,6 +4919,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tmp = NULL_TREE; } + /* Initialize descriptor's TKR information. */ + if (sym->ts.type == BT_CLASS) + gfc_trans_class_array (sym, block); + /* Deallocate when leaving the scope. Nullifying is not needed. */ if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer diff --git a/gcc/testsuite/gfortran.dg/PR100097.f90 b/gcc/testsuite/gfortran.dg/PR100097.f90 new file mode 100644 index 00000000000..2a077d0e473 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100097.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100097 +! + +program main_p + implicit none + + class(*), pointer :: bar_p(:) + class(*), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(*), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(*), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.elem_len=.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.elem_len=.*\\}" "original" } } diff --git a/gcc/testsuite/gfortran.dg/PR100098.f90 b/gcc/testsuite/gfortran.dg/PR100098.f90 new file mode 100644 index 00000000000..55b1958aa4a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100098.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100098 +! + +program main_p + implicit none + + type :: foo_t + integer :: i + end type foo_t + + class(foo_t), pointer :: bar_p(:) + class(foo_t), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(foo_t), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.elem_len=.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.elem_len=.*\\}" "original" } } -- 2.35.3 ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] 2022-10-18 20:48 ` Harald Anlauf 2022-10-18 20:48 ` Harald Anlauf @ 2022-10-21 11:13 ` Mikael Morin 2022-10-21 18:24 ` Harald Anlauf 1 sibling, 1 reply; 6+ messages in thread From: Mikael Morin @ 2022-10-21 11:13 UTC (permalink / raw) To: Harald Anlauf, fortran; +Cc: gcc-patches Le 18/10/2022 à 22:48, Harald Anlauf via Fortran a écrit : > I intended to add the updated patch but forgot, so here it is... > > Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran: >> Dear all, >> >> Jose posted a patch here that was never reviewed: >> >> https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html >> >> I could not find any issues with his patch, it works as advertised >> and fixes the reported problem. >> >> As his testcases did not reliably fail without the patch but rather >> randomly due to the uninitialized descriptor, I added a check of >> the tree-dumps to verify that the TKR initializer is generated. >> >> Does anybody else have any comments? >> >> Regtested on x86_64-pc-linux-gnu. OK for mainline? >> Looks good but please check the initialization of rank instead of elem_len in the dump patterns (elem_len actually doesn't matter). OK with that change. Thanks. ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] 2022-10-21 11:13 ` Mikael Morin @ 2022-10-21 18:24 ` Harald Anlauf 2022-10-21 18:24 ` Harald Anlauf 0 siblings, 1 reply; 6+ messages in thread From: Harald Anlauf @ 2022-10-21 18:24 UTC (permalink / raw) To: fortran; +Cc: gcc-patches [-- Attachment #1: Type: text/plain, Size: 1177 bytes --] Hi Mikael, Am 21.10.22 um 13:13 schrieb Mikael Morin: > Le 18/10/2022 à 22:48, Harald Anlauf via Fortran a écrit : >> I intended to add the updated patch but forgot, so here it is... >> >> Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran: >>> Dear all, >>> >>> Jose posted a patch here that was never reviewed: >>> >>> https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html >>> >>> I could not find any issues with his patch, it works as advertised >>> and fixes the reported problem. >>> >>> As his testcases did not reliably fail without the patch but rather >>> randomly due to the uninitialized descriptor, I added a check of >>> the tree-dumps to verify that the TKR initializer is generated. >>> >>> Does anybody else have any comments? >>> >>> Regtested on x86_64-pc-linux-gnu. OK for mainline? >>> > Looks good but please check the initialization of rank instead of > elem_len in the dump patterns (elem_len actually doesn't matter). > OK with that change. You're right, this is what I should have done in the first place. Pushed: https://gcc.gnu.org/g:4cfdaeb2755121ac1069f09898def56469b0fb51 See also attached. > Thanks. > Thanks, Harald [-- Attachment #2: pr100098-v2.diff --] [-- Type: text/x-patch, Size: 6918 bytes --] From 4cfdaeb2755121ac1069f09898def56469b0fb51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= <jrfsousa@gmail.com> Date: Tue, 18 Oct 2022 22:29:59 +0200 Subject: [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] gcc/fortran/ChangeLog: PR fortran/100097 PR fortran/100098 * trans-array.cc (gfc_trans_class_array): New function to initialize class descriptor's TKR information. * trans-array.h (gfc_trans_class_array): Add function prototype. * trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new function for both pointers and allocatables. gcc/testsuite/ChangeLog: PR fortran/100097 PR fortran/100098 * gfortran.dg/PR100097.f90: New test. * gfortran.dg/PR100098.f90: New test. --- gcc/fortran/trans-array.cc | 46 ++++++++++++++++++++++++++ gcc/fortran/trans-array.h | 2 ++ gcc/fortran/trans-decl.cc | 6 +++- gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +++++++++++++++++++++++++ 5 files changed, 139 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 795ce14af08..514cb057afb 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } +/* Initialize class descriptor's TKR infomation. */ + +void +gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) +{ + tree type, etype; + tree tmp; + tree descriptor; + stmtblock_t init; + locus loc; + int rank; + + /* Make sure the frontend gets these right. */ + gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable)); + + gcc_assert (VAR_P (sym->backend_decl) + || TREE_CODE (sym->backend_decl) == PARM_DECL); + + if (sym->attr.dummy) + return; + + descriptor = gfc_class_data_get (sym->backend_decl); + type = TREE_TYPE (descriptor); + + if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type)) + return; + + gfc_save_backend_locus (&loc); + gfc_set_backend_locus (&sym->declared_at); + gfc_init_block (&init); + + rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); + gcc_assert (rank>=0); + tmp = gfc_conv_descriptor_dtype (descriptor); + etype = gfc_get_element_type (type); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp, + gfc_get_dtype_rank_type (rank, etype)); + gfc_add_expr_to_block (&init, tmp); + + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); + gfc_restore_backend_locus (&loc); +} + + /* NULLIFY an allocatable/pointer array on function entry, free it on exit. Do likewise, recursively if necessary, with the allocatable components of derived types. This function is also called for assumed-rank arrays, which diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 04fee617590..cd2b3d9f2f0 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *); tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*); +/* Add initialization for class descriptors */ +void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *); /* Add initialization for deferred arrays. */ void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *); /* Generate an initializer for a static pointer or allocatable array. */ diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 4b570c3551a..63515b9072a 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4835,7 +4835,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)) - continue; + gfc_trans_class_array (sym, block); else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->attr.allocatable || (sym->attr.pointer && sym->attr.result) @@ -4919,6 +4919,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tmp = NULL_TREE; } + /* Initialize descriptor's TKR information. */ + if (sym->ts.type == BT_CLASS) + gfc_trans_class_array (sym, block); + /* Deallocate when leaving the scope. Nullifying is not needed. */ if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer diff --git a/gcc/testsuite/gfortran.dg/PR100097.f90 b/gcc/testsuite/gfortran.dg/PR100097.f90 new file mode 100644 index 00000000000..f927d293e2c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100097.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100097 +! + +program main_p + implicit none + + class(*), pointer :: bar_p(:) + class(*), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(*), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(*), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.* .rank=1,.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.* .rank=1,.*\\}" "original" } } diff --git a/gcc/testsuite/gfortran.dg/PR100098.f90 b/gcc/testsuite/gfortran.dg/PR100098.f90 new file mode 100644 index 00000000000..26ac0c88425 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100098.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100098 +! + +program main_p + implicit none + + type :: foo_t + integer :: i + end type foo_t + + class(foo_t), pointer :: bar_p(:) + class(foo_t), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(foo_t), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.* .rank=1,.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.* .rank=1,.*\\}" "original" } } -- 2.35.3 ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] 2022-10-21 18:24 ` Harald Anlauf @ 2022-10-21 18:24 ` Harald Anlauf 0 siblings, 0 replies; 6+ messages in thread From: Harald Anlauf @ 2022-10-21 18:24 UTC (permalink / raw) To: Mikael Morin, fortran; +Cc: gcc-patches [-- Attachment #1: Type: text/plain, Size: 1213 bytes --] Hi Mikael, Am 21.10.22 um 13:13 schrieb Mikael Morin: > Le 18/10/2022 à 22:48, Harald Anlauf via Fortran a écrit : >> I intended to add the updated patch but forgot, so here it is... >> >> Am 18.10.22 um 22:41 schrieb Harald Anlauf via Fortran: >>> Dear all, >>> >>> Jose posted a patch here that was never reviewed: >>> >>> https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html >>> >>> I could not find any issues with his patch, it works as advertised >>> and fixes the reported problem. >>> >>> As his testcases did not reliably fail without the patch but rather >>> randomly due to the uninitialized descriptor, I added a check of >>> the tree-dumps to verify that the TKR initializer is generated. >>> >>> Does anybody else have any comments? >>> >>> Regtested on x86_64-pc-linux-gnu. OK for mainline? >>> > Looks good but please check the initialization of rank instead of > elem_len in the dump patterns (elem_len actually doesn't matter). > OK with that change. You're right, this is what I should have done in the first place. Pushed: https://gcc.gnu.org/g:4cfdaeb2755121ac1069f09898def56469b0fb51 See also attached. > Thanks. > Thanks, Harald [-- Attachment #2: pr100098-v2.diff --] [-- Type: text/x-patch, Size: 6918 bytes --] From 4cfdaeb2755121ac1069f09898def56469b0fb51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= <jrfsousa@gmail.com> Date: Tue, 18 Oct 2022 22:29:59 +0200 Subject: [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] gcc/fortran/ChangeLog: PR fortran/100097 PR fortran/100098 * trans-array.cc (gfc_trans_class_array): New function to initialize class descriptor's TKR information. * trans-array.h (gfc_trans_class_array): Add function prototype. * trans-decl.cc (gfc_trans_deferred_vars): Add calls to the new function for both pointers and allocatables. gcc/testsuite/ChangeLog: PR fortran/100097 PR fortran/100098 * gfortran.dg/PR100097.f90: New test. * gfortran.dg/PR100098.f90: New test. --- gcc/fortran/trans-array.cc | 46 ++++++++++++++++++++++++++ gcc/fortran/trans-array.h | 2 ++ gcc/fortran/trans-decl.cc | 6 +++- gcc/testsuite/gfortran.dg/PR100097.f90 | 41 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/PR100098.f90 | 45 +++++++++++++++++++++++++ 5 files changed, 139 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100097.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR100098.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 795ce14af08..514cb057afb 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11125,6 +11125,52 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } +/* Initialize class descriptor's TKR infomation. */ + +void +gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block) +{ + tree type, etype; + tree tmp; + tree descriptor; + stmtblock_t init; + locus loc; + int rank; + + /* Make sure the frontend gets these right. */ + gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable)); + + gcc_assert (VAR_P (sym->backend_decl) + || TREE_CODE (sym->backend_decl) == PARM_DECL); + + if (sym->attr.dummy) + return; + + descriptor = gfc_class_data_get (sym->backend_decl); + type = TREE_TYPE (descriptor); + + if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type)) + return; + + gfc_save_backend_locus (&loc); + gfc_set_backend_locus (&sym->declared_at); + gfc_init_block (&init); + + rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0); + gcc_assert (rank>=0); + tmp = gfc_conv_descriptor_dtype (descriptor); + etype = gfc_get_element_type (type); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp, + gfc_get_dtype_rank_type (rank, etype)); + gfc_add_expr_to_block (&init, tmp); + + gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE); + gfc_restore_backend_locus (&loc); +} + + /* NULLIFY an allocatable/pointer array on function entry, free it on exit. Do likewise, recursively if necessary, with the allocatable components of derived types. This function is also called for assumed-rank arrays, which diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 04fee617590..cd2b3d9f2f0 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -69,6 +69,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *); tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*); +/* Add initialization for class descriptors */ +void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *); /* Add initialization for deferred arrays. */ void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *); /* Generate an initializer for a static pointer or allocatable array. */ diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 4b570c3551a..63515b9072a 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -4835,7 +4835,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)) - continue; + gfc_trans_class_array (sym, block); else if ((!sym->attr.dummy || sym->ts.deferred) && (sym->attr.allocatable || (sym->attr.pointer && sym->attr.result) @@ -4919,6 +4919,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) tmp = NULL_TREE; } + /* Initialize descriptor's TKR information. */ + if (sym->ts.type == BT_CLASS) + gfc_trans_class_array (sym, block); + /* Deallocate when leaving the scope. Nullifying is not needed. */ if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer diff --git a/gcc/testsuite/gfortran.dg/PR100097.f90 b/gcc/testsuite/gfortran.dg/PR100097.f90 new file mode 100644 index 00000000000..f927d293e2c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100097.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100097 +! + +program main_p + implicit none + + class(*), pointer :: bar_p(:) + class(*), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(*), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(*), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.* .rank=1,.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.* .rank=1,.*\\}" "original" } } diff --git a/gcc/testsuite/gfortran.dg/PR100098.f90 b/gcc/testsuite/gfortran.dg/PR100098.f90 new file mode 100644 index 00000000000..26ac0c88425 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100098.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR100098 +! + +program main_p + implicit none + + type :: foo_t + integer :: i + end type foo_t + + class(foo_t), pointer :: bar_p(:) + class(foo_t), allocatable :: bar_a(:) + + call foo_p(bar_p) + call foo_a(bar_a) + +contains + + subroutine foo_p(that) + class(foo_t), pointer, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 1 + end select + end subroutine foo_p + + subroutine foo_a(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(1) + rank default + stop 2 + end select + end subroutine foo_a + +end program main_p + +! { dg-final { scan-tree-dump "bar_a._data.dtype = \\{.* .rank=1,.*\\}" "original" } } +! { dg-final { scan-tree-dump "bar_p._data.dtype = \\{.* .rank=1,.*\\}" "original" } } -- 2.35.3 ^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2022-10-21 18:24 UTC | newest] Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2022-10-18 20:41 Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098] Harald Anlauf 2022-10-18 20:48 ` Harald Anlauf 2022-10-18 20:48 ` Harald Anlauf 2022-10-21 11:13 ` Mikael Morin 2022-10-21 18:24 ` Harald Anlauf 2022-10-21 18:24 ` Harald Anlauf
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).