diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3a45a96125a..083f59f0fdf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2004-07-12 Paul Brook + + * expr.c (gfc_check_assign_symbol): Handle pointer assignments. + * trans-array.c (gfc_trans_auto_array_allocation): Remove + initialization code. + * trans-common.c (create_common): Use gfc_conv_initializer. + * trans-decl.c (gfc_get_symbol_decl): Use gfc_conv_initializer. + * trans-expr.c (gfc_conv_initializer): New function. + (gfc_conv_structure): Use it. + * trans.h (gfc_conv_initializer): Add prototype. + 2004-07-11 Paul Brook PR fortran/15986 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index f332b3415d5..74b785a5175 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1855,7 +1855,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) /* Relative of gfc_check_assign() except that the lvalue is a single - symbol. */ + symbol. Used for initialization assignments. */ try gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue) @@ -1873,7 +1873,10 @@ gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue) lvalue.symtree->n.sym = sym; lvalue.where = sym->declared_at; - r = gfc_check_assign (&lvalue, rvalue, 1); + if (sym->attr.pointer) + r = gfc_check_pointer_assign (&lvalue, rvalue); + else + r = gfc_check_assign (&lvalue, rvalue, 1); gfc_free (lvalue.symtree); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 62ecafe767d..88e286544ef 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2848,20 +2848,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody) assert (GFC_ARRAY_TYPE_P (type)); onstack = TREE_CODE (type) != POINTER_TYPE; - /* We never generate initialization code of module variables. */ - if (fnbody == NULL_TREE) - { - assert (onstack); - - /* Generate static initializer. */ - if (sym->value) - { - DECL_INITIAL (decl) = - gfc_conv_array_initializer (TREE_TYPE (decl), sym->value); - } - return fnbody; - } - gfc_start_block (&block); /* Evaluate character string length. */ @@ -2884,12 +2870,6 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody) if (onstack) { - if (sym->value) - { - DECL_INITIAL (decl) = - gfc_conv_array_initializer (TREE_TYPE (decl), sym->value); - } - gfc_add_expr_to_block (&block, fnbody); return gfc_finish_block (&block); } diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 7907020371e..451312ef410 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -383,7 +383,6 @@ create_common (gfc_common_head *com) if (is_init) { tree list, ctor, tmp; - gfc_se se; HOST_WIDE_INT offset = 0; list = NULL_TREE; @@ -399,33 +398,11 @@ create_common (gfc_common_head *com) We don't implement this yet, so bail out. */ gfc_todo_error ("Initialization of overlapping variables"); } - if (s->sym->attr.dimension) - { - tmp = gfc_conv_array_initializer (TREE_TYPE (s->field), - s->sym->value); - list = tree_cons (s->field, tmp, list); - } - else - { - switch (s->sym->ts.type) - { - case BT_CHARACTER: - se.expr = gfc_conv_string_init - (s->sym->ts.cl->backend_decl, s->sym->value); - break; - - case BT_DERIVED: - gfc_init_se (&se, NULL); - gfc_conv_structure (&se, s->sym->value, 1); - break; - - default: - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, s->sym->value); - break; - } - list = tree_cons (s->field, se.expr, list); - } + /* Add the initializer for this field. */ + tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts, + TREE_TYPE (s->field), s->sym->attr.dimension, + s->sym->attr.pointer || s->sym->attr.allocatable); + list = tree_cons (s->field, tmp, list); offset = s->offset + s->length; } } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4dce18afdcc..24087c07b88 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -694,7 +694,6 @@ gfc_get_symbol_decl (gfc_symbol * sym) { tree decl; tree length = NULL_TREE; - gfc_se se; int byref; assert (sym->attr.referenced); @@ -802,26 +801,12 @@ gfc_get_symbol_decl (gfc_symbol * sym) DECL_INITIAL (length) = build_int_2 (-2, -1); } - /* TODO: Initialization of pointer variables. */ - switch (sym->ts.type) + if (sym->ts.type == BT_CHARACTER) { - case BT_CHARACTER: /* Character variables need special handling. */ gfc_allocate_lang_decl (decl); - if (TREE_CODE (length) == INTEGER_CST) - { - /* Static initializer for string scalars. - Initialization of string arrays is handled elsewhere. */ - if (sym->value && sym->attr.dimension == 0) - { - assert (TREE_STATIC (decl)); - if (sym->attr.pointer) - gfc_todo_error ("initialization of character pointers"); - DECL_INITIAL (decl) = gfc_conv_string_init (length, sym->value); - } - } - else + if (TREE_CODE (length) != INTEGER_CST) { char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2]; @@ -837,32 +822,17 @@ gfc_get_symbol_decl (gfc_symbol * sym) gfc_finish_var_decl (length, sym); assert (!sym->value); } - break; - - case BT_DERIVED: - if (sym->value && ! (sym->attr.use_assoc || sym->attr.dimension)) - { - gfc_init_se (&se, NULL); - gfc_conv_structure (&se, sym->value, 1); - DECL_INITIAL (decl) = se.expr; - } - break; - - default: - /* Static initializers for SAVEd variables. Arrays have already been - remembered. Module variables are initialized when the module is - loaded. */ - if (sym->value && ! (sym->attr.use_assoc || sym->attr.dimension)) - { - assert (TREE_STATIC (decl)); - gfc_init_se (&se, NULL); - gfc_conv_constant (&se, sym->value); - DECL_INITIAL (decl) = se.expr; - } - break; } sym->backend_decl = decl; + if (TREE_STATIC (decl) && !sym->attr.use_assoc) + { + /* Add static initializer. */ + DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts, + TREE_TYPE (decl), sym->attr.dimension, + sym->attr.pointer || sym->attr.allocatable); + } + return decl; } @@ -1784,7 +1754,6 @@ static void gfc_create_module_variable (gfc_symbol * sym) { tree decl; - gfc_se se; /* Only output symbols from this module. */ if (sym->ns != module_namespace) @@ -1812,33 +1781,6 @@ gfc_create_module_variable (gfc_symbol * sym) /* Create the decl. */ decl = gfc_get_symbol_decl (sym); - /* We want to allocate storage for this variable. */ - TREE_STATIC (decl) = 1; - - if (sym->attr.dimension) - { - assert (sym->attr.pointer || sym->attr.allocatable - || GFC_ARRAY_TYPE_P (TREE_TYPE (sym->backend_decl))); - if (sym->attr.pointer || sym->attr.allocatable) - gfc_trans_static_array_pointer (sym); - else - gfc_trans_auto_array_allocation (sym->backend_decl, sym, NULL_TREE); - } - else if (sym->ts.type == BT_DERIVED) - { - if (sym->value) - gfc_todo_error ("Initialization of derived type module variables"); - } - else - { - if (sym->value) - { - gfc_init_se (&se, NULL); - gfc_conv_constant (&se, sym->value); - DECL_INITIAL (decl) = se.expr; - } - } - /* Create the variable. */ pushdecl (decl); rest_of_decl_compilation (decl, NULL, 1, 0); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a8412bdcf28..4745f0cc3be 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1365,7 +1365,49 @@ gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr) } +/* Build a static initializer. EXPR is the expression for the initial value. + The other parameters describe the variable of component being initialized. + EXPR may be null. */ +tree +gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, + bool array, bool pointer) +{ + gfc_se se; + + if (!(expr || pointer)) + return NULL_TREE; + + if (array) + { + /* Arrays need special handling. */ + if (pointer) + return gfc_build_null_descriptor (type); + else + return gfc_conv_array_initializer (type, expr); + } + else if (pointer) + return fold_convert (type, null_pointer_node); + else + { + switch (ts->type) + { + case BT_DERIVED: + gfc_init_se (&se, NULL); + gfc_conv_structure (&se, expr, 1); + return se.expr; + + case BT_CHARACTER: + return gfc_conv_string_init (ts->cl->backend_decl,expr); + + default: + gfc_init_se (&se, NULL); + gfc_conv_constant (&se, expr); + return se.expr; + } + } +} + /* Build an expression for a constructor. If init is nonzero then this is part of a static variable initializer. */ @@ -1396,28 +1438,8 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) /* Evaluate the expression for this component. */ if (init) { - if (cm->dimension) - { - 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 if (cm->pointer) - { - /* 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); + cse.expr = gfc_conv_initializer (c->expr, &cm->ts, + TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer); } else { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 6119e587129..fe8db4e370d 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -374,6 +374,9 @@ void gfc_build_builtin_function_decls (void); /* Return the variable decl for a symbol. */ tree gfc_get_symbol_decl (gfc_symbol *); +/* Build a static initializer. */ +tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool); + /* Substitute a temporary variable in place of the real one. */ void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f4080b5a0bf..0ee84ee5ca2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2004-07-12 Paul Brook + + * gfortran.dg/pointer_init_1.f90: New test. + 2004-07-11 Paul Brook PR fortran/15986 diff --git a/gcc/testsuite/gfortran.dg/pointer_init_1.f90 b/gcc/testsuite/gfortran.dg/pointer_init_1.f90 new file mode 100644 index 00000000000..0cfa9038190 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_init_1.f90 @@ -0,0 +1,15 @@ +! Check that null initialization of pointer variable works. +! { dg-do run } +program pointer_init_1 + type t + real x + end type + type(t), pointer :: a => NULL() + real, pointer :: b => NULL() + character, pointer :: c => NULL() + integer, pointer, dimension(:) :: d => NULL() + if (associated(a)) call abort() + if (associated(b)) call abort() + if (associated(c)) call abort() + if (associated(d)) call abort() +end