diff options
author | Janus Weil <janus@gcc.gnu.org> | 2010-05-15 15:52:33 +0200 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2010-05-15 15:52:33 +0200 |
commit | f8dde8af6f4bf8d16fcb12544caef0aad3da56f2 (patch) | |
tree | a70032d51f8a223474b6f5114ee467e48b7758f9 /gcc | |
parent | 46c3001944a778ddd079de47697c092bfd82419a (diff) | |
download | gcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.zip gcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.tar.gz gcc-f8dde8af6f4bf8d16fcb12544caef0aad3da56f2.tar.bz2 |
re PR fortran/43207 ([OOP] invalid (pointer) assignment to and from abstract non-polymorphic expressions)
2010-05-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/43207
PR fortran/43969
* gfortran.h (gfc_class_null_initializer): New prototype.
* expr.c (gfc_class_null_initializer): New function to build a NULL
initializer for CLASS pointers.
* symbol.c (gfc_build_class_symbol): Modify internal naming of class
containers. Remove default NULL initialization of $data component.
* trans.c (gfc_allocate_array_with_status): Fix wording of an error
message.
* trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
Use new function 'gfc_class_null_initializer'.
* trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
class variables.
2010-05-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/43207
PR fortran/43969
* gfortran.dg/class_18.f03: New.
* gfortran.dg/class_19.f03: New.
From-SVN: r159431
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 26 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
-rw-r--r-- | gcc/fortran/symbol.c | 12 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 2 | ||||
-rw-r--r-- | gcc/fortran/trans.c | 6 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_18.f03 | 18 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_19.f03 | 41 |
10 files changed, 125 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a95d16d..dd6d23f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2010-05-15 Janus Weil <janus@gcc.gnu.org> + + PR fortran/43207 + PR fortran/43969 + * gfortran.h (gfc_class_null_initializer): New prototype. + * expr.c (gfc_class_null_initializer): New function to build a NULL + initializer for CLASS pointers. + * symbol.c (gfc_build_class_symbol): Modify internal naming of class + containers. Remove default NULL initialization of $data component. + * trans.c (gfc_allocate_array_with_status): Fix wording of an error + message. + * trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign): + Use new function 'gfc_class_null_initializer'. + * trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar + class variables. + 2010-05-14 Steven G. Kargl <kargl@gcc.gnu.org> PR fortran/44135 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8230b46..382d1fe 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3628,6 +3628,32 @@ gfc_default_initializer (gfc_typespec *ts) } +/* Build a NULL initializer for CLASS pointers, + initializing the $data and $vptr components to zero. */ + +gfc_expr * +gfc_class_null_initializer (gfc_typespec *ts) +{ + gfc_expr *init; + gfc_component *comp; + + init = gfc_get_structure_constructor_expr (ts->type, ts->kind, + &ts->u.derived->declared_at); + init->ts = *ts; + + for (comp = ts->u.derived->components; comp; comp = comp->next) + { + gfc_constructor *ctor = gfc_constructor_get(); + ctor->expr = gfc_get_expr (); + ctor->expr->expr_type = EXPR_NULL; + ctor->expr->ts = comp->ts; + gfc_constructor_append (&init->value.constructor, ctor); + } + + return init; +} + + /* Given a symbol, create an expression node with that symbol as a variable. If the symbol is array valued, setup a reference of the whole array. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 91c8b80..96acaa4 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2630,6 +2630,7 @@ gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *); gfc_expr *gfc_default_initializer (gfc_typespec *); +gfc_expr *gfc_class_null_initializer (gfc_typespec *); gfc_expr *gfc_get_variable_expr (gfc_symtree *); gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 8403578..ceb45bf 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4717,15 +4717,15 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, /* Determine the name of the encapsulating type. */ if ((*as) && (*as)->rank && attr->allocatable) - sprintf (name, ".class.%s.%d.a", ts->u.derived->name, (*as)->rank); + sprintf (name, "class$%s_%d_a", ts->u.derived->name, (*as)->rank); else if ((*as) && (*as)->rank) - sprintf (name, ".class.%s.%d", ts->u.derived->name, (*as)->rank); + sprintf (name, "class$%s_%d", ts->u.derived->name, (*as)->rank); else if (attr->pointer) - sprintf (name, ".class.%s.p", ts->u.derived->name); + sprintf (name, "class$%s_p", ts->u.derived->name); else if (attr->allocatable) - sprintf (name, ".class.%s.a", ts->u.derived->name); + sprintf (name, "class$%s_a", ts->u.derived->name); else - sprintf (name, ".class.%s", ts->u.derived->name); + sprintf (name, "class$%s", ts->u.derived->name); gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass); if (fclass == NULL) @@ -4759,7 +4759,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, c->attr.codimension = attr->codimension; c->attr.abstract = ts->u.derived->attr.abstract; c->as = (*as); - c->initializer = gfc_get_null_expr (NULL); + c->initializer = NULL; /* Add component '$vptr'. */ if (gfc_add_component (fclass, "$vptr", &c) == FAILURE) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 47883e2..4d48c05 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3894,7 +3894,10 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type, case BT_DERIVED: case BT_CLASS: gfc_init_se (&se, NULL); - gfc_conv_structure (&se, expr, 1); + if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL) + gfc_conv_structure (&se, gfc_class_null_initializer(ts), 1); + else + gfc_conv_structure (&se, expr, 1); return se.expr; case BT_CHARACTER: @@ -4202,7 +4205,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr) { /* NULL initialization for CLASS components. */ tmp = gfc_trans_structure_assign (dest, - gfc_default_initializer (&cm->ts)); + gfc_class_null_initializer (&cm->ts)); gfc_add_expr_to_block (&block, tmp); } else if (cm->attr.dimension) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 1ffe284..257b684 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4529,6 +4529,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) { /* Allocatable scalar. */ arg1se.want_pointer = 1; + if (arg1->expr->ts.type == BT_CLASS) + gfc_add_component_ref (arg1->expr, "$data"); gfc_conv_expr (&arg1se, arg1->expr); tmp = arg1se.expr; } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 8acccf8..3a25bcc 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -704,7 +704,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) return mem; } else - runtime_error ("Attempting to allocate already allocated array"); + runtime_error ("Attempting to allocate already allocated variable"); } } @@ -743,13 +743,13 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, error = gfc_trans_runtime_error (true, &expr->where, "Attempting to allocate already" - " allocated array '%s'", + " allocated variable '%s'", varname); } else error = gfc_trans_runtime_error (true, NULL, "Attempting to allocate already allocated" - "array"); + "variable"); if (status != NULL_TREE && !integer_zerop (status)) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a813121..1e3d9c7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2010-05-15 Janus Weil <janus@gcc.gnu.org> + + PR fortran/43207 + PR fortran/43969 + * gfortran.dg/class_18.f03: New. + * gfortran.dg/class_19.f03: New. + 2010-05-14 Jakub Jelinek <jakub@redhat.com> PR debug/44112 diff --git a/gcc/testsuite/gfortran.dg/class_18.f03 b/gcc/testsuite/gfortran.dg/class_18.f03 new file mode 100644 index 0000000..576f931 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_18.f03 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! PR 43207: [OOP] ICE for class pointer => null() initialization +! +! Original test case by Tobias Burnus <burnus@gcc.gnu.org> +! Modified by Janus Weil <janus@gcc.gnu.org> + + implicit none + type :: parent + end type + type(parent), target :: t + class(parent), pointer :: cp => null() + + if (associated(cp)) call abort() + cp => t + if (.not. associated(cp)) call abort() + +end diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03 new file mode 100644 index 0000000..ffc3de3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_19.f03 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! PR 43969: [OOP] ALLOCATED() with polymorphic variables +! +! Contributed by Salvatore Filippone <sfilippone@uniroma2.it> + + +module foo_mod + type foo_inner + integer, allocatable :: v(:) + end type foo_inner + type foo_outer + class(foo_inner), allocatable :: int + end type foo_outer +contains +subroutine foo_checkit() + implicit none + type(foo_outer) :: try + type(foo_outer),allocatable :: try2 + class(foo_outer), allocatable :: try3 + + if (allocated(try%int)) call abort() + allocate(foo_outer :: try3) + if (allocated(try3%int)) call abort() + allocate(try2) + if (allocated(try2%int)) call abort() + +end subroutine foo_checkit +end module foo_mod + + +program main + + use foo_mod + implicit none + + call foo_checkit() + +end program main + +! { dg-final { cleanup-modules "foo_mod" } } |