[PATCH] Fortran: handle procedure pointer component in DT array [PR110826]

2024-03-11 Thread Harald Anlauf
Dear all,

the attached patch fixes an ICE-on-valid code when assigning
a procedure pointer that is a component of a DT array and
the function in question is array-valued.  (The procedure
pointer itself cannot be an array.)

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

From a9be17cf987b796c49684cde2f20dac3839c736c Mon Sep 17 00:00:00 2001
From: Harald Anlauf 
Date: Mon, 11 Mar 2024 22:05:51 +0100
Subject: [PATCH] Fortran: handle procedure pointer component in DT array
 [PR110826]

gcc/fortran/ChangeLog:

	PR fortran/110826
	* array.cc (gfc_array_dimen_size): When walking the ref chain of an
	array and the ultimate component is a procedure pointer, do not try
	to figure out its dimension even if it is a array-valued function.

gcc/testsuite/ChangeLog:

	PR fortran/110826
	* gfortran.dg/proc_ptr_comp_53.f90: New test.
---
 gcc/fortran/array.cc  |  7 
 .../gfortran.dg/proc_ptr_comp_53.f90  | 41 +++
 2 files changed, 48 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 3a6e3a7c95b..e9934f1491b 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -2597,6 +2597,13 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
 case EXPR_FUNCTION:
   for (ref = array->ref; ref; ref = ref->next)
 	{
+	  /* Ultimate component is a procedure pointer.  */
+	  if (ref->type == REF_COMPONENT
+	  && !ref->next
+	  && ref->u.c.component->attr.function
+	  && IS_PROC_POINTER (ref->u.c.component))
+	return false;
+
 	  if (ref->type != REF_ARRAY)
 	continue;

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90
new file mode 100644
index 000..881ddd3558f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! PR fortran/110826 - procedure pointer component in DT array
+
+module m
+  implicit none
+
+  type pp
+procedure(func_template), pointer, nopass :: f =>null()
+  end type pp
+
+  abstract interface
+ function func_template(state) result(dstate)
+   implicit none
+   real, dimension(:,:), intent(in)  :: state
+   real, dimension(size(state,1), size(state,2)) :: dstate
+ end function
+  end interface
+
+contains
+
+  function zero_state(state) result(dstate)
+real, dimension(:,:), intent(in)  :: state
+real, dimension(size(state,1), size(state,2)) :: dstate
+dstate = 0.
+  end function zero_state
+
+end module m
+
+program test_func_array
+  use m
+  implicit none
+
+  real, dimension(4,6) :: state
+  type(pp) :: func_scalar
+  type(pp) :: func_array(4)
+
+  func_scalar  %f => zero_state
+  func_array(1)%f => zero_state
+  print *, func_scalar  %f(state)
+  print *, func_array(1)%f(state)
+end program test_func_array
--
2.35.3



Re: [Patch] OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283]

2024-03-11 Thread Jakub Jelinek
On Mon, Mar 11, 2024 at 11:07:46AM +0100, Tobias Burnus wrote:
> Using dummy procedures in a target region with 'defaultmap(none)' leads to:
> 
>   Error: 'g' not specified in enclosing 'target'
> 
> and this cannot be fixed by using 'firstprivate' as non-pointer dummy routines
> are rejected as "Error: Object 'g' is not a variable".
> 
> Fixed by doing the same for mapping as for data sharing: using predetermined
> firstprivate.
> 
> BTW: Only since GCC 14, 'declare target indirect' makes it possible to
> simply use dummy procedures and procedures pointers in a target region.

So firstprivate clause handling remaps them then if declare target indirect
is used?
If so, the patch looks reasonable to me.

Jakub



[Patch] OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283]

2024-03-11 Thread Tobias Burnus

Using dummy procedures in a target region with 'defaultmap(none)' leads to:

  Error: 'g' not specified in enclosing 'target'

and this cannot be fixed by using 'firstprivate' as non-pointer dummy routines
are rejected as "Error: Object 'g' is not a variable".

Fixed by doing the same for mapping as for data sharing: using predetermined
firstprivate.

BTW: Only since GCC 14, 'declare target indirect' makes it possible to
simply use dummy procedures and procedures pointers in a target region.

Comments? Suggestions?

Tobias

PS: Procedure pointers aren't variables either, but they act even more like
variables as they permit changing pointer association such that '(first)private'
vs. 'shared'/'map' can both make sense. — GCC accepts those in (nearly) all 
clauses,
ifort only in (first)private while flang not at all. The spec is somewhat silent
about it. This is tracked in the same PR (PR114283) and in the specification
issue #3823.
OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283]

Dummy procedures look similar to variables but aren't - neither in Fortran
nor in OpenMP. As the middle end sees PARM_DECLs, mark them as predetermined
firstprivate for mapping (as already done in gfc_omp_predetermined_sharing).

This does not address the isses related to procedure pointers, which are
still discussed on spec level [see PR].

	PR fortran/114283

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_omp_predetermined_mapping): Map dummy
	procedures as firstprivate.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/target4.f90: New test.

 gcc/fortran/trans-openmp.cc|  9 +
 gcc/testsuite/gfortran.dg/gomp/target4.f90 | 18 ++
 2 files changed, 27 insertions(+)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a2bf15665b3..1dba47126ed 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -343,6 +343,15 @@ gfc_omp_predetermined_mapping (tree decl)
 	&& GFC_DECL_SAVED_DESCRIPTOR (decl)))
 return OMP_CLAUSE_DEFAULTMAP_TO;
 
+  /* Dummy procedures aren't considered variables by OpenMP, thus are
+ disallowed in OpenMP clauses.  They are represented as PARM_DECLs
+ in the middle-end, so return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE here
+ to avoid complaining about their uses with defaultmap(none).  */
+  if (TREE_CODE (decl) == PARM_DECL
+  && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+  && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
+
   /* These are either array or derived parameters, or vtables.  */
   if (VAR_P (decl) && TREE_READONLY (decl)
   && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
diff --git a/gcc/testsuite/gfortran.dg/gomp/target4.f90 b/gcc/testsuite/gfortran.dg/gomp/target4.f90
new file mode 100644
index 000..09364e707f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target4.f90
@@ -0,0 +1,18 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! PR fortran/114283
+
+! { dg-final { scan-tree-dump "#pragma omp parallel default\\(none\\) firstprivate\\(g\\)" "gimple" } }
+! { dg-final { scan-tree-dump "#pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) defaultmap\\(none\\) firstprivate\\(g\\)" "gimple" } }
+
+subroutine f(g)
+procedure() :: g
+
+!$omp parallel default(none)
+  call g
+!$omp end parallel
+
+!$omp target defaultmap(none)
+  call g
+!$omp end target
+end