Skip to content

R
riscv-gcc-1
Commit 460263d0 by Tobias Burnus Committed by Tobias Burnus
Options

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
parent 8d4227c8
Showing with 33 additions and 15 deletions
gcc/fortran/ChangeLog
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
* check.c (gfc_check_reshape): Replace %<%d%> by %qd.
* matchexp.c (gfc_match_defined_op_name): Use %qc.
......
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)
......
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 *);
......
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))
......
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;
......
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
{
......
gcc/testsuite/ChangeLog
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.
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment