re PR fortran/45859 ([Coarray, F2008, IR] Rejects valid actuals to coarray dummies)

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

gcc/fortran
        PR fortran/45859
        * expr.c (gfc_is_simply_contiguous): Optionally permit array
        * elements.
        (gfc_check_pointer_assign): Update call.
        * interface.c (compare_parameter): Ditto.
        * trans-array.c (gfc_conv_array_parameter): Ditto.
        * trans-intrinsic.c (gfc_conv_intrinsic_transfer,
        conv_isocbinding_function): Ditto.
        * gfortran.h (gfc_is_simply_contiguous): Update prototype.

gcc/testsuite/
        PR fortran/45859
        * gcc/testsuite/gfortran.dg/coarray_args_2.f90: Remove dg-error.

From-SVN: r231585

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 749d5223d03de007913473697628555d266edc60..9c768fbc08bdea58690c6f86b2a4bc480a60fd5e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2014-12-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45859
+       * expr.c (gfc_is_simply_contiguous): Optionally permit array elements.
+       (gfc_check_pointer_assign): Update call.
+       * interface.c (compare_parameter): Ditto.
+       * trans-array.c (gfc_conv_array_parameter): Ditto.
+       * trans-intrinsic.c (gfc_conv_intrinsic_transfer,
+       conv_isocbinding_function): Ditto.
+       * gfortran.h (gfc_is_simply_contiguous): Update prototype.
+
 2014-12-12  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/68815

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 2aeb0b5f94604111817e9016b42d0d6b071c2696..5dd90ef891cab4c62c1e1d80e43ede8400f3469e 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3683,7 +3683,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
         and F2008 must be allowed.  */
       if (rvalue->rank != 1)
        {
-         if (!gfc_is_simply_contiguous (rvalue, true))
+         if (!gfc_is_simply_contiguous (rvalue, true, false))
            {
              gfc_error ("Rank remapping target must be rank 1 or"
                         " simply contiguous at %L", &rvalue->where);
@@ -4601,7 +4601,7 @@ gfc_has_ultimate_pointer (gfc_expr *e)
    a "(::1)" is accepted.  */
 
 bool
-gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
+gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
 {
   bool colon;
   int i;
@@ -4615,7 +4615,7 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
   else if (expr->expr_type != EXPR_VARIABLE)
     return false;
 
-  if (expr->rank == 0)
+  if (!permit_element && expr->rank == 0)
     return false;
 
   for (ref = expr->ref; ref; ref = ref->next)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9f61e4522c4d3c53187595ffa24f548ed060f109..d203c3212325d63b66995edb17ddaf8a85f8b75e 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2982,7 +2982,7 @@ void gfc_free_actual_arglist (gfc_actual_arglist *);
 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
 const char *gfc_extract_int (gfc_expr *, int *);
 bool is_subref_array (gfc_expr *);
-bool gfc_is_simply_contiguous (gfc_expr *, bool);
+bool gfc_is_simply_contiguous (gfc_expr *, bool, bool);
 bool gfc_check_init_expr (gfc_expr *);
 
 gfc_expr *gfc_build_conversion (gfc_expr *);

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f74239d48449c71fed5264e6489ebb56832331cd..bfd5d361e09f1442a827ded10d1013eadd8404ad 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2020,7 +2020,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
   /* F2008, C1241.  */
   if (formal->attr.pointer && formal->attr.contiguous
-      && !gfc_is_simply_contiguous (actual, true))
+      && !gfc_is_simply_contiguous (actual, true, false))
     {
       if (where)
        gfc_error ("Actual argument to contiguous pointer dummy %qs at %L "
@@ -2131,15 +2131,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
   if (formal->attr.codimension)
     {
-      /* F2008, 12.5.2.8.  */
+      /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048).  */
+      /* F2015, 12.5.2.8.  */
       if (formal->attr.dimension
          && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
          && gfc_expr_attr (actual).dimension
-         && !gfc_is_simply_contiguous (actual, true))
+         && !gfc_is_simply_contiguous (actual, true, true))
        {
          if (where)
            gfc_error ("Actual argument to %qs at %L must be simply "
-                      "contiguous", formal->name, &actual->where);
+                      "contiguous or an element of such an array",
+                      formal->name, &actual->where);
          return 0;
        }
 
@@ -2179,7 +2181,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       && (actual->symtree->n.sym->attr.asynchronous
          || actual->symtree->n.sym->attr.volatile_)
       &&  (formal->attr.asynchronous || formal->attr.volatile_)
-      && actual->rank && formal->as && !gfc_is_simply_contiguous (actual, true)
+      && actual->rank && formal->as
+      && !gfc_is_simply_contiguous (actual, true, false)
       && ((formal->as->type != AS_ASSUMED_SHAPE
           && formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer)
          || formal->attr.contiguous))

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 69f6e19f92260b1a216a71fe7fd5dc379d497c9c..6e24e2e954cdd9bcbf9676223d63962ee49dbd3e 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7386,7 +7386,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
                  && ref->u.ar.as->type != AS_ASSUMED_RANK
                  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
                      ||
-            gfc_is_simply_contiguous (expr, false));
+            gfc_is_simply_contiguous (expr, false, true));
 
   no_pack = contiguous && no_pack;
 
@@ -7464,7 +7464,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
     }
 
   if (g77 || (fsym && fsym->attr.contiguous
-             && !gfc_is_simply_contiguous (expr, false)))
+             && !gfc_is_simply_contiguous (expr, false, true)))
     {
       tree origptr = NULL_TREE;
 

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 31bad3563185a7198bfeb5b6bf7495561c37a0a2..4e6560319a7b3df97c07e56fea4ecd723f09b307 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -6269,7 +6269,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
       source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
 
       /* Repack the source if not simply contiguous.  */
-      if (!gfc_is_simply_contiguous (arg->expr, false))
+      if (!gfc_is_simply_contiguous (arg->expr, false, true))
        {
          tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);
 
@@ -7167,7 +7167,7 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr)
     {
       if (arg->expr->rank == 0)
        gfc_conv_expr_reference (se, arg->expr);
-      else if (gfc_is_simply_contiguous (arg->expr, false))
+      else if (gfc_is_simply_contiguous (arg->expr, false, false))
        gfc_conv_array_parameter (se, arg->expr, true, NULL, NULL, NULL);
       else
        {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1cfdb4d0a5851650526136dfef793de57c956175..f29a74bb998c2cd6c1a4106ec7af5718a8a30af8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-12-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45859
+       * gfortran.dg/coarray_args_2.f90: Remove dg-error.
+
 2015-12-12  David Edelsohn  <dje.gcc@gmail.com>
 
        * gcc.target/powerpc/pr67808.c: Add -mlong-double-128 option.

diff --git a/gcc/testsuite/gfortran.dg/coarray_args_2.f90 b/gcc/testsuite/gfortran.dg/coarray_args_2.f90
index c7dc490cc47063aa62f35a93a29e664cc9927c9d..869fa873e4dca95724b619f003146bd5e8e07698 100644 (file)
--- a/gcc/testsuite/gfortran.dg/coarray_args_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_args_2.f90
@@ -40,8 +40,7 @@ program rank_mismatch_02
   sync all
 
   call subr(ndim, a(1:1,2)) ! OK
-  call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" }
-                          ! See also F08/0048 and PR 45859 about the validity
+  call subr(ndim, a(1,2)) ! See also F08/0048 and PR 45859 about the validity
   if (this_image() == 1) then
      write(*, *) 'OK'
   end if