+2011-04-04 Tobias Burnus <burnus@net-b.de>
+ Mikael Morin <mikael.morin@sfr.fr>
+
+ PR fortran/18918
+ * check.c (is_coarray): Update - because of DIMEN_THIS_IMAGE.
+ * expr.c (gfc_is_coindexed): Ditto.
+ * gfortran.h (gfc_array_ref_dimen_type): Add DIMEN_THIS_IMAGE.
+ * interface.c (compare_parameter): Use gfc_expr_attr and
+ gfc_is_coindexed.
+ * resolve.c (check_dimension, compare_spec_to_ref,
+ resolve_allocate_expr, check_data_variable): Update for
+ DIMEN_THIS_IMAGE.
+ * simplify.c (gfc_simplify_lcobound, gfc_simplify_this_image,
+ gfc_simplify_ucobound): Allow non-constant bounds.
+ * trans-array.c (gfc_set_loop_bounds_from_array_spec,
+ gfc_trans_create_temp_array, gfc_trans_constant_array_constructor,
+ gfc_set_vector_loop_bounds, gfc_conv_array_index_offset,
+ gfc_start_scalarized_body, gfc_trans_scalarizing_loops,
+ gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride,
+ gfc_conv_ss_startstride, gfc_conv_loop_setup,
+ gfc_trans_array_bounds, gfc_conv_expr_descriptor,
+ gfc_walk_variable_expr): Handle codimen.
+ * trans-decl.c (gfc_build_qualified_array): Save cobounds.
+ * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use arg2.
+ (conv_intrinsic_cobound): New function.
+ (gfc_conv_intrinsic_function): Call it.
+ (gfc_walk_intrinsic_function, gfc_add_intrinsic_ss_code): Handle
+ ucobound, lcobound, this_image.
+ * fortran/trans-types.c (gfc_build_array_type): Save cobounds.
+ (gfc_get_dtype): Honour corank.
+ (gfc_get_nodesc_array_type): Save corank and codimensions.
+ (gfc_get_array_type_bounds): Save cobound.
+ * fortran/trans.h (gfc_ss_info,gfc_loopinfo): Add codimen item.
+ (gfc_array_kind): Add corank item.
+ (GFC_TYPE_ARRAY_CORANK): New macro.
+
2011-04-03 Kai Tietz <ktietz@redhat.com>
PR middle-end/48422
{
if (ref->type == REF_COMPONENT)
coarray = ref->u.c.component->attr.codimension;
- else if (ref->type != REF_ARRAY || ref->u.ar.dimen != 0
- || ref->u.ar.codimen != 0)
+ else if (ref->type != REF_ARRAY || ref->u.ar.dimen != 0)
coarray = false;
+ else if (ref->type == REF_ARRAY && ref->u.ar.codimen != 0)
+ {
+ int n;
+ for (n = 0; n < ref->u.ar.codimen; n++)
+ if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
+ coarray = false;
+ }
}
return coarray;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
- return true;
+ {
+ int n;
+ for (n = ref->u.ar.dimen; n < ref->u.ar.dimen + ref->u.ar.codimen; n++)
+ if (ref->u.ar.dimen_type[n] != DIMEN_THIS_IMAGE)
+ return true;
+ }
return false;
}
enum gfc_array_ref_dimen_type
{
- DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_UNKNOWN
+ DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_THIS_IMAGE, DIMEN_UNKNOWN
};
typedef struct gfc_array_ref
gfc_ref *last = NULL;
if (actual->expr_type != EXPR_VARIABLE
- || (actual->ref == NULL
- && !actual->symtree->n.sym->attr.codimension))
+ || !gfc_expr_attr (actual).codimension)
{
if (where)
gfc_error ("Actual argument to '%s' at %L must be a coarray",
return 0;
}
+ if (gfc_is_coindexed (actual))
+ {
+ if (where)
+ gfc_error ("Actual argument to '%s' at %L must be a coarray "
+ "and not coindexed", formal->name, &actual->where);
+ return 0;
+ }
+
for (ref = actual->ref; ref; ref = ref->next)
{
- if (ref->type == REF_ARRAY && ref->u.ar.codimen != 0)
- {
- if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray "
- "and not coindexed", formal->name, &ref->u.ar.where);
- return 0;
- }
if (ref->type == REF_ARRAY && ref->u.ar.as->corank
&& ref->u.ar.type != AR_FULL && ref->u.ar.dimen != 0)
{
last = ref;
}
- if (last && !last->u.c.component->attr.codimension)
- {
- if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray",
- formal->name, &actual->where);
- return 0;
- }
-
/* F2008, 12.5.2.6. */
if (formal->attr.allocatable &&
((last && last->u.c.component->as->corank != formal->as->corank)
switch (ar->dimen_type[i])
{
case DIMEN_VECTOR:
+ case DIMEN_THIS_IMAGE:
break;
case DIMEN_STAR:
if (ar->codimen != 0)
for (i = as->rank; i < as->rank + as->corank; i++)
{
- if (ar->dimen_type[i] != DIMEN_ELEMENT && !ar->in_allocate)
+ if (ar->dimen_type[i] != DIMEN_ELEMENT && !ar->in_allocate
+ && ar->dimen_type[i] != DIMEN_THIS_IMAGE)
{
gfc_error ("Coindex of codimension %d must be a scalar at %L",
i + 1 - as->rank, &ar->where);
return FAILURE;
}
+ if (as->corank && ar->codimen == 0)
+ {
+ int n;
+ ar->codimen = as->corank;
+ for (n = ar->dimen; n < ar->dimen + ar->codimen; n++)
+ ar->dimen_type[n] = DIMEN_THIS_IMAGE;
+ }
+
return SUCCESS;
}
ar = &ref2->u.ar;
- if (codimension && ar->codimen == 0)
- {
- gfc_error ("Coarray specification required in ALLOCATE statement "
- "at %L", &e->where);
- goto failure;
- }
+ if (codimension)
+ for (i = ar->dimen; i < ar->dimen + ar->codimen; i++)
+ if (ar->dimen_type[i] == DIMEN_THIS_IMAGE)
+ {
+ gfc_error ("Coarray specification required in ALLOCATE statement "
+ "at %L", &e->where);
+ goto failure;
+ }
for (i = 0; i < ar->dimen; i++)
{
case DIMEN_UNKNOWN:
case DIMEN_VECTOR:
case DIMEN_STAR:
+ case DIMEN_THIS_IMAGE:
gfc_error ("Bad array specification in ALLOCATE statement at %L",
&e->where);
goto failure;
has_pointer = sym->attr.pointer;
+ if (gfc_is_coindexed (e))
+ {
+ gfc_error ("DATA element '%s' at %L cannot have a coindex", sym->name,
+ where);
+ return FAILURE;
+ }
+
for (ref = e->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
has_pointer = 1;
- if (ref->type == REF_ARRAY && ref->u.ar.codimen)
- {
- gfc_error ("DATA element '%s' at %L cannot have a coindex",
- sym->name, where);
- return FAILURE;
- }
-
if (has_pointer
&& ref->type == REF_ARRAY
&& ref->u.ar.type != AR_FULL)
gfc_expr *
gfc_simplify_lcobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
{
- gfc_expr *e;
- /* return simplify_cobound (array, dim, kind, 0);*/
-
- e = simplify_cobound (array, dim, kind, 0);
- if (e != NULL)
- return e;
-
- gfc_error ("Not yet implemented: LCOBOUND for coarray with non-constant "
- "cobounds at %L", &array->where);
- return &gfc_bad_expr;
+ return simplify_cobound (array, dim, kind, 0);
}
gfc_expr *
as = ref->u.ar.as;
if (as->type == AS_DEFERRED)
- goto not_implemented; /* return NULL;*/
+ return NULL;
if (dim == NULL)
{
for (j = 0; j < d; j++)
gfc_free_expr (bounds[j]);
- if (bounds[d] == NULL)
- goto not_implemented;
+
return bounds[d];
}
}
}
else
{
- gfc_expr *e;
/* A DIM argument is specified. */
if (dim->expr_type != EXPR_CONSTANT)
- goto not_implemented; /*return NULL;*/
+ return NULL;
d = mpz_get_si (dim->value.integer);
return &gfc_bad_expr;
}
- /*return simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);*/
- e = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);
- if (e != NULL)
- return e;
- else
- goto not_implemented;
+ return simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL,
+ true);
}
-
-not_implemented:
- gfc_error ("Not yet implemented: THIS_IMAGE for coarray with non-constant "
- "cobounds at %L", &coarray->where);
- return &gfc_bad_expr;
}
gfc_expr *
gfc_simplify_ucobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
{
- gfc_expr *e;
- /* return simplify_cobound (array, dim, kind, 1);*/
-
- e = simplify_cobound (array, dim, kind, 1);
- if (e != NULL)
- return e;
-
- gfc_error ("Not yet implemented: UCOBOUND for coarray with non-constant "
- "cobounds at %L", &array->where);
- return &gfc_bad_expr;
+ return simplify_cobound (array, dim, kind, 1);
}
tree tmp;
if (as && as->type == AS_EXPLICIT)
- for (n = 0; n < se->loop->dimen; n++)
+ for (n = 0; n < se->loop->dimen + se->loop->codimen; n++)
{
dim = se->ss->data.info.dim[n];
gcc_assert (dim < as->rank);
gfc_add_block_to_block (&se->post, &tmpse.post);
lower = fold_convert (gfc_array_index_type, tmpse.expr);
- /* ...and the upper bound. */
- gfc_init_se (&tmpse, NULL);
- gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
- gfc_add_block_to_block (&se->pre, &tmpse.pre);
- gfc_add_block_to_block (&se->post, &tmpse.post);
- upper = fold_convert (gfc_array_index_type, tmpse.expr);
-
- /* Set the upper bound of the loop to UPPER - LOWER. */
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, upper, lower);
- tmp = gfc_evaluate_now (tmp, &se->pre);
- se->loop->to[n] = tmp;
+ if (se->loop->codimen == 0
+ || n < se->loop->dimen + se->loop->codimen - 1)
+ {
+ /* ...and the upper bound. */
+ gfc_init_se (&tmpse, NULL);
+ gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
+ gfc_add_block_to_block (&se->pre, &tmpse.pre);
+ gfc_add_block_to_block (&se->post, &tmpse.post);
+ upper = fold_convert (gfc_array_index_type, tmpse.expr);
+
+ /* Set the upper bound of the loop to UPPER - LOWER. */
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, upper, lower);
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ se->loop->to[n] = tmp;
+ }
}
}
}
size, tmp);
size = gfc_evaluate_now (size, pre);
}
+ for (n = info->dimen; n < info->dimen + info->codimen; n++)
+ {
+ gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+ gfc_index_zero_node);
+ if (n < info->dimen + info->codimen - 1)
+ gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], loop->to[n]);
+ }
/* Get the size of the array. */
info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
- for (i = 0; i < info->dimen; i++)
+ for (i = 0; i < info->dimen + info->codimen; i++)
{
info->delta[i] = gfc_index_zero_node;
info->start[i] = gfc_index_zero_node;
int n;
int dim;
- for (n = 0; n < loop->dimen; n++)
+ for (n = 0; n < loop->dimen + loop->codimen; n++)
{
dim = info->dim[n];
if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
gcc_assert (ar->type != AR_ELEMENT);
switch (ar->dimen_type[dim])
{
+ case DIMEN_THIS_IMAGE:
+ gcc_unreachable ();
+ break;
case DIMEN_ELEMENT:
/* Elemental dimension. */
gcc_assert (info->subscript[dim]
gcc_assert (!loop->array_parameter);
- for (dim = loop->dimen - 1; dim >= 0; dim--)
+ for (dim = loop->dimen + loop->codimen - 1; dim >= 0; dim--)
{
n = loop->order[dim];
pblock = body;
/* Generate the loops. */
- for (dim = 0; dim < loop->dimen; dim++)
+ for (dim = 0; dim < loop->dimen + loop->codimen; dim++)
{
n = loop->order[dim];
gfc_trans_scalarized_loop_end (loop, n, pblock);
/* Calculate the lower bound of an array section. */
static void
-gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
+gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim,
+ bool coarray, bool coarray_last)
{
gfc_expr *start;
gfc_expr *end;
- gfc_expr *stride;
+ gfc_expr *stride = NULL;
tree desc;
gfc_se se;
gfc_ss_info *info;
{
/* We use a zero-based index to access the vector. */
info->start[dim] = gfc_index_zero_node;
- info->stride[dim] = gfc_index_one_node;
info->end[dim] = NULL;
+ if (!coarray)
+ info->stride[dim] = gfc_index_one_node;
return;
}
desc = info->descriptor;
start = info->ref->u.ar.start[dim];
end = info->ref->u.ar.end[dim];
- stride = info->ref->u.ar.stride[dim];
+ if (!coarray)
+ stride = info->ref->u.ar.stride[dim];
/* Calculate the start of the range. For vector subscripts this will
be the range of the vector. */
/* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end
is an expression with side-effects. */
- if (end)
+ if (!coarray_last)
{
- /* Specified section start. */
- gfc_init_se (&se, NULL);
- gfc_conv_expr_type (&se, end, gfc_array_index_type);
- gfc_add_block_to_block (&loop->pre, &se.pre);
- info->end[dim] = se.expr;
- }
- else
- {
- /* No upper bound specified so use the bound of the array. */
- info->end[dim] = gfc_conv_array_ubound (desc, dim);
+ if (end)
+ {
+ /* Specified section start. */
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_type (&se, end, gfc_array_index_type);
+ gfc_add_block_to_block (&loop->pre, &se.pre);
+ info->end[dim] = se.expr;
+ }
+ else
+ {
+ /* No upper bound specified so use the bound of the array. */
+ info->end[dim] = gfc_conv_array_ubound (desc, dim);
+ }
+ info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre);
}
- info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre);
/* Calculate the stride. */
- if (stride == NULL)
+ if (!coarray && stride == NULL)
info->stride[dim] = gfc_index_one_node;
- else
+ else if (!coarray)
{
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, stride, gfc_array_index_type);
case GFC_SS_FUNCTION:
case GFC_SS_COMPONENT:
loop->dimen = ss->data.info.dimen;
+ loop->codimen = ss->data.info.codimen;
break;
/* As usual, lbound and ubound are exceptions!. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
loop->dimen = ss->data.info.dimen;
+ loop->codimen = 0;
+ break;
+
+ case GFC_ISYM_LCOBOUND:
+ case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_THIS_IMAGE:
+ loop->dimen = ss->data.info.dimen;
+ loop->codimen = ss->data.info.codimen;
+ break;
default:
break;
/* We should have determined the rank of the expression by now. If
not, that's bad news. */
- gcc_assert (loop->dimen != 0);
+ gcc_assert (loop->dimen + loop->codimen != 0);
/* Loop over all the SS in the chain. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
for (n = 0; n < ss->data.info.dimen; n++)
- gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]);
+ gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n],
+ false, false);
+ for (n = ss->data.info.dimen;
+ n < ss->data.info.dimen + ss->data.info.codimen; n++)
+ gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n], true,
+ n == ss->data.info.dimen
+ + ss->data.info.codimen -1);
+
break;
case GFC_SS_INTRINSIC:
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
+ case GFC_ISYM_LCOBOUND:
+ case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_THIS_IMAGE:
break;
+
default:
continue;
}
loop->temp_ss->data.temp.type = base_type;
loop->temp_ss->string_length = dest->string_length;
loop->temp_ss->data.temp.dimen = loop->dimen;
+ loop->temp_ss->data.temp.codimen = loop->codimen;
loop->temp_ss->next = gfc_ss_terminator;
gfc_add_ss_to_loop (loop, loop->temp_ss);
}
mpz_t i;
mpz_init (i);
- for (n = 0; n < loop->dimen; n++)
+ for (n = 0; n < loop->dimen + loop->codimen; n++)
{
loopspec[n] = NULL;
dynamic[n] = false;
known lower bound
known upper bound
*/
- else if (loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
+ else if ((loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
+ || n >= loop->dimen)
loopspec[n] = ss;
else if (integer_onep (info->stride[dim])
&& !integer_onep (specinfo->stride[spec_dim]))
/* Set the extents of this range. */
cshape = loopspec[n]->shape;
- if (cshape && INTEGER_CST_P (info->start[dim])
+ if (n < loop->dimen && cshape && INTEGER_CST_P (info->start[dim])
&& INTEGER_CST_P (info->stride[dim]))
{
loop->from[n] = info->start[dim];
}
/* Transform everything so we have a simple incrementing variable. */
- if (integer_onep (info->stride[dim]))
+ if (n < loop->dimen && integer_onep (info->stride[dim]))
info->delta[dim] = gfc_index_zero_node;
- else
+ else if (n < loop->dimen)
{
/* Set the delta for this section. */
info->delta[dim] = gfc_evaluate_now (loop->from[n], &loop->pre);
size = stride;
}
-
+ for (dim = as->rank; dim < as->rank + as->corank; dim++)
+ {
+ /* Evaluate non-constant array bound expressions. */
+ lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
+ if (as->lower[dim] && !INTEGER_CST_P (lbound))
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type);
+ gfc_add_block_to_block (pblock, &se.pre);
+ gfc_add_modify (pblock, lbound, se.expr);
+ }
+ ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
+ if (as->upper[dim] && !INTEGER_CST_P (ubound))
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type);
+ gfc_add_block_to_block (pblock, &se.pre);
+ gfc_add_modify (pblock, ubound, se.expr);
+ }
+ }
gfc_trans_vla_type_sizes (sym, pblock);
*poffset = offset;
se->string_length = loop.temp_ss->string_length;
loop.temp_ss->data.temp.dimen = loop.dimen;
+ loop.temp_ss->data.temp.codimen = loop.codimen;
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
limits will be the limits of the section.
A function may decide to repack the array to speed up access, but
we're not bothered about that here. */
- int dim, ndim;
+ int dim, ndim, codim;
tree parm;
tree parmtype;
tree stride;
{
/* Otherwise make a new one. */
parmtype = gfc_get_element_type (TREE_TYPE (desc));
- parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
- loop.from, loop.to, 0,
+ parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
+ loop.codimen, loop.from,
+ loop.to, 0,
GFC_ARRAY_UNKNOWN, false);
parm = gfc_create_var (parmtype, "parm");
}
base = NULL_TREE;
ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+ codim = info->codimen;
for (n = 0; n < ndim; n++)
{
stride = gfc_conv_array_stride (desc, n);
gfc_rank_cst[dim], stride);
}
+ for (n = ndim; n < ndim + codim; n++)
+ {
+ /* look for the corresponding scalarizer dimension: dim. */
+ for (dim = 0; dim < ndim + codim; dim++)
+ if (info->dim[dim] == n)
+ break;
+
+ /* loop exited early: the DIM being looked for has been found. */
+ gcc_assert (dim < ndim + codim);
+
+ from = loop.from[dim];
+ to = loop.to[dim];
+ gfc_conv_descriptor_lbound_set (&loop.pre, parm,
+ gfc_rank_cst[dim], from);
+ if (n < ndim + codim - 1)
+ gfc_conv_descriptor_ubound_set (&loop.pre, parm,
+ gfc_rank_cst[dim], to);
+ dim++;
+ }
+
if (se->data_not_needed)
gfc_conv_descriptor_data_set (&loop.pre, parm,
gfc_index_zero_node);
switch (ar->type)
{
case AR_ELEMENT:
- for (n = 0; n < ar->dimen; n++)
+ for (n = 0; n < ar->dimen + ar->codimen; n++)
{
newss = gfc_get_ss ();
newss->type = GFC_SS_SCALAR;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = ar->as->rank;
+ newss->data.info.codimen = 0;
newss->data.info.ref = ref;
/* Make sure array is the same as array(:,:), this way
we don't need to special case all the time. */
ar->dimen = ar->as->rank;
+ ar->codimen = 0;
for (n = 0; n < ar->dimen; n++)
{
newss->data.info.dim[n] = n;
gcc_assert (ar->end[n] == NULL);
gcc_assert (ar->stride[n] == NULL);
}
+ for (n = ar->dimen; n < ar->dimen + ar->as->corank; n++)
+ {
+ newss->data.info.dim[n] = n;
+ ar->dimen_type[n] = DIMEN_RANGE;
+
+ gcc_assert (ar->start[n] == NULL);
+ gcc_assert (ar->end[n] == NULL);
+ }
ss = newss;
break;
newss->expr = expr;
newss->next = ss;
newss->data.info.dimen = 0;
+ newss->data.info.codimen = 0;
newss->data.info.ref = ref;
/* We add SS chains for all the subscripts in the section. */
- for (n = 0; n < ar->dimen; n++)
+ for (n = 0; n < ar->dimen + ar->codimen; n++)
{
gfc_ss *indexss;
switch (ar->dimen_type[n])
{
+ case DIMEN_THIS_IMAGE:
+ continue;
case DIMEN_ELEMENT:
/* Add SS for elemental (scalar) subscripts. */
gcc_assert (ar->start[n]);
case DIMEN_RANGE:
/* We don't add anything for sections, just remember this
dimension for later. */
- newss->data.info.dim[newss->data.info.dimen] = n;
- newss->data.info.dimen++;
+ newss->data.info.dim[newss->data.info.dimen
+ + newss->data.info.codimen] = n;
+ if (n < ar->dimen)
+ newss->data.info.dimen++;
break;
case DIMEN_VECTOR:
indexss->next = gfc_ss_terminator;
indexss->loop_chain = gfc_ss_terminator;
newss->data.info.subscript[n] = indexss;
- newss->data.info.dim[newss->data.info.dimen] = n;
- newss->data.info.dimen++;
+ newss->data.info.dim[newss->data.info.dimen
+ + newss->data.info.codimen] = n;
+ if (n < ar->dimen)
+ newss->data.info.dimen++;
break;
default:
TREE_NO_WARNING (GFC_TYPE_ARRAY_STRIDE (type, dim)) = 1;
}
}
+ for (dim = GFC_TYPE_ARRAY_RANK (type);
+ dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type); dim++)
+ {
+ if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
+ {
+ GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
+ TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+ }
+ /* Don't try to use the unknown ubound for the last coarray dimension. */
+ if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
+ && dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type) - 1)
+ {
+ GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
+ TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+ }
+ }
if (GFC_TYPE_ARRAY_OFFSET (type) == NULL_TREE)
{
GFC_TYPE_ARRAY_OFFSET (type) = gfc_create_var_np (gfc_array_index_type,
se->expr = gfort_gvar_caf_num_images;
}
+
/* Evaluate a single upper or lower bound. */
/* TODO: bound intrinsic generates way too much unnecessary code. */
else
{
/* use the passed argument. */
- gcc_assert (arg->next->expr);
+ gcc_assert (arg2->expr);
gfc_init_se (&argse, NULL);
- gfc_conv_expr_type (&argse, arg->next->expr, gfc_array_index_type);
+ gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &argse.pre);
bound = argse.expr;
/* Convert from one based to zero based. */
static void
+conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
+{
+ gfc_actual_arglist *arg;
+ gfc_actual_arglist *arg2;
+ gfc_se argse;
+ gfc_ss *ss;
+ tree bound, resbound, resbound2, desc, cond, tmp;
+ tree type;
+ gfc_array_spec * as;
+ int corank;
+
+ gcc_assert (expr->value.function.isym->id == GFC_ISYM_LCOBOUND
+ || expr->value.function.isym->id == GFC_ISYM_UCOBOUND
+ || expr->value.function.isym->id == GFC_ISYM_THIS_IMAGE);
+
+ arg = expr->value.function.actual;
+ arg2 = arg->next;
+
+ gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
+ corank = gfc_get_corank (arg->expr);
+
+ as = gfc_get_full_arrayspec_from_expr (arg->expr);
+ gcc_assert (as);
+
+ ss = gfc_walk_expr (arg->expr);
+ gcc_assert (ss != gfc_ss_terminator);
+ ss->data.info.codimen = corank;
+ gfc_init_se (&argse, NULL);
+
+ gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+ gfc_add_block_to_block (&se->pre, &argse.pre);
+ gfc_add_block_to_block (&se->post, &argse.post);
+ desc = argse.expr;
+
+ if (se->ss)
+ {
+ mpz_t mpz_rank;
+ tree tree_rank;
+
+ /* Create an implicit second parameter from the loop variable. */
+ gcc_assert (!arg2->expr);
+ gcc_assert (corank > 0);
+ gcc_assert (se->loop->dimen == 1);
+ gcc_assert (se->ss->expr == expr);
+
+ mpz_init_set_ui (mpz_rank, arg->expr->rank);
+ tree_rank = gfc_conv_mpz_to_tree (mpz_rank, gfc_index_integer_kind);
+
+ bound = se->loop->loopvar[0];
+ bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
+ se->ss->data.info.delta[0]);
+ bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
+ tree_rank);
+ gfc_advance_se_ss_chain (se);
+ }
+ else
+ {
+ /* use the passed argument. */
+ gcc_assert (arg2->expr);
+ gfc_init_se (&argse, NULL);
+ gfc_conv_expr_type (&argse, arg2->expr, gfc_array_index_type);
+ gfc_add_block_to_block (&se->pre, &argse.pre);
+ bound = argse.expr;
+
+ if (INTEGER_CST_P (bound))
+ {
+ int hi, low;
+
+ hi = TREE_INT_CST_HIGH (bound);
+ low = TREE_INT_CST_LOW (bound);
+ if (hi || low < 1 || low > GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc)))
+ gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
+ "dimension index", expr->value.function.isym->name,
+ &expr->where);
+ }
+ else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+ {
+ bound = gfc_evaluate_now (bound, &se->pre);
+ cond = fold_build2 (LT_EXPR, boolean_type_node,
+ bound, build_int_cst (TREE_TYPE (bound), 1));
+ tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))];
+ tmp = fold_build2 (GT_EXPR, boolean_type_node, bound, tmp);
+ cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp);
+ gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
+ gfc_msg_fault);
+ }
+
+
+ /* Substract 1 to get to zero based and add dimensions. */
+ switch (arg->expr->rank)
+ {
+ case 0:
+ bound = fold_build2 (MINUS_EXPR, gfc_array_index_type, bound,
+ gfc_index_one_node);
+ case 1:
+ break;
+ default:
+ bound = fold_build2 (PLUS_EXPR, gfc_array_index_type, bound,
+ gfc_rank_cst[arg->expr->rank - 1]);
+ }
+ }
+
+ resbound = gfc_conv_descriptor_lbound_get (desc, bound);
+
+ if (expr->value.function.isym->id == GFC_ISYM_UCOBOUND)
+ {
+ cond = fold_build2 (EQ_EXPR, boolean_type_node, bound,
+ build_int_cst (TREE_TYPE (bound),
+ arg->expr->rank + corank - 1));
+ resbound2 = gfc_conv_descriptor_ubound_get (desc, bound);
+ se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
+ resbound, resbound2);
+ }
+ else
+ se->expr = resbound;
+
+ type = gfc_typenode_for_spec (&expr->ts);
+ se->expr = convert (type, se->expr);
+}
+
+
+static void
gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
{
tree arg, cabs;
gfc_conv_intrinsic_bound (se, expr, 0);
break;
+ case GFC_ISYM_LCOBOUND:
+ conv_intrinsic_cobound (se, expr);
+ break;
+
case GFC_ISYM_TRANSPOSE:
/* The scalarizer has already been set up for reversed dimension access
order ; now we just get the argument value normally. */
gfc_conv_intrinsic_bound (se, expr, 1);
break;
+ case GFC_ISYM_UCOBOUND:
+ conv_intrinsic_cobound (se, expr);
+ break;
+
case GFC_ISYM_XOR:
gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR);
break;
break;
case GFC_ISYM_THIS_IMAGE:
- trans_this_image (se, expr);
+ if (expr->value.function.actual)
+ conv_intrinsic_cobound (se, expr);
+ else
+ trans_this_image (se, expr);
break;
case GFC_ISYM_NUM_IMAGES:
{
case GFC_ISYM_UBOUND:
case GFC_ISYM_LBOUND:
+ case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_LCOBOUND:
+ case GFC_ISYM_THIS_IMAGE:
break;
default:
}
-/* UBOUND and LBOUND intrinsics with one parameter are expanded into code
- inside the scalarization loop. */
+/* The LBOUND, LCOBOUND, UBOUND and UCOBOUND intrinsics with one parameter
+ are expanded into code inside the scalarization loop. */
static gfc_ss *
gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr)
switch (isym->id)
{
case GFC_ISYM_LBOUND:
+ case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UBOUND:
+ case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_THIS_IMAGE:
return gfc_walk_intrinsic_bound (ss, expr);
case GFC_ISYM_TRANSFER:
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
+ for (n = as->rank; n < as->rank + as->corank; n++)
+ {
+ if (as->lower[n] == NULL)
+ lbound[n] = gfc_index_one_node;
+ else
+ lbound[n] = gfc_conv_array_bound (as->lower[n]);
+
+ if (n < as->rank + as->corank - 1)
+ ubound[n] = gfc_conv_array_bound (as->upper[n]);
+ }
+
if (as->type == AS_ASSUMED_SHAPE)
akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
: GFC_ARRAY_ASSUMED_SHAPE;
if (packed == PACKED_NO || packed == PACKED_PARTIAL)
known_stride = 0;
}
+ for (n = as->rank; n < as->rank + as->corank; n++)
+ {
+ expr = as->lower[n];
+ if (expr->expr_type == EXPR_CONSTANT)
+ tmp = gfc_conv_mpz_to_tree (expr->value.integer,
+ gfc_index_integer_kind);
+ else
+ tmp = NULL_TREE;
+ GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
+
+ expr = as->upper[n];
+ if (expr && expr->expr_type == EXPR_CONSTANT)
+ tmp = gfc_conv_mpz_to_tree (expr->value.integer,
+ gfc_index_integer_kind);
+ else
+ tmp = NULL_TREE;
+ if (n < as->rank + as->corank - 1)
+ GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
+ }
if (known_offset)
{
GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
GFC_TYPE_ARRAY_RANK (type) = as->rank;
+ GFC_TYPE_ARRAY_CORANK (type) = as->corank;
GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
NULL_TREE);
= ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
+ GFC_TYPE_ARRAY_CORANK (fat_type) = codimen;
GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
typedef struct gfc_ss_info
{
- int dimen;
+ int dimen, codimen;
/* The ref that holds information on this section. */
gfc_ref *ref;
/* The descriptor of this array. */
{
/* The rank of the temporary. May be less than the rank of the
assigned expression. */
- int dimen;
+ int dimen, codimen;
tree type;
}
temp;
stmtblock_t pre;
stmtblock_t post;
- int dimen;
+ int dimen, codimen;
/* All the SS involved with this loop. */
gfc_ss *ss;
variable-sized in some other frontends. Due to gengtype deficiency the GTY
options of such types have to agree across all frontends. */
struct GTY((variable_size)) lang_type {
- int rank;
+ int rank, corank;
enum gfc_array_kind akind;
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
#define GFC_TYPE_ARRAY_STRIDE(node, dim) \
(TYPE_LANG_SPECIFIC(node)->stride[dim])
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
+#define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
#define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
#define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
+2011-04-04 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * gfortran.dg/coarray_10.f90: Add coarray descriptor diagnostic check.
+ * gfortran.dg/coarray_13.f90: Add checks for run-time cobounds.
+ * gfortran.dg/coarray_15.f90: New.
+
2011-04-04 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* gfortran.dg/bessel_6.f90: Use dg-add-options ieee.
A(1)[1,1] = 1 ! { dg-error "Too few codimensions" }
A(1)[1,1:1] = 1 ! { dg-error "Too few codimensions" }
end subroutine rank_mismatch
+
+subroutine rank_mismatch2()
+ implicit none
+ integer, allocatable:: A(:)[:,:,:]
+ allocate(A(1)[7:8,4:*]) ! { dg-error "Unexpected .*. for codimension 2 of 3" }
+end subroutine rank_mismatch2
! { dg-do run }
-! { dg-options "-fcoarray=single" }
+! { dg-options "-fcoarray=single -fcheck=bounds" }
!
! Coarray support -- allocatable array coarrays
+! -- intrinsic procedures
! PR fortran/18918
! PR fortran/43931
!
program test
implicit none
+ integer,allocatable :: B(:)[:]
+
call one()
+ call two()
+ allocate(B(3)[-4:*])
+ call three(3,B,1)
+ call three_a(3,B)
+ call three_b(3,B)
+ call four(B)
+ call five()
contains
subroutine one()
integer, allocatable :: a(:)[:,:,:]
allocate(a(1)[-4:9,8,4:*])
+
+ if (this_image(a,dim=1) /= -4_8) call abort()
+ if (lcobound (a,dim=1) /= -4_8) call abort()
+ if (ucobound (a,dim=1) /= 9_8) call abort()
+
+ if (this_image(a,dim=2) /= 1_8) call abort()
+ if (lcobound (a,dim=2) /= 1_8) call abort()
+ if (ucobound (a,dim=2) /= 8_8) call abort()
+
+ if (this_image(a,dim=3) /= 4_8) call abort()
+ if (lcobound (a,dim=3) /= 4_8) call abort()
+ if (ucobound (a,dim=3) /= 4_8) call abort()
+
+ if (any(this_image(a) /= [-4_8, 1_8, 4_8])) call abort()
+ if (any(lcobound (a) /= [-4_8, 1_8, 4_8])) call abort()
+ if (any(ucobound (a) /= [9_8, 8_8, 4_8])) call abort()
end subroutine one
- subroutine four(C)
- integer, allocatable :: C(:)[:]
- end subroutine four
+
+ subroutine two()
+ integer, allocatable :: a(:)[:,:,:]
+ allocate(a(1)[-4:9,8,4:*])
+
+ if (this_image(a,dim=1) /= -4) call abort()
+ if (lcobound (a,dim=1) /= -4) call abort()
+ if (ucobound (a,dim=1) /= 9) call abort()
+
+ if (this_image(a,dim=2) /= 1) call abort()
+ if (lcobound (a,dim=2) /= 1) call abort()
+ if (ucobound (a,dim=2) /= 8) call abort()
+
+ if (this_image(a,dim=3) /= 4) call abort()
+ if (lcobound (a,dim=3) /= 4) call abort()
+ if (ucobound (a,dim=3) /= 4) call abort()
+
+ if (any(this_image(a) /= [-4, 1, 4])) call abort()
+ if (any(lcobound (a) /= [-4, 1, 4])) call abort()
+ if (any(ucobound (a) /= [9, 8, 4])) call abort()
+ end subroutine two
+
+ subroutine three(n,A, n2)
+ integer :: n, n2
+ integer :: A(3)[n:*]
+
+ A(1) = 42
+ if (A(1) /= 42) call abort()
+ A(1)[n2] = -42
+ if (A(1)[n2] /= -42) call abort()
+
+ if (this_image(A,dim=1) /= n) call abort()
+ if (lcobound (A,dim=1) /= n) call abort()
+ if (ucobound (A,dim=1) /= n) call abort()
+
+ if (any(this_image(A) /= n)) call abort()
+ if (any(lcobound (A) /= n)) call abort()
+ if (any(ucobound (A) /= n)) call abort()
+ end subroutine three
+
+ subroutine three_a(n,A)
+ integer :: n
+ integer :: A(3)[n+2:n+5,n-1:*]
+
+ A(1) = 42
+ if (A(1) /= 42) call abort()
+ A(1)[4,n] = -42
+ if (A(1)[4,n] /= -42) call abort()
+
+ if (this_image(A,dim=1) /= n+2) call abort()
+ if (lcobound (A,dim=1) /= n+2) call abort()
+ if (ucobound (A,dim=1) /= n+5) call abort()
+
+ if (this_image(A,dim=2) /= n-1) call abort()
+ if (lcobound (A,dim=2) /= n-1) call abort()
+ if (ucobound (A,dim=2) /= n-1) call abort()
+
+ if (any(this_image(A) /= [n+2,n-1])) call abort()
+ if (any(lcobound (A) /= [n+2,n-1])) call abort()
+ if (any(ucobound (A) /= [n+5,n-1])) call abort()
+ end subroutine three_a
+
+ subroutine three_b(n,A)
+ integer :: n
+ integer :: A(-1:3,0:4,-2:5,-4:7)[n+2:n+5,n-1:*]
+
+ A(1,1,1,1) = 42
+ if (A(1,1,1,1) /= 42) call abort()
+ A(1,1,1,1)[4,n] = -42
+ if (A(1,1,1,1)[4,n] /= -42) call abort()
+
+ if (this_image(A,dim=1) /= n+2) call abort()
+ if (lcobound (A,dim=1) /= n+2) call abort()
+ if (ucobound (A,dim=1) /= n+5) call abort()
+
+ if (this_image(A,dim=2) /= n-1) call abort()
+ if (lcobound (A,dim=2) /= n-1) call abort()
+ if (ucobound (A,dim=2) /= n-1) call abort()
+
+ if (any(this_image(A) /= [n+2,n-1])) call abort()
+ if (any(lcobound (A) /= [n+2,n-1])) call abort()
+ if (any(ucobound (A) /= [n+5,n-1])) call abort()
+ end subroutine three_b
+
+ subroutine four(A)
+ integer, allocatable :: A(:)[:]
+ if (this_image(A,dim=1) /= -4_8) call abort()
+ if (lcobound (A,dim=1) /= -4_8) call abort()
+ if (ucobound (A,dim=1) /= -4_8) call abort()
+ end subroutine four
+
+ subroutine five()
+ integer, save :: foo(2)[5:7,4:*]
+ integer :: i
+
+ i = 1
+ foo(1)[5,4] = 42
+ if (foo(1)[5,4] /= 42) call abort()
+ if (this_image(foo,dim=i) /= 5) call abort()
+ if (lcobound(foo,dim=i) /= 5) call abort()
+ if (ucobound(foo,dim=i) /= 7) call abort()
+
+ i = 2
+ if (this_image(foo,dim=i) /= 4) call abort()
+ if (lcobound(foo,dim=i) /= 4) call abort()
+ if (ucobound(foo,dim=i) /= 4) call abort()
+ end subroutine five
end program test
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Contributed by John Reid.
+!
+program ex2
+ implicit none
+ real, allocatable :: z(:)[:]
+ integer :: image
+ character(len=80) :: str
+
+ allocate(z(3)[*])
+ write(*,*) 'z allocated on image',this_image()
+ sync all
+ if (this_image()==1) then
+ z = 1.2
+ do image = 2, num_images() ! { dg-warning "will be executed zero times" }
+ write(*,*) 'Assigning z(:) on image',image
+ z(:)[image] = z
+ end do
+ end if
+ sync all
+
+ str = repeat('X', len(str))
+ write(str,*) 'z=',z(:),' on image',this_image()
+ if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") &
+ call abort ()
+
+ str = repeat('X', len(str))
+ write(str,*) 'z=',z,' on image',this_image()
+ if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") &
+ call abort ()
+
+ str = repeat('X', len(str))
+ write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image()
+ if (str /= " z= 1.2000000 1.2000000 1.2000000 on image 1") &
+ call abort ()
+
+ call ex2a()
+ call ex5()
+end
+
+subroutine ex2a()
+ implicit none
+ real, allocatable :: z(:,:)[:,:]
+ integer :: image
+ character(len=100) :: str
+
+ allocate(z(2,2)[1,*])
+ write(*,*) 'z allocated on image',this_image()
+ sync all
+ if (this_image()==1) then
+ z = 1.2
+ do image = 2, num_images() ! { dg-warning "will be executed zero times" }
+ write(*,*) 'Assigning z(:) on image',image
+ z(:,:)[1,image] = z
+ end do
+ end if
+ sync all
+
+ str = repeat('X', len(str))
+ write(str,*) 'z=',z(:,:),' on image',this_image()
+ if (str /= " z= 1.2000000 1.2000000 1.2000000 1.2000000 on image 1") &
+ call abort ()
+
+ str = repeat('X', len(str))
+ write(str,*) 'z=',z,' on image',this_image()
+ if (str /= " z= 1.2000000 1.2000000 1.2000000 1.2000000 on image 1") &
+ call abort ()
+end subroutine ex2a
+
+subroutine ex5
+ implicit none
+ integer :: me
+ real, save :: w(4)[*]
+ character(len=100) :: str
+
+ me = this_image()
+ w = me
+
+ str = repeat('X', len(str))
+ write(str,*) 'In main on image',this_image(), 'w= ',w
+ if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") &
+ call abort ()
+
+ str = repeat('X', len(str))
+ write(str,*) 'In main on image',this_image(), 'w= ',w(1:4)
+ if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") &
+ call abort ()
+
+ str = repeat('X', len(str))
+ write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1]
+ if (str /= " In main on image 1 w= 1.0000000 1.0000000 1.0000000 1.0000000") &
+ call abort ()
+
+ sync all
+ call ex5_sub(me,w)
+end subroutine ex5
+
+subroutine ex5_sub(n,w)
+ implicit none
+ integer :: n
+ real :: w(n)
+ character(len=50) :: str
+
+ str = repeat('X', len(str))
+ write(str,*) 'In sub on image',this_image(), 'w= ',w
+ if (str /= " In sub on image 1 w= 1.0000000") &
+ call abort ()
+end subroutine ex5_sub
OSDN Git Service
