diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-09-01 22:50:46 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-09-01 22:50:46 +0200 |
| commit | 50f308010c3fabfd87f32576b44220469196de1d (patch) | |
| tree | 76df2300c94ed6e0551613c3ace7b3f60f88da56 /gcc/fortran/class.c | |
| parent | 596aa3f09d3cb553112fe78da3074075da57d1b9 (diff) | |
| download | gcc-50f308010c3fabfd87f32576b44220469196de1d.zip gcc-50f308010c3fabfd87f32576b44220469196de1d.tar.gz gcc-50f308010c3fabfd87f32576b44220469196de1d.tar.bz2 | |
re PR fortran/44541 ([OOP] wrong code for polymorphic variable with INTENT(OUT)/Alloc w/ MOLD)
2010-09-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/44541
* class.c (gfc_find_derived_vtab): Add component '$def_init'.
* resolve.c (resolve_allocate_expr): Defer handling of default
initialization to 'gfc_trans_allocate'.
(apply_default_init,resolve_symbol): Handle polymorphic dummies.
(resolve_fl_derived): Suppress error messages for vtypes.
* trans-stmt.c (gfc_trans_allocate): Handle initialization via
polymorphic MOLD expression.
* trans-expr.c (gfc_trans_class_init_assign): Now only used for
dummy initialization.
2010-09-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/44541
* gfortran.dg/allocate_alloc_opt_10.f90: Extended.
* gfortran.dg/class_dummy_1.f03: New.
From-SVN: r163744
Diffstat (limited to 'gcc/fortran/class.c')
| -rw-r--r-- | gcc/fortran/class.c | 31 |
1 files changed, 30 insertions, 1 deletions
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index df3a314..218247d 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -319,7 +319,7 @@ gfc_symbol * gfc_find_derived_vtab (gfc_symbol *derived) { gfc_namespace *ns; - gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL; + gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL; char name[2 * GFC_MAX_SYMBOL_LEN + 8]; /* Find the top-level namespace (MODULE or PROGRAM). */ @@ -408,6 +408,33 @@ gfc_find_derived_vtab (gfc_symbol *derived) c->initializer = gfc_get_null_expr (NULL); } + /* Add component $def_init. */ + if (gfc_add_component (vtype, "$def_init", &c) == FAILURE) + goto cleanup; + c->attr.pointer = 1; + c->attr.access = ACCESS_PRIVATE; + c->ts.type = BT_DERIVED; + c->ts.u.derived = derived; + if (derived->attr.abstract) + c->initializer = NULL; + else + { + /* Construct default initialization variable. */ + sprintf (name, "def_init$%s", derived->name); + gfc_get_symbol (name, ns, &def_init); + def_init->attr.target = 1; + def_init->attr.save = SAVE_EXPLICIT; + def_init->attr.access = ACCESS_PUBLIC; + def_init->attr.flavor = FL_VARIABLE; + gfc_set_sym_referenced (def_init); + def_init->ts.type = BT_DERIVED; + def_init->ts.u.derived = derived; + def_init->value = gfc_default_initializer (&def_init->ts); + + c->initializer = gfc_lval_expr_from_sym (def_init); + } + + /* Add procedure pointers for type-bound procedures. */ add_procs_to_declared_vtab (derived, vtype); vtype->attr.vtype = 1; } @@ -427,6 +454,8 @@ cleanup: gfc_commit_symbol (vtab); if (vtype) gfc_commit_symbol (vtype); + if (def_init) + gfc_commit_symbol (def_init); } else gfc_undo_symbols (); |