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.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d9eb333abcb1994ecede825fba54a51ea02affd8..feb43fdec746cea6a9fd0078efc92c28b920272d 100644 (file)
--- 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 33e95853ad4ab1cac1cfd9bee12a3fd8e755f28a..c437b2a10fc41f262204e018b4c0a599adda1542 100644 (file)
--- 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 (file)
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 
+