diff options
| author | Paul Brook <paul@codesourcery.com> | 2004-05-18 00:48:05 +0000 |
|---|---|---|
| committer | Paul Brook <pbrook@gcc.gnu.org> | 2004-05-18 00:48:05 +0000 |
| commit | 54b4ba60f20d3870a79467caa3b604971225d388 (patch) | |
| tree | c59d49b2984c03bcf5e5f018b12cc2f44288e7a1 /gcc/fortran/resolve.c | |
| parent | b7cefb87f053f26b4354d18f94c4e3baa4266645 (diff) | |
| download | gcc-54b4ba60f20d3870a79467caa3b604971225d388.zip gcc-54b4ba60f20d3870a79467caa3b604971225d388.tar.gz gcc-54b4ba60f20d3870a79467caa3b604971225d388.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3530ee1..ca9208f 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) |