summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/decl.c68
-rw-r--r--gcc/fortran/expr.c43
-rw-r--r--gcc/fortran/gfortran.h2
-rw-r--r--gcc/fortran/resolve.c47
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/der_init_4.f9015
7 files changed, 129 insertions, 62 deletions
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 <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.
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 (&current_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 <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
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
View Lorry Controller Status