Dear All,
This regression was caused by the patch for PR60357. The fix is
straightforward. Please note however, that I have not checked for
other fallout yet - I have merely addressed the reported failure. I
will check around the reported testcase tomorrow night.
Dominique, thanks for the rapid feedback.
class_to_type_4.f90 is reserved for the patch for PR63205.
Bootstrapped and regtested on x86_64/FC21 - OK for trunk?
Michael, many thanks for a prompt report. Please come back to us with
any more bugs that you find!
Cheers
Paul
2015-01-28 Paul Thomas <[email protected]>
PR fortran/640757
* trans-expr.c
(alloc_scalar_allocatable_for_subcomponent_assignment): If comp
is a class component, get the data pointer.
(gfc_trans_subcomponent_assign): If a class component with a
derived type expression get the data pointer for the assignment
and set the vptr.
2015-01-28 Paul Thomas <[email protected]>
PR fortran/640757
* gfortran.dg/class_to_type_5.f90: New test
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 220083)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -6335,6 +6335,7 @@
gfc_symbol *sym)
{
tree tmp;
+ tree ptr;
tree size;
tree size_in_bytes;
tree lhs_cl_size = NULL_TREE;
@@ -6400,8 +6401,12 @@
tmp = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MALLOC),
1, size_in_bytes);
- tmp = fold_convert (TREE_TYPE (comp), tmp);
- gfc_add_modify (block, comp, tmp);
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (comp)))
+ ptr = gfc_class_data_get (comp);
+ else
+ ptr = comp;
+ tmp = fold_convert (TREE_TYPE (ptr), tmp);
+ gfc_add_modify (block, ptr, tmp);
}
if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
@@ -6504,7 +6509,21 @@
if (expr->symtree && expr->symtree->n.sym->attr.proc_pointer
&& expr->symtree->n.sym->attr.dummy)
se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
- tmp = build_fold_indirect_ref_loc (input_location, dest);
+
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (dest)) && expr->ts.type == BT_DERIVED)
+ {
+ tree vtab;
+ tmp = gfc_class_data_get (dest);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ vtab = gfc_get_symbol_decl (gfc_find_vtab (&expr->ts));
+ vtab = gfc_build_addr_expr (NULL_TREE, vtab);
+ gfc_add_modify (&block, gfc_class_vptr_get (dest),
+ fold_convert (TREE_TYPE (gfc_class_vptr_get (dest)), vtab));
+ }
+ else
+ tmp = build_fold_indirect_ref_loc (input_location, dest);
+
+
/* For deferred strings insert a memcpy. */
if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
{
Index: gcc/testsuite/gfortran.dg/class_to_type_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_to_type_5.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/class_to_type_5.f03 (working copy)
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! Test the fix for PR64757.
+!
+! Contributed by Michael Lee Rilee <[email protected]>
+!
+ type :: Test
+ integer :: i
+ end type
+
+ type :: TestReference
+ class(Test), allocatable :: test
+ end type
+
+ type(TestReference) :: testList
+ type(test) :: x
+
+ testList = TestReference(Test(99)) ! ICE in fold_convert_loc was here
+
+ x = testList%test
+
+ select type (y => testList%test) ! Check vptr set
+ type is (Test)
+ if (x%i .ne. y%i) call abort
+ class default
+ call abort
+ end select
+end
+
+
