From: Paul Brook Date: Tue, 18 May 2004 00:48:05 +0000 (+0000) Subject: re PR fortran/13930 (derived type with intent(in) attribute not accepted) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=54b4ba60f20d3870a79467caa3b604971225d388;p=gcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 376c9f9c1b0..e27e6854132 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2004-05-18 Paul Brook + + 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 * arith.c (gfc_arith_power): Complex number raised to 0 power is 1. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index ff87bee144a..84547a4f750 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8b3e391b06c..bb912c79721 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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; +} diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 498e63b6c9b..211aafdbbdc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3530ee1c07e..ca9208f4caf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4e51763b522..e48dfaf776b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2004-05-18 Paul Brook + + PR fortran/13930 + * gfortran.fortran-torture/execute/der_init_4.f90: New test. + 2004-05-18 Tobias Schlueter * gfortran.fortran-torture/execute/cmplx.f90: Add test for bug in diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/der_init_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_4.f90 new file mode 100644 index 00000000000..2b136207aa8 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/der_init_4.f90 @@ -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