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

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.

3 files changed, 48 insertions, 10 deletions

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d431ed5..9b61b66 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7777,16 +7777,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);
@@ -7799,8 +7809,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)
@@ -7810,8 +7820,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 
+