+2010-04-27 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * resolve.c (resolve_allocate_expr): Allow array coarrays.
+ * trans-types.h (gfc_get_array_type_bounds): Update prototype.
+ * trans-types.c (gfc_get_array_type_bounds,
+ gfc_get_array_descriptor_base): Add corank argument.
+ * trans-array.c (gfc_array_init_size): Handle corank.
+ (gfc_trans_create_temp_array, gfc_array_allocate,
+ gfc_conv_expr_descriptor): Add corank argument to call.
+ * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
+
2010-04-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/30073
goto failure;
}
- if (codimension)
+ if (codimension && ar->as->rank == 0)
{
- gfc_error ("Sorry, allocatable coarrays are no yet supported coarray "
+ gfc_error ("Sorry, allocatable scalar coarrays are not yet supported "
"at %L", &e->where);
goto failure;
}
else
{
/* Collect multiple scalar constants into a constructor. */
- VEC(constructor_elt,gc) *v = NULL;
+ tree list;
tree init;
tree bound;
tree tmptype;
HOST_WIDE_INT idx = 0;
p = c;
+ list = NULL_TREE;
/* Count the number of consecutive scalar constants. */
while (p && !(p->iterator
|| p->expr->expr_type != EXPR_CONSTANT))
(gfc_get_pchar_type (p->expr->ts.kind),
se.expr);
- CONSTRUCTOR_APPEND_ELT (v,
- build_int_cst (gfc_array_index_type,
- idx++),
- se.expr);
+ list = tree_cons (build_int_cst (gfc_array_index_type,
+ idx++), se.expr, list);
c = p;
p = gfc_constructor_next (p);
}
gfc_index_zero_node, bound);
tmptype = build_array_type (type, tmptype);
- init = build_constructor (tmptype, v);
+ init = build_constructor_from_list (tmptype, nreverse (list));
TREE_CONSTANT (init) = 1;
TREE_STATIC (init) = 1;
/* Create a static variable to hold the data. */
tree
gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
{
- tree tmptype, init, tmp;
+ tree tmptype, list, init, tmp;
HOST_WIDE_INT nelem;
gfc_constructor *c;
gfc_array_spec as;
gfc_se se;
int i;
- VEC(constructor_elt,gc) *v = NULL;
/* First traverse the constructor list, converting the constants
to tree to build an initializer. */
tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
- init = build_constructor (tmptype, v);
+ init = build_constructor_from_list (tmptype, nreverse (list));
TREE_CONSTANT (init) = 1;
TREE_STATIC (init) = 1;
if (ref == NULL || ref->type != REF_ARRAY)
return false;
- /* Return if this is a scalar coarray. */
- if (!prev_ref && !expr->symtree->n.sym->attr.dimension)
- {
- gcc_assert (expr->symtree->n.sym->attr.codimension);
- return false;
- }
- else if (prev_ref && !prev_ref->u.c.component->attr.dimension)
- {
- gcc_assert (prev_ref->u.c.component->attr.codimension);
- return false;
- }
-
if (!prev_ref)
{
allocatable_array = expr->symtree->n.sym->attr.allocatable;
{
gfc_constructor *c;
tree tmp;
+ mpz_t maxval;
gfc_se se;
HOST_WIDE_INT hi;
unsigned HOST_WIDE_INT lo;
- tree index;
+ tree index, range;
VEC(constructor_elt,gc) *v = NULL;
switch (expr->expr_type)
{
case EXPR_CONSTANT:
gfc_conv_constant (&se, c->expr);
- CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ if (range == NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ else
+ {
+ if (index != NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+ }
break;
case EXPR_STRUCTURE:
for one reason or another, assuming that if they are
standard defying the frontend will catch them. */
gfc_conv_expr (&se, c->expr);
- CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ if (range == NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ else
+ {
+ if (index != NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+ }
break;
}
}
ppvoid_type_node = build_pointer_type (pvoid_type_node);
pchar_type_node = build_pointer_type (gfc_character1_type_node);
pfunc_type_node
- = build_pointer_type (build_function_type_list (void_type_node, NULL_TREE));
+ = build_pointer_type (build_function_type (void_type_node, NULL_TREE));
gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
/* We cannot use gfc_index_zero_node in definition of gfc_array_range_type,
{
tree fat_type, fieldlist, decl, arraytype;
char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
- int idx = 2 * (codimen + dimen - 1) + restricted;
+ int idx = 2 * (dimen - 1) + restricted;
gcc_assert (dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
if (gfc_array_descriptor_base[idx])
/* Build the type node. */
fat_type = make_node (RECORD_TYPE);
- sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen + codimen);
+ sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT "_"
+ GFC_RANK_PRINTF_FORMAT, dimen, codimen);
TYPE_NAME (fat_type) = get_identifier (name);
/* Add the data member as the first element of the descriptor. */
type_name = IDENTIFIER_POINTER (tmp);
else
type_name = "unknown";
- sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen + codimen,
+ sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_"
+ GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, codimen,
GFC_MAX_SYMBOL_LEN, type_name);
TYPE_NAME (fat_type) = get_identifier (name);
restricted);
byref = 0;
}
-
- if (sym->attr.cray_pointee)
- GFC_POINTER_TYPE_P (type) = 1;
}
else
{
{
if (sym->attr.allocatable || sym->attr.pointer)
type = gfc_build_pointer_type (sym, type);
- if (sym->attr.pointer || sym->attr.cray_pointee)
+ if (sym->attr.pointer)
GFC_POINTER_TYPE_P (type) = 1;
}
else
t = void_type_node;
- return build_pointer_type (build_function_type_list (t, NULL_TREE));
+ return build_pointer_type (build_function_type (t, NULL_TREE));
}
+2010-04-27 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * gfortran.dg/coarray_7.f90: Modified and removed obsolete tests.
+ * gfortran.dg/coarray_12.f90: New.
+
2010-04-27 Shujing Zhao <pearly.zhao@oracle.com>
PR c/32207
! { dg-final { scan-tree-dump-times "a.dim.0..lbound = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "a.dim.0..ubound = .*nn;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.0..ubound = .* nn;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.1..lbound = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "a.dim.1..ubound = .*mm;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.1..ubound = .* mm;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.2..lbound = 1;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.2..ubound" 0 "original" } }
allocate(b(1)) ! { dg-error "Coarray specification" }
allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
allocate(c[*]) ! { dg-error "Sorry" }
-allocate(b(3)[5:*]) ! { dg-error "Sorry" }
allocate(a%a(5)) ! OK
end subroutine alloc
subroutine allocateTest()
implicit none
- real, allocatable,dimension(:,:), codimension[:,:] :: a,b,c
+ real, allocatable, codimension[:,:] :: a,b,c
integer :: n, q
n = 1
q = 1
- allocate(a(n,n)[q,*]) ! { dg-error "Sorry" }
- allocate(b(n,n)[q,*]) ! { dg-error "Sorry" }
- allocate(c(n,n)[q,*]) ! { dg-error "Sorry" }
+ allocate(a[q,*]) ! { dg-error "Sorry" }
+ allocate(b[q,*]) ! { dg-error "Sorry" }
+ allocate(c[q,*]) ! { dg-error "Sorry" }
end subroutine allocateTest
-subroutine testAlloc3
-implicit none
-integer, allocatable :: a(:,:,:)[:,:]
-integer, allocatable, dimension(:),codimension[:] :: b(:,:,:)[:,:]
-integer, allocatable, dimension(:,:),codimension[:,:,:] :: c
-integer, allocatable, dimension(:,:),codimension[:,:,:] :: d[:,:]
-integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: e(:,:)
-integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: f(:,:)[:,:]
-
-allocate(a(1,2,3)[4,*]) ! { dg-error "Sorry" }
-allocate(b(1,2,3)[4,*]) ! { dg-error "Sorry" }
-allocate(c(1,2)[3,4,*]) ! { dg-error "Sorry" }
-allocate(d(1,2)[3,*]) ! { dg-error "Sorry" }
-allocate(e(1,2)[3,4,*]) ! { dg-error "Sorry" }
-allocate(f(1,2)[3,*]) ! { dg-error "Sorry" }
-end subroutine testAlloc3
-
-
subroutine testAlloc4()
implicit none
type co_double_3