mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 23:31:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

Browse Source 
2011-05-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * trans-array.c (gfc_walk_variable_expr): Continue walking
        for scalar coarrays.
        * trans-intrinsic.c (convert_element_to_coarray_ref): New
        * function.
        (trans_this_image, trans_image_index, conv_intrinsic_cobound): Use it.
        (trans_this_image): Fix algorithm.
        * trans-types.c (gfc_get_element_type,
        * gfc_get_array_descriptor_base,
        gfc_sym_type): Handle scalar coarrays.

2011-05-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray/this_image_2.f90: New.

From-SVN: r173506
This commit is contained in:
Tobias Burnus 2011-05-06 20:39:08 +02:00 committed by Tobias Burnus
parent cc9ae24cbe
commit c81e79b590
6 changed files with 179 additions and 11 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-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* trans-array.c (gfc_walk_variable_expr): Continue walking
for scalar coarrays.
* trans-intrinsic.c (convert_element_to_coarray_ref): New function.
(trans_this_image, trans_image_index, conv_intrinsic_cobound): Use it.
(trans_this_image): Fix algorithm.
* trans-types.c (gfc_get_element_type, gfc_get_array_descriptor_base,
gfc_sym_type): Handle scalar coarrays.
2011-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/48858

2
gcc/fortran/trans-array.c
View File

@ -7443,7 +7443,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
ar = &ref->u.ar;
if (ar->as->rank == 0)
if (ar->as->rank == 0 && ref->next != NULL)
{
/* Scalar coarray. */
continue;

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

@ -921,6 +921,24 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
}
/* Convert the last ref of a scalar coarray from an AR_ELEMENT to an
AR_FULL, suitable for the scalarizer. */
static void
convert_element_to_coarray_ref (gfc_expr *expr)
{
gfc_ref *ref;
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->next == NULL
&& ref->u.ar.codimen)
{
ref->u.ar.type = AR_FULL;
break;
}
}
static void
trans_this_image (gfc_se * se, gfc_expr *expr)
{
@ -951,6 +969,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
if (expr->value.function.actual->expr->rank == 0)
convert_element_to_coarray_ref (expr->value.function.actual->expr);
ss = gfc_walk_expr (expr->value.function.actual->expr);
gcc_assert (ss != gfc_ss_terminator);
ss->data.info.codimen = corank;
@ -970,7 +990,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
dim_arg = se->loop->loopvar[0];
dim_arg = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, dim_arg,
gfc_rank_cst[rank]);
build_int_cst (TREE_TYPE (dim_arg), 1));
gfc_advance_se_ss_chain (se);
}
else
@ -1016,7 +1036,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
m = this_images() - 1
i = rank
min_var = min (corank - 2, dim_arg)
min_var = min (rank + corank - 2, rank + dim_arg - 1)
for (;;)
{
extent = gfc_extent(i)
@ -1042,10 +1062,13 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
build_int_cst (type, 1));
gfc_add_modify (&se->pre, m, tmp);
/* min_var = min (rank+corank-2, dim_arg). */
/* min_var = min (rank + corank-2, rank + dim_arg - 1). */
tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
fold_convert (integer_type_node, dim_arg),
build_int_cst (integer_type_node, rank - 1));
tmp = fold_build2_loc (input_location, MIN_EXPR, integer_type_node,
build_int_cst (integer_type_node, rank + corank - 2),
fold_convert (integer_type_node, dim_arg));
tmp);
gfc_add_modify (&se->pre, min_var, tmp);
/* i = rank. */
@ -1102,9 +1125,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
build_int_cst (TREE_TYPE (dim_arg), corank));
lbound = gfc_conv_descriptor_lbound_get (desc,
fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, dim_arg,
gfc_rank_cst[rank - 1]));
fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, dim_arg,
build_int_cst (TREE_TYPE (dim_arg), rank-1)));
lbound = fold_convert (type, lbound);
tmp = fold_build2_loc (input_location, MINUS_EXPR, type, ml,
@ -1133,6 +1156,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
if (expr->value.function.actual->expr->rank == 0)
convert_element_to_coarray_ref (expr->value.function.actual->expr);
ss = gfc_walk_expr (expr->value.function.actual->expr);
gcc_assert (ss != gfc_ss_terminator);
ss->data.info.codimen = corank;
@ -1457,6 +1482,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
corank = gfc_get_corank (arg->expr);
if (expr->value.function.actual->expr->rank == 0)
convert_element_to_coarray_ref (expr->value.function.actual->expr);
ss = gfc_walk_expr (arg->expr);
gcc_assert (ss != gfc_ss_terminator);
ss->data.info.codimen = corank;

6
gcc/fortran/trans-types.c
View File

@ -1205,7 +1205,7 @@ gfc_get_element_type (tree type)
int
gfc_is_nodesc_array (gfc_symbol * sym)
{
gcc_assert (sym->attr.dimension);
gcc_assert (sym->attr.dimension || sym->attr.codimension);
/* We only want local arrays. */
if (sym->attr.pointer || sym->attr.allocatable)
@ -1598,7 +1598,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
int idx = 2 * (codimen + dimen - 1) + restricted;
gcc_assert (dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
gcc_assert (codimen + dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
if (gfc_array_descriptor_base[idx])
return gfc_array_descriptor_base[idx];
@ -1996,7 +1996,7 @@ gfc_sym_type (gfc_symbol * sym)
if (!restricted)
type = gfc_nonrestricted_type (type);
if (sym->attr.dimension)
if (sym->attr.dimension || sym->attr.codimension)
{
if (gfc_is_nodesc_array (sym))
{

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray/this_image_2.f90: New.
2011-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/48858

125
gcc/testsuite/gfortran.dg/coarray/this_image_2.f90 Normal file
View File

@ -0,0 +1,125 @@
! { dg-do run }
!
! PR fortran/18918
!
! Version for scalar coarrays
!
! this_image(coarray) run test,
! expecially for num_images > 1
!
! Tested are values up to num_images == 8,
! higher values are OK, but not tested for
!
implicit none
integer :: a[2:2, 3:4, 7:*]
integer :: i
if (this_image(A, dim=1) /= 2) call abort()
i = 1
if (this_image(A, dim=i) /= 2) call abort()
select case (this_image())
case (1)
if (this_image(A, dim=2) /= 3) call abort()
if (this_image(A, dim=3) /= 7) call abort()
i = 2
if (this_image(A, dim=i) /= 3) call abort()
i = 3
if (this_image(A, dim=i) /= 7) call abort()
if (any (this_image(A) /= [2,3,7])) call abort()
case (2)
if (this_image(A, dim=2) /= 4) call abort()
if (this_image(A, dim=3) /= 7) call abort()
i = 2
if (this_image(A, dim=i) /= 4) call abort()
i = 3
if (this_image(A, dim=i) /= 7) call abort()
if (any (this_image(A) /= [2,4,7])) call abort()
case (3)
if (this_image(A, dim=2) /= 3) call abort()
if (this_image(A, dim=3) /= 8) call abort()
i = 2
if (this_image(A, dim=i) /= 3) call abort()
i = 3
if (this_image(A, dim=i) /= 8) call abort()
if (any (this_image(A) /= [2,3,8])) call abort()
case (4)
if (this_image(A, dim=2) /= 4) call abort()
if (this_image(A, dim=3) /= 8) call abort()
i = 2
if (this_image(A, dim=i) /= 4) call abort()
i = 3
if (this_image(A, dim=i) /= 8) call abort()
if (any (this_image(A) /= [2,4,8])) call abort()
case (5)
if (this_image(A, dim=2) /= 3) call abort()
if (this_image(A, dim=3) /= 9) call abort()
i = 2
if (this_image(A, dim=i) /= 3) call abort()
i = 3
if (this_image(A, dim=i) /= 9) call abort()
if (any (this_image(A) /= [2,3,9])) call abort()
case (6)
if (this_image(A, dim=2) /= 4) call abort()
if (this_image(A, dim=3) /= 9) call abort()
i = 2
if (this_image(A, dim=i) /= 4) call abort()
i = 3
if (this_image(A, dim=i) /= 9) call abort()
if (any (this_image(A) /= [2,4,9])) call abort()
case (7)
if (this_image(A, dim=2) /= 3) call abort()
if (this_image(A, dim=3) /= 10) call abort()
i = 2
if (this_image(A, dim=i) /= 3) call abort()
i = 3
if (this_image(A, dim=i) /= 10) call abort()
if (any (this_image(A) /= [2,3,10])) call abort()
case (8)
if (this_image(A, dim=2) /= 4) call abort()
if (this_image(A, dim=3) /= 10) call abort()
i = 2
if (this_image(A, dim=i) /= 4) call abort()
i = 3
if (this_image(A, dim=i) /= 10) call abort()
if (any (this_image(A) /= [2,4,10])) call abort()
end select
contains
subroutine test_image_index
implicit none
integer :: index1, index2, index3
logical :: one
integer, save :: d(2)[-1:3, *]
integer, save :: e(2)[-1:-1, 3:*]
one = num_images() == 1
index1 = image_index(d, [-1, 1] )
index2 = image_index(d, [0, 1] )
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
call abort()
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
call abort()
index1 = image_index(e, [-1, 3] )
index2 = image_index(e, [-1, 4] )
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
call abort()
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
call abort()
end subroutine test_image_index
end