OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

expr.c (gfc_check_assign_symbol): Handle pointer assignments. 

* 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.
testsuite/
	* gfortran.dg/pointer_init_1.f90: New test.

From-SVN: r84542
This commit is contained in:
Paul Brook 2004-07-12 01:23:39 +00:00 committed by Paul Brook
parent 247fec6ee6
commit 597073ace8
9 changed files with 97 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2004-07-12 Paul Brook <paul@codesourcery.com>
* 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 <paul@codesourcery.com>
PR fortran/15986

7
gcc/fortran/expr.c
View File

@ -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);

20
gcc/fortran/trans-array.c
View File

@ -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);
}

33
gcc/fortran/trans-common.c
View File

@ -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;
}
}

78
gcc/fortran/trans-decl.c
View File

@ -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);

66
gcc/fortran/trans-expr.c
View File

@ -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
{

3
gcc/fortran/trans.h
View File

@ -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 *);

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2004-07-12 Paul Brook <paul@codesourcery.com>
* gfortran.dg/pointer_init_1.f90: New test.
2004-07-11 Paul Brook <paul@codesourcery.com>
PR fortran/15986

15
gcc/testsuite/gfortran.dg/pointer_init_1.f90 Normal file
View File

@ -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