trans-decl.c (create_function_arglist): Add hidden coarray

2014-04-30  Tobias Burnus  <burnus@net-b.de>

        * trans-decl.c (create_function_arglist): Add hidden coarray
        * arguments
        also for polymorphic coarrays.
        * trans-expr.c (gfc_conv_procedure_call): Pass hidden coarray
        arguments also for polymorphic coarrays.

2014-04-30  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_poly_7.f90
        * gfortran.dg/coarray_poly_8.f90
        * gfortran.dg/coarray_poly_9.f90

From-SVN: r209953

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1dcde5db695c3ccf06aadc135ac0bcf0c7e7276c..b991dc0b115ca0c56be10e1843d1927e28e2508f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+       * trans-decl.c (create_function_arglist): Add hidden coarray arguments
+       also for polymorphic coarrays.
+       * trans-expr.c (gfc_conv_procedure_call): Pass hidden coarray arguments
+       also for polymorphic coarrays.
+
 2014-04-30  Tobias Burnus  <burnus@net-b.de>
 
        * resolve.c (resolve_function): Don't do

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c835a3b34de3ead91ee4039d03d470ea24284eb5..ee6c7e3004d37705fc0d154f8ceb03cd021eb53f 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2234,9 +2234,12 @@ create_function_arglist (gfc_symbol * sym)
 
       /* Coarrays which are descriptorless or assumed-shape pass with
         -fcoarray=lib the token and the offset as hidden arguments.  */
-      if (f->sym->attr.codimension
-         && gfc_option.coarray == GFC_FCOARRAY_LIB
-         && !f->sym->attr.allocatable)
+      if (gfc_option.coarray == GFC_FCOARRAY_LIB
+         && ((f->sym->ts.type != BT_CLASS && f->sym->attr.codimension
+              && !f->sym->attr.allocatable)
+             || (f->sym->ts.type == BT_CLASS
+                 && CLASS_DATA (f->sym)->attr.codimension
+                 && !CLASS_DATA (f->sym)->attr.allocatable)))
        {
          tree caf_type;
          tree token;
@@ -2244,13 +2247,18 @@ create_function_arglist (gfc_symbol * sym)
 
          gcc_assert (f->sym->backend_decl != NULL_TREE
                      && !sym->attr.is_bind_c);
-         caf_type = TREE_TYPE (f->sym->backend_decl);
+         caf_type = f->sym->ts.type == BT_CLASS
+                    ? TREE_TYPE (CLASS_DATA (f->sym)->backend_decl)
+                    : TREE_TYPE (f->sym->backend_decl);
 
          token = build_decl (input_location, PARM_DECL,
                              create_tmp_var_name ("caf_token"),
                              build_qualified_type (pvoid_type_node,
                                                    TYPE_QUAL_RESTRICT));
-         if (f->sym->as->type == AS_ASSUMED_SHAPE)
+         if ((f->sym->ts.type != BT_CLASS
+              && f->sym->as->type != AS_DEFERRED)
+             || (f->sym->ts.type == BT_CLASS
+                 && CLASS_DATA (f->sym)->as->type != AS_DEFERRED))
            {
              gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL
                          || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE);
@@ -2275,7 +2283,10 @@ create_function_arglist (gfc_symbol * sym)
                               create_tmp_var_name ("caf_offset"),
                               gfc_array_index_type);
 
-         if (f->sym->as->type == AS_ASSUMED_SHAPE)
+         if ((f->sym->ts.type != BT_CLASS
+              && f->sym->as->type != AS_DEFERRED)
+             || (f->sym->ts.type == BT_CLASS
+                 && CLASS_DATA (f->sym)->as->type != AS_DEFERRED))
            {
              gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl)
                                               == NULL_TREE);

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f0e5b7ddc2f03a6b3d7d5b29212fa3bdcd973811..6b9353767efc1e1e0a4d075b57df3ec8d5fbf2c4 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4783,19 +4783,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
       /* For descriptorless coarrays and assumed-shape coarray dummies, we
         pass the token and the offset as additional arguments.  */
-      if (fsym && fsym->attr.codimension
-         && gfc_option.coarray == GFC_FCOARRAY_LIB
-         && !fsym->attr.allocatable
-         && e == NULL)
+      if (fsym && e == NULL && gfc_option.coarray == GFC_FCOARRAY_LIB
+         && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
+              && !fsym->attr.allocatable)
+             || (fsym->ts.type == BT_CLASS
+                 && CLASS_DATA (fsym)->attr.codimension
+                 && !CLASS_DATA (fsym)->attr.allocatable)))
        {
          /* Token and offset. */
          vec_safe_push (stringargs, null_pointer_node);
          vec_safe_push (stringargs, build_int_cst (gfc_array_index_type, 0));
          gcc_assert (fsym->attr.optional);
        }
-      else if (fsym && fsym->attr.codimension
-              && !fsym->attr.allocatable
-              && gfc_option.coarray == GFC_FCOARRAY_LIB)
+      else if (fsym && gfc_option.coarray == GFC_FCOARRAY_LIB
+              && ((fsym->ts.type != BT_CLASS && fsym->attr.codimension
+                   && !fsym->attr.allocatable)
+                  || (fsym->ts.type == BT_CLASS
+                      && CLASS_DATA (fsym)->attr.codimension
+                      && !CLASS_DATA (fsym)->attr.allocatable)))
        {
          tree caf_decl, caf_type;
          tree offset, tmp2;
@@ -4837,22 +4842,30 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
              tmp = caf_decl;
            }
 
-          if (fsym->as->type == AS_ASSUMED_SHAPE
-             || (fsym->as->type == AS_ASSUMED_RANK && !fsym->attr.pointer
-                 && !fsym->attr.allocatable))
+          tmp2 = fsym->ts.type == BT_CLASS
+                ? gfc_class_data_get (parmse.expr) : parmse.expr;
+          if ((fsym->ts.type != BT_CLASS
+              && (fsym->as->type == AS_ASSUMED_SHAPE
+                  || fsym->as->type == AS_ASSUMED_RANK))
+             || (fsym->ts.type == BT_CLASS
+                 && (CLASS_DATA (fsym)->as->type == AS_ASSUMED_SHAPE
+                     || CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)))
            {
-             gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
-             gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE
-                                                  (TREE_TYPE (parmse.expr))));
-             tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr);
+             if (fsym->ts.type == BT_CLASS)
+               gcc_assert (!POINTER_TYPE_P (TREE_TYPE (tmp2)));
+             else
+               {
+                 gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2)));
+                 tmp2 = build_fold_indirect_ref_loc (input_location, tmp2);
+               }
+             gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2)));
              tmp2 = gfc_conv_descriptor_data_get (tmp2);
            }
-         else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
-           tmp2 = gfc_conv_descriptor_data_get (parmse.expr);
+         else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp2)))
+           tmp2 = gfc_conv_descriptor_data_get (tmp2);
          else
            {
-             gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
-             tmp2 = parmse.expr;
+             gcc_assert (POINTER_TYPE_P (TREE_TYPE (tmp2)));
            }
 
          tmp = fold_build2_loc (input_location, MINUS_EXPR,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 862f133d8789ad0556ec5e1aa5e720208c1ccc17..c0c61b2cd9db94f14b53a0356e3335db7fb3e578 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/coarray_poly_7.f90
+       * gfortran.dg/coarray_poly_8.f90
+       * gfortran.dg/coarray_poly_9.f90
+
 2014-04-30  Tobias Burnus  <burnus@net-b.de>
 
        * gfortran.dg/coarray_lib_this_image_2.f90: Update dump.

diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
new file mode 100644 (file)
index 0000000..aeafa7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+  implicit none
+  type t
+  end type t
+  class(t), allocatable :: y[:]
+  call bar()
+  call foo(y)
+contains
+  subroutine bar(x)
+    class(t), optional :: x[*]
+  end subroutine bar
+  subroutine foo(x)
+    class(t) :: x[*]
+  end subroutine foo
+end
+! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
new file mode 100644 (file)
index 0000000..f33ecbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+  implicit none
+  type t
+  end type t
+  class(t), allocatable :: y(:)[:]
+  call bar()
+  call foo(y)
+contains
+  subroutine bar(x)
+    class(t), optional :: x(:)[*]
+  end subroutine bar
+  subroutine foo(x)
+    class(t) :: x(:)[*]
+  end subroutine foo
+end
+! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }

diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
new file mode 100644 (file)
index 0000000..65ad29c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+  implicit none
+  type t
+  end type t
+  class(t), allocatable :: y(:)[:]
+  call bar()
+  call foo(y)
+contains
+  subroutine bar(x)
+    class(t), optional :: x(2)[*]
+  end subroutine bar
+  subroutine foo(x)
+    class(t) :: x(2)[*]
+  end subroutine foo
+end
+! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=8\\)\\) class..._data.data - \\(integer\\(kind=8\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }