From 460263d0ef85e47cff2f39181a06d1d235ad4df7 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 12 Dec 2015 20:00:32 +0100 Subject: [PATCH] re PR fortran/45859 ([Coarray, F2008, IR] Rejects valid actuals to coarray dummies) 2014-12-12 Tobias Burnus 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 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/expr.c | 6 +++--- gcc/fortran/gfortran.h | 2 +- gcc/fortran/interface.c | 13 ++++++++----- gcc/fortran/trans-array.c | 4 ++-- gcc/fortran/trans-intrinsic.c | 4 ++-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/coarray_args_2.f90 | 3 +-- 8 files changed, 33 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 749d5223d03..9c768fbc08b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2014-12-12 Tobias Burnus + + 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 PR fortran/68815 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 2aeb0b5f946..5dd90ef891c 100644 --- 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 9f61e4522c4..d203c321232 100644 --- 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 f74239d4844..bfd5d361e09 100644 --- 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 69f6e19f922..6e24e2e954c 100644 --- 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 31bad356318..4e6560319a7 100644 --- 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 1cfdb4d0a58..f29a74bb998 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-12-12 Tobias Burnus + + PR fortran/45859 + * gfortran.dg/coarray_args_2.f90: Remove dg-error. + 2015-12-12 David Edelsohn * 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 c7dc490cc47..869fa873e4d 100644 --- 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 -- 2.30.2