Commit 331c72f3 by Paul Brook Committed by Paul Brook

trans-array.c (gfc_build_null_descriptor): New function.

	* trans-array.c (gfc_build_null_descriptor): New function.
	(gfc_trans_static_array_pointer): Use it.
	* trans-array.h (gfc_build_null_descriptor): Add prototype.
	* trans-expr.c (gfc_conv_structure): Handle array pointers.
testsuite/
	* gfortran.fortran-torture/execute/der_init_5.f90: Enable more tests.

From-SVN: r84477
parent 53814b8f
2004-07-10 Paul Brook <paul@codesourcery.com>
* trans-array.c (gfc_build_null_descriptor): New function.
(gfc_trans_static_array_pointer): Use it.
* trans-array.h (gfc_build_null_descriptor): Add prototype.
* trans-expr.c (gfc_conv_structure): Handle array pointers.
2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> 2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/16336 PR fortran/16336
......
...@@ -288,27 +288,26 @@ gfc_conv_descriptor_ubound (tree desc, tree dim) ...@@ -288,27 +288,26 @@ gfc_conv_descriptor_ubound (tree desc, tree dim)
} }
/* Generate an initializer for a static pointer or allocatable array. */ /* Build an null array descriptor constructor. */
void tree
gfc_trans_static_array_pointer (gfc_symbol * sym) gfc_build_null_descriptor (tree type)
{ {
tree tmp;
tree field; tree field;
tree type; tree tmp;
assert (TREE_STATIC (sym->backend_decl));
/* Just zero the data member. */
type = TREE_TYPE (sym->backend_decl);
assert (GFC_DESCRIPTOR_TYPE_P (type)); assert (GFC_DESCRIPTOR_TYPE_P (type));
assert (DATA_FIELD == 0); assert (DATA_FIELD == 0);
field = TYPE_FIELDS (type); field = TYPE_FIELDS (type);
/* Set a NULL data pointer. */
tmp = tree_cons (field, null_pointer_node, NULL_TREE); tmp = tree_cons (field, null_pointer_node, NULL_TREE);
tmp = build1 (CONSTRUCTOR, type, tmp); tmp = build1 (CONSTRUCTOR, type, tmp);
TREE_CONSTANT (tmp) = 1; TREE_CONSTANT (tmp) = 1;
TREE_INVARIANT (tmp) = 1; TREE_INVARIANT (tmp) = 1;
DECL_INITIAL (sym->backend_decl) = tmp; /* All other fields are ignored. */
return tmp;
} }
...@@ -422,6 +421,20 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) ...@@ -422,6 +421,20 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
} }
/* Generate an initializer for a static pointer or allocatable array. */
void
gfc_trans_static_array_pointer (gfc_symbol * sym)
{
tree type;
assert (TREE_STATIC (sym->backend_decl));
/* Just zero the data member. */
type = TREE_TYPE (sym->backend_decl);
DECL_INITIAL (sym->backend_decl) =gfc_build_null_descriptor (type);
}
/* Generate code to allocate an array temporary, or create a variable to /* Generate code to allocate an array temporary, or create a variable to
hold the data. */ hold the data. */
......
...@@ -73,6 +73,8 @@ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); ...@@ -73,6 +73,8 @@ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
void gfc_conv_loop_setup (gfc_loopinfo *); void gfc_conv_loop_setup (gfc_loopinfo *);
/* Resolve array assignment dependencies. */ /* Resolve array assignment dependencies. */
void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
/* Build an null array descriptor constructor. */
tree gfc_build_null_descriptor (tree);
/* Get a single array element. */ /* Get a single array element. */
void gfc_conv_array_ref (gfc_se *, gfc_array_ref *); void gfc_conv_array_ref (gfc_se *, gfc_array_ref *);
......
...@@ -1379,7 +1379,6 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) ...@@ -1379,7 +1379,6 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
tree val; tree val;
gfc_se cse; gfc_se cse;
tree type; tree type;
tree arraytype;
assert (expr->expr_type == EXPR_STRUCTURE || expr->expr_type == EXPR_NULL); assert (expr->expr_type == EXPR_STRUCTURE || expr->expr_type == EXPR_NULL);
type = gfc_typenode_for_spec (&expr->ts); type = gfc_typenode_for_spec (&expr->ts);
...@@ -1397,32 +1396,28 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) ...@@ -1397,32 +1396,28 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
/* Evaluate the expression for this component. */ /* Evaluate the expression for this component. */
if (init) if (init)
{ {
if (!cm->pointer) if (cm->dimension)
{ {
/* Initializing a non-pointer element. */ tree arraytype;
if (cm->dimension) arraytype = TREE_TYPE (cm->backend_decl);
{
arraytype = TREE_TYPE (cm->backend_decl);
cse.expr = gfc_conv_array_initializer (arraytype, c->expr);
}
else if (cm->ts.type == BT_DERIVED)
gfc_conv_structure (&cse, c->expr, 1);
else
gfc_conv_expr (&cse, c->expr);
/* Arrays need special handling. */
if (cm->pointer)
cse.expr = gfc_build_null_descriptor (arraytype);
else
cse.expr = gfc_conv_array_initializer (arraytype, c->expr);
} }
else else if (cm->pointer)
{ {
/* Pointer components may only be initialized to /* Pointer components may only be initialized to NULL. */
NULL. This should have been enforced by the frontend. */ assert (c->expr->expr_type == EXPR_NULL);
if (cm->dimension) cse.expr = fold_convert (TREE_TYPE (cm->backend_decl),
{ null_pointer_node);
gfc_todo_error ("Initialization of pointer members");
}
else
cse.expr = fold_convert (TREE_TYPE (cm->backend_decl),
null_pointer_node);
} }
else if (cm->ts.type == BT_DERIVED)
gfc_conv_structure (&cse, c->expr, 1);
else
gfc_conv_expr (&cse, c->expr);
} }
else else
{ {
......
2004-07-10 Paul Brook <paul@codesourcery.com>
* gfortran.fortran-torture/execute/der_init_5.f90: Enable more tests.
2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> 2004-07-10 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/15969 PR fortran/15969
......
...@@ -5,12 +5,12 @@ program der_init_5 ...@@ -5,12 +5,12 @@ program der_init_5
type t type t
type(t), pointer :: a => NULL() type(t), pointer :: a => NULL()
real, pointer :: b => NULL() real, pointer :: b => NULL()
! character, pointer :: c => NULL() character, pointer :: c => NULL()
! integer, pointer, dimension(:) :: d => NULL() integer, pointer, dimension(:) :: d => NULL()
end type t end type t
type (t) :: p type (t) :: p
if (associated(p%a)) call abort() if (associated(p%a)) call abort()
if (associated(p%b)) call abort() if (associated(p%b)) call abort()
! if (associated(p%c)) call abort() ! if (associated(p%c)) call abort()
! if (associated(p%d)) call abort() if (associated(p%d)) call abort()
end end
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