OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

primary.c (gfc_match_varspec): Match array spec for polymorphic coarrays. 

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

        * primary.c (gfc_match_varspec): Match array spec for
        polymorphic coarrays.
        (gfc_match_rvalue): If a symbol of unknown flavor has a
        codimension, mark it as a variable.
        * simplify.c (gfc_simplify_image_index): Directly call
        simplify_cobound.
        * trans-intrinsic.c (trans_this_image): Fix handling of
        corank = 1 arrays.

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

        * gfortran.dg/coarray/poly_run_3.f90: New.
        * gfortran.dg/coarray/poly_run_2.f90: Enable comment-out test.

From-SVN: r182371
This commit is contained in:
Tobias Burnus 2011-12-15 15:53:55 +01:00 committed by Tobias Burnus
parent 9d69847d6e
commit 492792ed9b
7 changed files with 88 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2011-12-15 Tobias Burnus <burnus@net-b.de>
* primary.c (gfc_match_varspec): Match array spec for
polymorphic coarrays.
(gfc_match_rvalue): If a symbol of unknown flavor has a
codimension, mark it as a variable.
* simplify.c (gfc_simplify_image_index): Directly call
simplify_cobound.
* trans-intrinsic.c (trans_this_image): Fix handling of
corank = 1 arrays.
2011-12-15 Jakub Jelinek <jakub@redhat.com>
PR debug/51517

11
gcc/fortran/primary.c
View File

@ -1821,7 +1821,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
&& !(gfc_matching_procptr_assignment
&& sym->attr.flavor == FL_PROCEDURE))
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& CLASS_DATA (sym)->attr.dimension))
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension)))
{
/* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character
@ -2894,10 +2895,10 @@ gfc_match_rvalue (gfc_expr **result)
&& gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
gfc_set_default_type (sym, 0, sym->ns);
/* If the symbol has a dimension attribute, the expression is a
/* If the symbol has a (co)dimension attribute, the expression is a
variable. */
if (sym->attr.dimension)
if (sym->attr.dimension || sym->attr.codimension)
{
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
sym->name, NULL) == FAILURE)
@ -2913,7 +2914,9 @@ gfc_match_rvalue (gfc_expr **result)
break;
}
if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension)
if (sym->ts.type == BT_CLASS
&& (CLASS_DATA (sym)->attr.dimension
|| CLASS_DATA (sym)->attr.codimension))
{
if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
sym->name, NULL) == FAILURE)

74
gcc/fortran/simplify.c
View File

@ -6227,10 +6227,6 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
gfc_expr *
gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim)
{
gfc_ref *ref;
gfc_array_spec *as;
int d;
if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
return NULL;
@ -6244,74 +6240,8 @@ gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim)
return result;
}
gcc_assert (coarray->expr_type == EXPR_VARIABLE);
/* Follow any component references. */
as = coarray->symtree->n.sym->as;
for (ref = coarray->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
as = ref->u.ar.as;
if (as->type == AS_DEFERRED)
return NULL;
if (dim == NULL)
{
/* Multi-dimensional bounds. */
gfc_expr *bounds[GFC_MAX_DIMENSIONS];
gfc_expr *e;
/* Simplify the bounds for each dimension. */
for (d = 0; d < as->corank; d++)
{
bounds[d] = simplify_bound_dim (coarray, NULL, d + as->rank + 1, 0,
as, NULL, true);
if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
{
int j;
for (j = 0; j < d; j++)
gfc_free_expr (bounds[j]);
return bounds[d];
}
}
/* Allocate the result expression. */
e = gfc_get_expr ();
e->where = coarray->where;
e->expr_type = EXPR_ARRAY;
e->ts.type = BT_INTEGER;
e->ts.kind = gfc_default_integer_kind;
e->rank = 1;
e->shape = gfc_get_shape (1);
mpz_init_set_ui (e->shape[0], as->corank);
/* Create the constructor for this array. */
for (d = 0; d < as->corank; d++)
gfc_constructor_append_expr (&e->value.constructor,
bounds[d], &e->where);
return e;
}
else
{
/* A DIM argument is specified. */
if (dim->expr_type != EXPR_CONSTANT)
return NULL;
d = mpz_get_si (dim->value.integer);
if (d < 1 || d > as->corank)
{
gfc_error ("DIM argument at %L is out of bounds", &dim->where);
return &gfc_bad_expr;
}
return simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL,
true);
}
/* For -fcoarray=single, this_image(A) is the same as lcobound(A). */
return simplify_cobound (coarray, dim, NULL, 0);
}

25
gcc/fortran/trans-intrinsic.c
View File

@ -1054,6 +1054,11 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
one always has a dim_arg argument.
m = this_images() - 1
if (corank == 1)
{
sub(1) = m + lcobound(corank)
return;
}
i = rank
min_var = min (rank + corank - 2, rank + dim_arg - 1)
for (;;)
@ -1070,15 +1075,29 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
: m + lcobound(corank)
*/
/* this_image () - 1. */
tmp = fold_convert (type, gfort_gvar_caf_this_image);
tmp = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
build_int_cst (type, 1));
if (corank == 1)
{
/* sub(1) = m + lcobound(corank). */
lbound = gfc_conv_descriptor_lbound_get (desc,
build_int_cst (TREE_TYPE (gfc_array_index_type),
corank+rank-1));
lbound = fold_convert (type, lbound);
tmp = fold_build2_loc (input_location, PLUS_EXPR, type, tmp, lbound);
se->expr = tmp;
return;
}
m = gfc_create_var (type, NULL);
ml = gfc_create_var (type, NULL);
loop_var = gfc_create_var (integer_type_node, NULL);
min_var = gfc_create_var (integer_type_node, NULL);
/* m = this_image () - 1. */
tmp = fold_convert (type, gfort_gvar_caf_this_image);
tmp = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
build_int_cst (type, 1));
gfc_add_modify (&se->pre, m, tmp);
/* min_var = min (rank + corank-2, rank + dim_arg - 1). */

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-12-15 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray/poly_run_3.f90: New.
* gfortran.dg/coarray/poly_run_2.f90: Enable comment-out test.
2011-12-15 Richard Guenther <rguenther@suse.de>
PR lto/51564

5
gcc/testsuite/gfortran.dg/coarray/poly_run_2.f90
View File

@ -10,9 +10,8 @@ if (allocated(A)) stop
if (any (lcobound(A) /= [1, -5])) call abort ()
if (num_images() == 1) then
if (any (ucobound(A) /= [4, -5])) call abort ()
! FIXME: Tree walk issue
!else
! if (ucobound(A,dim=1) /= 4) call abort ()
else
if (ucobound(A,dim=1) /= 4) call abort ()
end if
if (allocated(A)) i = 5
call s(A)

39
gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90 Normal file
View File

@ -0,0 +1,39 @@
! { dg-do run }
!
! Check that the bounds of polymorphic coarrays is
! properly handled.
!
type t
end type t
class(t), allocatable :: a(:)[:]
class(t), allocatable :: b[:], d[:]
allocate(a(1)[*])
if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
call abort ()
if (any (lcobound(a) /= 1)) call abort()
if (any (ucobound(a) /= this_image())) call abort ()
deallocate(a)
allocate(b[*])
if (this_image() == 1 .and. any (this_image(b) /= lcobound(b))) &
call abort ()
if (any (lcobound(b) /= 1)) call abort()
if (any (ucobound(b) /= this_image())) call abort ()
deallocate(b)
allocate(a(1)[-10:*])
if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
call abort ()
if (any (lcobound(a) /= -10)) call abort()
if (any (ucobound(a) /= -11+this_image())) call abort ()
deallocate(a)
allocate(d[23:*])
if (this_image() == 1 .and. any (this_image(d) /= lcobound(d))) &
call abort ()
if (any (lcobound(d) /= 23)) call abort()
if (any (ucobound(d) /= 22+this_image())) call abort ()
deallocate(d)
end