https://gcc.gnu.org/g:4e9f475cdc8617f94c903656faaf28910c21c29b
commit r13-8445-g4e9f475cdc8617f94c903656faaf28910c21c29b
Author: Harald Anlauf <anl...@gmx.de>
Date: Mon Mar 11 22:05:51 2024 +0100
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.
(cherry picked from commit 81ee1298b47d3f3b3712ef3f3b2929ca26c4bcd2)
Diff:
---
gcc/fortran/array.cc | 7 +++++
gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 | 43 ++++++++++++++++++++++++++
2 files changed, 50 insertions(+)
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index be5eb8b6a0f..936f774353e 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -2600,6 +2600,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 00000000000..affb5922235
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90
@@ -0,0 +1,43 @@
+! { 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)
+ if (.not. all (shape (func_scalar %f(state)) == shape (state))) stop 1
+ if (.not. all (shape (func_array(1)%f(state)) == shape (state))) stop 2
+end program test_func_array
