procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix Rejects allocatable coarray passed as a dummy argument [88624]

Browse source 
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.
This commit is contained in:
Andre Vehreschild 2024-07-11 10:07:12 +02:00
parent 0c5c0c959c
commit 9d8888650e
3 changed files with 47 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gcc/fortran/trans-expr.cc
View file

@ -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 (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 (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 (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));

2
gcc/testsuite/gfortran.dg/coarray/dummy_1.f90
View file

@ -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

21
gcc/testsuite/gfortran.dg/pr88624.f90 Normal file
View file

@ -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