diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2024-03-11 22:05:51 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2024-03-12 19:09:26 +0100 |
| commit | 81ee1298b47d3f3b3712ef3f3b2929ca26c4bcd2 (patch) | |
| tree | 63bc53462ed58044320eba29764acb2c47717a58 | |
| parent | ef79c64cb5762c86ee04ddfcedb7fe31eaa3bac8 (diff) | |
| download | gcc-81ee1298b47d3f3b3712ef3f3b2929ca26c4bcd2.zip gcc-81ee1298b47d3f3b3712ef3f3b2929ca26c4bcd2.tar.gz gcc-81ee1298b47d3f3b3712ef3f3b2929ca26c4bcd2.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/array.cc | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_comp_53.f90 | 43 |
2 files changed, 50 insertions, 0 deletions
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc index 3a6e3a7..e9934f1 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 0000000..affb592 --- /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 |