diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-01-31 22:56:02 +0100 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-01-31 22:56:02 +0100 |
| commit | 7adac79a3d5420b9683e9fe38b2b526f26c2c225 (patch) | |
| tree | 141d0f689a065770fa6cc34ecce6c668bb1bf081 /gcc/fortran/resolve.c | |
| parent | 355b1741d9529b17183d99b21ca692769d049c64 (diff) | |
| download | gcc-7adac79a3d5420b9683e9fe38b2b526f26c2c225.zip gcc-7adac79a3d5420b9683e9fe38b2b526f26c2c225.tar.gz gcc-7adac79a3d5420b9683e9fe38b2b526f26c2c225.tar.bz2 | |
re PR fortran/42888 (ICE in fold_convert_loc, at fold-const.c:2670)
gcc/fortran/
2010-01-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42888
* resolve.c (resolve_allocate_expr): Move default initialization code
here from gfc_trans_allocate.
* trans.c (gfc_trans_code): Call gfc_trans_class_assign also for
EXEC_INIT_ASSIGN.
* trans-expr.c (gfc_trans_class_assign): Handle default initialization
of CLASS variables via memcpy.
* trans-stmt.c (gfc_trans_allocate): Move default initialization code
to resolve_allocate_expr.
gcc/testsuite/
2010-01-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42888
* gfortran.dg/allocate_derived_2.f90: New test.
From-SVN: r156418
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fe98b7e..d0aa6ad 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6099,6 +6099,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) gfc_symbol *sym; gfc_alloc *a; gfc_component *c; + gfc_expr *init_e; /* Check INTENT(IN), unless the object is a sub-component of a pointer. */ check_intent_in = 1; @@ -6223,6 +6224,36 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) sym->name, &e->where); return FAILURE; } + + if (!code->expr3) + { + /* Add default initializer for those derived types that need them. */ + if (e->ts.type == BT_DERIVED + && (init_e = gfc_default_initializer (&e->ts))) + { + gfc_code *init_st = gfc_get_code (); + init_st->loc = code->loc; + init_st->op = EXEC_INIT_ASSIGN; + init_st->expr1 = gfc_expr_to_initialize (e); + init_st->expr2 = init_e; + init_st->next = code->next; + code->next = init_st; + } + else if (e->ts.type == BT_CLASS + && ((code->ext.alloc.ts.type == BT_UNKNOWN + && (init_e = gfc_default_initializer (&e->ts.u.derived->components->ts))) + || (code->ext.alloc.ts.type == BT_DERIVED + && (init_e = gfc_default_initializer (&code->ext.alloc.ts))))) + { + gfc_code *init_st = gfc_get_code (); + init_st->loc = code->loc; + init_st->op = EXEC_INIT_ASSIGN; + init_st->expr1 = gfc_expr_to_initialize (e); + init_st->expr2 = init_e; + init_st->next = code->next; + code->next = init_st; + } + } if (pointer || dimension == 0) return SUCCESS; |