diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2024-07-11 10:07:12 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2024-07-22 11:31:07 +0200 |
| commit | 9d8888650e97cb76e4ea3b5d060e4a4cef38fc58 (patch) | |
| tree | 7b33c2c2a2a54da0e3aec16ee1d9eb8552d25165 | |
| parent | 0c5c0c959c2e592b84739f19ca771fa69eb8dfee (diff) | |
| download | gcc-master.zip gcc-master.tar.gz gcc-master.tar.bz2 | |
Coarray parameters of procedures/functions need to be dereffed, because
they are references to the descriptor but the routine expected the
descriptor directly.
PR fortran/88624
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Treat
pointers/references (e.g. from parameters) correctly by derefing
them.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/dummy_1.f90: Add calling function trough
function.
* gfortran.dg/pr88624.f90: New test.
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 35 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr88624.f90 | 21 |
3 files changed, 48 insertions, 10 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d9eb333..feb43fd 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7773,16 +7773,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && CLASS_DATA (fsym)->attr.codimension && !CLASS_DATA (fsym)->attr.allocatable))) { - tree caf_decl, caf_type; + tree caf_decl, caf_type, caf_desc = NULL_TREE; tree offset, tmp2; caf_decl = gfc_get_tree_for_caf_expr (e); caf_type = TREE_TYPE (caf_decl); - - if (GFC_DESCRIPTOR_TYPE_P (caf_type) - && (GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE - || GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_POINTER)) - tmp = gfc_conv_descriptor_token (caf_decl); + if (POINTER_TYPE_P (caf_type) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (caf_type))) + caf_desc = TREE_TYPE (caf_type); + else if (GFC_DESCRIPTOR_TYPE_P (caf_type)) + caf_desc = caf_type; + + if (caf_desc + && (GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE + || GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_POINTER)) + { + tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl)) + ? build_fold_indirect_ref (caf_decl) + : caf_decl; + tmp = gfc_conv_descriptor_token (tmp); + } else if (DECL_LANG_SPECIFIC (caf_decl) && GFC_DECL_TOKEN (caf_decl) != NULL_TREE) tmp = GFC_DECL_TOKEN (caf_decl); @@ -7795,8 +7805,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, vec_safe_push (stringargs, tmp); - if (GFC_DESCRIPTOR_TYPE_P (caf_type) - && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE) + if (caf_desc + && GFC_TYPE_ARRAY_AKIND (caf_desc) == GFC_ARRAY_ALLOCATABLE) offset = build_int_cst (gfc_array_index_type, 0); else if (DECL_LANG_SPECIFIC (caf_decl) && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE) @@ -7806,8 +7816,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else offset = build_int_cst (gfc_array_index_type, 0); - if (GFC_DESCRIPTOR_TYPE_P (caf_type)) - tmp = gfc_conv_descriptor_data_get (caf_decl); + if (caf_desc) + { + tmp = POINTER_TYPE_P (TREE_TYPE (caf_decl)) + ? build_fold_indirect_ref (caf_decl) + : caf_decl; + tmp = gfc_conv_descriptor_data_get (tmp); + } else { gcc_assert (POINTER_TYPE_P (caf_type)); diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 index 33e9585..c437b2a 100644 --- a/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray/dummy_1.f90 @@ -66,5 +66,7 @@ if (lcobound(A, dim=1) /= 2) STOP 13 if (ucobound(A, dim=1) /= 3) STOP 14 if (lcobound(A, dim=2) /= 5) STOP 15 + + call sub4(A) ! Check PR88624 is fixed. end subroutine sub5 end diff --git a/gcc/testsuite/gfortran.dg/pr88624.f90 b/gcc/testsuite/gfortran.dg/pr88624.f90 new file mode 100644 index 0000000..e88ac90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr88624.f90 @@ -0,0 +1,21 @@ +!{ dg-do compile } +!{ dg-options "-fcoarray=lib" } + +! Check that PR fortran/88624 is fixed. +! Contributed by Modrzejewski <m.modrzejewski@student.uw.edu.pl> +! Reduced to the essence of the issue. + +program test + implicit none + integer, dimension(:), allocatable :: x[:] + call g(x) +contains + subroutine g(x) + integer, dimension(:), allocatable :: x[:] + call g2(x) + end subroutine g + subroutine g2(x) + integer, dimension(:) :: x[*] + end subroutine g2 +end program test + |