public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* 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).