From 331c72f3db58cd93b1863aef4844a2ef883ae63a Mon Sep 17 00:00:00 2001 From: Paul Brook Date: Sat, 10 Jul 2004 22:55:40 +0000 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-array.c | 31 ++++++++++----- gcc/fortran/trans-array.h | 2 + gcc/fortran/trans-expr.c | 39 ++++++++----------- gcc/testsuite/ChangeLog | 4 ++ .../execute/der_init_5.f90 | 6 +-- 6 files changed, 55 insertions(+), 34 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1b39762b967..813e7c0d400 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2004-07-10 Paul Brook + + * 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 PR fortran/16336 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 731fb193099..62ecafe767d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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 -gfc_trans_static_array_pointer (gfc_symbol * sym) +tree +gfc_build_null_descriptor (tree type) { - tree tmp; 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 (DATA_FIELD == 0); field = TYPE_FIELDS (type); + /* Set a NULL data pointer. */ tmp = tree_cons (field, null_pointer_node, NULL_TREE); tmp = build1 (CONSTRUCTOR, type, tmp); TREE_CONSTANT (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) } +/* 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 hold the data. */ diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index a78c04f4b04..ee7db9beaee 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -73,6 +73,8 @@ void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); void gfc_conv_loop_setup (gfc_loopinfo *); /* Resolve array assignment dependencies. */ 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. */ void gfc_conv_array_ref (gfc_se *, gfc_array_ref *); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5c62234660f..a8412bdcf28 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1379,7 +1379,6 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) tree val; gfc_se cse; tree type; - tree arraytype; assert (expr->expr_type == EXPR_STRUCTURE || expr->expr_type == EXPR_NULL); type = gfc_typenode_for_spec (&expr->ts); @@ -1397,32 +1396,28 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) /* Evaluate the expression for this component. */ if (init) { - if (!cm->pointer) + if (cm->dimension) { - /* Initializing a non-pointer element. */ - if (cm->dimension) - { - 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); + tree arraytype; + arraytype = TREE_TYPE (cm->backend_decl); + /* 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 - NULL. This should have been enforced by the frontend. */ - if (cm->dimension) - { - gfc_todo_error ("Initialization of pointer members"); - } - else - cse.expr = fold_convert (TREE_TYPE (cm->backend_decl), - null_pointer_node); + /* Pointer components may only be initialized to NULL. */ + assert (c->expr->expr_type == EXPR_NULL); + 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 { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ae23fd8b28..497eca53383 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2004-07-10 Paul Brook + + * gfortran.fortran-torture/execute/der_init_5.f90: Enable more tests. + 2004-07-10 Tobias Schlueter PR fortran/15969 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 index 22c0c33ba2f..c81d9260e55 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_5.f90 @@ -5,12 +5,12 @@ program der_init_5 type t type(t), pointer :: a => NULL() real, pointer :: b => NULL() -! character, pointer :: c => NULL() -! integer, pointer, dimension(:) :: d => NULL() + character, pointer :: c => NULL() + integer, pointer, dimension(:) :: d => NULL() end type t type (t) :: p if (associated(p%a)) call abort() if (associated(p%b)) call abort() ! if (associated(p%c)) call abort() -! if (associated(p%d)) call abort() + if (associated(p%d)) call abort() end -- 2.30.2