re PR fortran/13930 (derived type with intent(in) attribute not accepted)
PR fortran/13930 * decl.c (add_init_expr_to_sym): Remove incorrect check. (default_initializer): Move to expr.c. (variable_decl): Don't assign default initializer to variables. * expr.c (gfc_default_initializer): Move to here. * gfortran.h (gfc_default_initializer): Add prototype. * resolve.c (resolve_symbol): Check for illegal initializers. Assign default initializer. testsuite/ * gfortran.fortran-torture/execute/der_init_4.f90: New test. From-SVN: r81966
This commit is contained in:
parent
b7cefb87f0
commit
54b4ba60f2
|
@ -1,3 +1,14 @@
|
|||
2004-05-18 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
PR fortran/13930
|
||||
* decl.c (add_init_expr_to_sym): Remove incorrect check.
|
||||
(default_initializer): Move to expr.c.
|
||||
(variable_decl): Don't assign default initializer to variables.
|
||||
* expr.c (gfc_default_initializer): Move to here.
|
||||
* gfortran.h (gfc_default_initializer): Add prototype.
|
||||
* resolve.c (resolve_symbol): Check for illegal initializers.
|
||||
Assign default initializer.
|
||||
|
||||
2004-05-17 Steve Kargl <kargls@comcast.net>
|
||||
|
||||
* arith.c (gfc_arith_power): Complex number raised to 0 power is 1.
|
||||
|
|
|
@ -254,7 +254,6 @@ static try
|
|||
add_init_expr_to_sym (const char *name, gfc_expr ** initp,
|
||||
locus * var_locus)
|
||||
{
|
||||
int i;
|
||||
symbol_attribute attr;
|
||||
gfc_symbol *sym;
|
||||
gfc_expr *init;
|
||||
|
@ -311,19 +310,6 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
|
|||
&& gfc_check_assign_symbol (sym, init) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
for (i = 0; i < sym->attr.dimension; i++)
|
||||
{
|
||||
if (sym->as->lower[i] == NULL
|
||||
|| sym->as->lower[i]->expr_type != EXPR_CONSTANT
|
||||
|| sym->as->upper[i] == NULL
|
||||
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
|
||||
{
|
||||
gfc_error ("Array '%s' at %C cannot have initializer",
|
||||
sym->name);
|
||||
return FAILURE;
|
||||
}
|
||||
}
|
||||
|
||||
/* Add initializer. Make sure we keep the ranks sane. */
|
||||
if (sym->attr.dimension && init->rank == 0)
|
||||
init->rank = sym->as->rank;
|
||||
|
@ -447,47 +433,6 @@ gfc_match_null (gfc_expr ** result)
|
|||
}
|
||||
|
||||
|
||||
/* Get an expression for a default initializer. */
|
||||
static gfc_expr *
|
||||
default_initializer (void)
|
||||
{
|
||||
gfc_constructor *tail;
|
||||
gfc_expr *init;
|
||||
gfc_component *c;
|
||||
|
||||
init = NULL;
|
||||
|
||||
/* First see if we have a default initializer. */
|
||||
for (c = current_ts.derived->components; c; c = c->next)
|
||||
{
|
||||
if (c->initializer && init == NULL)
|
||||
init = gfc_get_expr ();
|
||||
}
|
||||
|
||||
if (init == NULL)
|
||||
return NULL;
|
||||
|
||||
init->expr_type = EXPR_STRUCTURE;
|
||||
init->ts = current_ts;
|
||||
init->where = current_ts.derived->declared_at;
|
||||
tail = NULL;
|
||||
for (c = current_ts.derived->components; c; c = c->next)
|
||||
{
|
||||
if (tail == NULL)
|
||||
init->value.constructor = tail = gfc_get_constructor ();
|
||||
else
|
||||
{
|
||||
tail->next = gfc_get_constructor ();
|
||||
tail = tail->next;
|
||||
}
|
||||
|
||||
if (c->initializer)
|
||||
tail->expr = gfc_copy_expr (c->initializer);
|
||||
}
|
||||
return init;
|
||||
}
|
||||
|
||||
|
||||
/* Match a variable name with an optional initializer. When this
|
||||
subroutine is called, a variable is expected to be parsed next.
|
||||
Depending on what is happening at the moment, updates either the
|
||||
|
@ -644,18 +589,17 @@ variable_decl (void)
|
|||
}
|
||||
}
|
||||
|
||||
if (current_ts.type == BT_DERIVED && !initializer)
|
||||
{
|
||||
initializer = default_initializer ();
|
||||
}
|
||||
|
||||
/* Add the initializer. Note that it is fine if &initializer is
|
||||
/* Add the initializer. Note that it is fine if initializer is
|
||||
NULL here, because we sometimes also need to check if a
|
||||
declaration *must* have an initialization expression. */
|
||||
if (gfc_current_state () != COMP_DERIVED)
|
||||
t = add_init_expr_to_sym (name, &initializer, &var_locus);
|
||||
else
|
||||
t = build_struct (name, cl, &initializer, &as);
|
||||
{
|
||||
if (current_ts.type == BT_DERIVED && !initializer)
|
||||
initializer = gfc_default_initializer (¤t_ts);
|
||||
t = build_struct (name, cl, &initializer, &as);
|
||||
}
|
||||
|
||||
m = (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
|
||||
|
||||
|
|
|
@ -1953,3 +1953,46 @@ gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue)
|
|||
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
/* Get an expression for a default initializer. */
|
||||
|
||||
gfc_expr *
|
||||
gfc_default_initializer (gfc_typespec *ts)
|
||||
{
|
||||
gfc_constructor *tail;
|
||||
gfc_expr *init;
|
||||
gfc_component *c;
|
||||
|
||||
init = NULL;
|
||||
|
||||
/* See if we have a default initializer. */
|
||||
for (c = ts->derived->components; c; c = c->next)
|
||||
{
|
||||
if (c->initializer && init == NULL)
|
||||
init = gfc_get_expr ();
|
||||
}
|
||||
|
||||
if (init == NULL)
|
||||
return NULL;
|
||||
|
||||
/* Build the constructor. */
|
||||
init->expr_type = EXPR_STRUCTURE;
|
||||
init->ts = *ts;
|
||||
init->where = ts->derived->declared_at;
|
||||
tail = NULL;
|
||||
for (c = ts->derived->components; c; c = c->next)
|
||||
{
|
||||
if (tail == NULL)
|
||||
init->value.constructor = tail = gfc_get_constructor ();
|
||||
else
|
||||
{
|
||||
tail->next = gfc_get_constructor ();
|
||||
tail = tail->next;
|
||||
}
|
||||
|
||||
if (c->initializer)
|
||||
tail->expr = gfc_copy_expr (c->initializer);
|
||||
}
|
||||
return init;
|
||||
}
|
||||
|
|
|
@ -1545,6 +1545,8 @@ try gfc_check_assign (gfc_expr *, gfc_expr *, int);
|
|||
try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
|
||||
try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
|
||||
|
||||
gfc_expr *gfc_default_initializer (gfc_typespec *);
|
||||
|
||||
/* st.c */
|
||||
extern gfc_code new_st;
|
||||
|
||||
|
|
|
@ -3687,6 +3687,9 @@ resolve_symbol (gfc_symbol * sym)
|
|||
/* Zero if we are checking a formal namespace. */
|
||||
static int formal_ns_flag = 1;
|
||||
int formal_ns_save, check_constant, mp_flag;
|
||||
int i;
|
||||
const char *whynot;
|
||||
|
||||
|
||||
if (sym->attr.flavor == FL_UNKNOWN)
|
||||
{
|
||||
|
@ -3835,6 +3838,50 @@ resolve_symbol (gfc_symbol * sym)
|
|||
}
|
||||
}
|
||||
|
||||
if (sym->attr.flavor == FL_VARIABLE)
|
||||
{
|
||||
/* Can the sybol have an initializer? */
|
||||
whynot = NULL;
|
||||
if (sym->attr.allocatable)
|
||||
whynot = "Allocatable";
|
||||
else if (sym->attr.external)
|
||||
whynot = "External";
|
||||
else if (sym->attr.dummy)
|
||||
whynot = "Dummy";
|
||||
else if (sym->attr.intrinsic)
|
||||
whynot = "Intrinsic";
|
||||
else if (sym->attr.result)
|
||||
whynot = "Function Result";
|
||||
else if (sym->attr.dimension && !sym->attr.pointer)
|
||||
{
|
||||
/* Don't allow initialization of automatic arrays. */
|
||||
for (i = 0; i < sym->as->rank; i++)
|
||||
{
|
||||
if (sym->as->lower[i] == NULL
|
||||
|| sym->as->lower[i]->expr_type != EXPR_CONSTANT
|
||||
|| sym->as->upper[i] == NULL
|
||||
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
|
||||
{
|
||||
whynot = "Automatic array";
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Reject illegal initializers. */
|
||||
if (sym->value && whynot)
|
||||
{
|
||||
gfc_error ("%s '%s' at %L cannot have an initializer",
|
||||
whynot, sym->name, &sym->declared_at);
|
||||
return;
|
||||
}
|
||||
|
||||
/* Assign default initializer. */
|
||||
if (sym->ts.type == BT_DERIVED && !(sym->value || whynot))
|
||||
sym->value = gfc_default_initializer (&sym->ts);
|
||||
}
|
||||
|
||||
|
||||
/* Make sure that intrinsic exist */
|
||||
if (sym->attr.intrinsic
|
||||
&& ! gfc_intrinsic_name(sym->name, 0)
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2004-05-18 Paul Brook <paul@codesourcery.com>
|
||||
|
||||
PR fortran/13930
|
||||
* gfortran.fortran-torture/execute/der_init_4.f90: New test.
|
||||
|
||||
2004-05-18 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
* gfortran.fortran-torture/execute/cmplx.f90: Add test for bug in
|
||||
|
|
|
@ -0,0 +1,15 @@
|
|||
! PR13930
|
||||
! We were trying to assugn a default initializer to dummy variables.
|
||||
program der_init_4
|
||||
type t
|
||||
integer :: i = 42
|
||||
end type
|
||||
|
||||
call foo(t(5))
|
||||
contains
|
||||
subroutine foo(a)
|
||||
type (t), intent(in) :: a
|
||||
|
||||
if (a%i .ne. 5) call abort
|
||||
end subroutine
|
||||
end program
|
Loading…
Reference in New Issue