+2011-01-05 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/47180
+ * trans-expr.c (gfc_trans_class_assign): For a polymorphic NULL pointer
+ assignment, set the _vptr component to the declared type.
+
2011-01-05 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/46017
if (expr2->ts.type != BT_CLASS)
{
/* Insert an additional assignment which sets the '_vptr' field. */
+ gfc_symbol *vtab;
+ gfc_symtree *st;
+
lhs = gfc_copy_expr (expr1);
gfc_add_vptr_component (lhs);
+
if (expr2->ts.type == BT_DERIVED)
- {
- gfc_symbol *vtab;
- gfc_symtree *st;
- vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
- gcc_assert (vtab);
- rhs = gfc_get_expr ();
- rhs->expr_type = EXPR_VARIABLE;
- gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
- rhs->symtree = st;
- rhs->ts = vtab->ts;
- }
+ vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
else if (expr2->expr_type == EXPR_NULL)
- rhs = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
- else
- gcc_unreachable ();
+ vtab = gfc_find_derived_vtab (expr1->ts.u.derived);
+ gcc_assert (vtab);
+
+ rhs = gfc_get_expr ();
+ rhs->expr_type = EXPR_VARIABLE;
+ gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
+ rhs->symtree = st;
+ rhs->ts = vtab->ts;
tmp = gfc_trans_pointer_assignment (lhs, rhs);
gfc_add_expr_to_block (&block, tmp);
+2011-01-05 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/47180
+ * gfortran.dg/extends_type_of_2.f03: New.
+
2011-01-05 Ulrich Weigand <Ulrich.Weigand@de.ibm.com>
* gcc.dg/stack-usage-1.c (SIZE): Provide proper value for __SPU__.
--- /dev/null
+! { dg-do run }
+!
+! PR 47180: [OOP] EXTENDS_TYPE_OF returns the wrong result for disassociated polymorphic pointers
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+
+type t1
+ integer :: a
+end type t1
+
+type, extends(t1):: t11
+ integer :: b
+end type t11
+
+type(t1) , target :: a1
+type(t11) , target :: a11
+class(t1) , pointer :: b1
+class(t11), pointer :: b11
+
+b1 => NULL()
+b11 => NULL()
+
+if (.not. extends_type_of(b1 , a1)) call abort()
+if (.not. extends_type_of(b11, a1)) call abort()
+if (.not. extends_type_of(b11,a11)) call abort()
+
+b1 => a1
+b11 => a11
+
+if (.not. extends_type_of(b1 , a1)) call abort()
+if (.not. extends_type_of(b11, a1)) call abort()
+if (.not. extends_type_of(b11,a11)) call abort()
+
+end