diff mbox series

[Fortran,PR101100,v1] Fix ICE when compiling with caf-lib and using proc_pointer component.

Message ID 20240919141903.5d1996f3@vepi2
State New
Headers
Series [Fortran,PR101100,v1] Fix ICE when compiling with caf-lib and using proc_pointer component. |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm fail Patch failed to apply
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 fail Patch failed to apply

Commit Message

Andre Vehreschild Sept. 19, 2024, 12:19 p.m. UTC 
  Hi all,

the attached patch fixes an ICE when compiling with -fcoarray=lib and using
(proc_-)pointer component in a coarray. The code was looking at the wrong
location for the caf-token.

Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?

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

Comments

Harald Anlauf Sept. 23, 2024, 7:25 p.m. UTC | #1 
Hi Andre,

Am 19.09.24 um 14:19 schrieb Andre Vehreschild:
> Hi all,
>
> the attached patch fixes an ICE when compiling with -fcoarray=lib and using
> (proc_-)pointer component in a coarray. The code was looking at the wrong
> location for the caf-token.
>
> Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?

this looks good to me.

Thanks for the patch!

Harald

> Regards,
> 	Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
Andre Vehreschild Sept. 24, 2024, 12:29 p.m. UTC | #2 
Hi Harald,

thanks for the review. Committed as gcc-15-3827-g0c0d79c783f

Thanks again,
	Andre

On Mon, 23 Sep 2024 21:25:55 +0200
Harald Anlauf <anlauf@gmx.de> wrote:

> Hi Andre,
>
> Am 19.09.24 um 14:19 schrieb Andre Vehreschild:
> > Hi all,
> >
> > the attached patch fixes an ICE when compiling with -fcoarray=lib and using
> > (proc_-)pointer component in a coarray. The code was looking at the wrong
> > location for the caf-token.
> >
> > Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> this looks good to me.
>
> Thanks for the patch!
>
> Harald
>
> > Regards,
> > 	Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>


--
Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox series

Patch

From 5115201ea3eb9caf673adce89c49e953cb46c375 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed, 18 Sep 2024 15:55:28 +0200
Subject: [PATCH] Fortran: Allow to nullify caf token when not in ultimate
 component. [PR101100]

gcc/fortran/ChangeLog:

	PR fortran/101100

	* trans-expr.cc (trans_caf_token_assign): Take caf-token from
	decl for non ultimate coarray components.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/proc_pointer_assign_1.f90: New test.
---
 gcc/fortran/trans-expr.cc                     |  8 ++++-
 .../coarray/proc_pointer_assign_1.f90         | 29 +++++++++++++++++++
 2 files changed, 36 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 54901c33139..18ef5e246ce 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10371,7 +10371,13 @@  trans_caf_token_assign (gfc_se *lse, gfc_se *rse, gfc_expr *expr1,
   else if (lhs_attr.codimension)
     {
       lhs_tok = gfc_get_ultimate_alloc_ptr_comps_caf_token (lse, expr1);
-      lhs_tok = build_fold_indirect_ref (lhs_tok);
+      if (!lhs_tok)
+	{
+	  lhs_tok = gfc_get_tree_for_caf_expr (expr1);
+	  lhs_tok = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (lhs_tok));
+	}
+      else
+	lhs_tok = build_fold_indirect_ref (lhs_tok);
       tmp = build2_loc (input_location, MODIFY_EXPR, void_type_node,
 			lhs_tok, null_pointer_node);
       gfc_prepend_expr_to_block (&lse->post, tmp);
diff --git a/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90 b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
new file mode 100644
index 00000000000..81f0c3b19cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/proc_pointer_assign_1.f90
@@ -0,0 +1,29 @@ 
+!{ dg-do run }
+
+! Check that PR101100 is fixed.
+
+! Contributed by G. Steinmetz  <gscfq@t-online.de>
+
+program p
+  type t
+    procedure(), pointer, nopass :: f
+  end type
+
+  integer :: i = 0
+  type(t) :: x[*]
+
+  x%f => null()
+  if ( associated(x%f) ) stop 1
+
+  x%f => g
+  if (.not. associated(x%f) ) stop 2
+
+  call x%f()
+  if ( i /= 1 ) stop 3
+
+contains
+  subroutine g()
+    i = 1
+  end subroutine
+end
+
--
2.46.0