From: Harald Anlauf <anlauf@gmx.de>
To: fortran@gcc.gnu.org
Cc: gcc-patches@gcc.gnu.org
Subject: Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098]
Date: Fri, 21 Oct 2022 20:24:31 +0200 [thread overview]
Message-ID: <c6545a16-6ebe-08bc-adcc-d0dc998bad04@gmx.de> (raw)
In-Reply-To: <5a5b09f2-cfff-63dd-8ccb-6db9b42287c9@orange.fr>
[-- 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
WARNING: multiple messages have this Message-ID
From: Harald Anlauf <anlauf@gmx.de>
To: Mikael Morin <morin-mikael@orange.fr>, fortran@gcc.gnu.org
Cc: gcc-patches@gcc.gnu.org
Subject: Re: Proxy ping [PATCH] Fortran: Add missing TKR initialization to class variables [PR100097, PR100098]
Date: Fri, 21 Oct 2022 20:24:31 +0200 [thread overview]
Message-ID: <c6545a16-6ebe-08bc-adcc-d0dc998bad04@gmx.de> (raw)
Message-ID: <20221021182431.CAfhyi9eUHB8X_nO6pSz5nY2bSWRIj3NrK18VRoVT9c@z> (raw)
In-Reply-To: <5a5b09f2-cfff-63dd-8ccb-6db9b42287c9@orange.fr>
[-- 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
next prev parent reply other threads:[~2022-10-21 18:24 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-10-18 20:41 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 [this message]
2022-10-21 18:24 ` Harald Anlauf
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=c6545a16-6ebe-08bc-adcc-d0dc998bad04@gmx.de \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).