Dear All,
Please find attached a reworked version of the patch for this PR. I
have no idea at all, why the original version worked for array
components on my laptop. In this version, the treatment of scalar and
array components is cleanly separated.
Bootstrapped and regtested on FC21/x86_64. OK for trunk?
Paul
2015-02-04 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/640757
* resolve.c (resolve_structure_cons): Obtain the rank of class
components.
* trans-expr.c (gfc_trans_alloc_subarray_assign): Do the
assignment to allocatable class array components.
(alloc_scalar_allocatable_for_subcomponent_assignment): If comp
is a class component, allocate to the _data field.
(gfc_trans_subcomponent_assign): If a class component with a
derived type expression set the _vptr field and for array
components, call gfc_trans_alloc_subarray_assign. For scalars,
the assignment is performed here.
2015-02-04 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/640757
* gfortran.dg/type_to_class_2.f90: New test
* gfortran.dg/type_to_class_3.f90: New test
On 3 February 2015 at 22:36, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
> Dear Dominique,
>
> I have fixed all the problems except the last one. For that case, the
> other brand gives
> type_to_class_30.f90(19): error #7822: Variables containing ultimate
> allocatable array components are forbidden from appearing directly in
> input/output lists.
> print *, TestReference([Test(99), Test(199)])
> ---------^
> compilation aborted for type_to_class_30.f90 (code 1)
>
> which seems to me to be correct. I'll see what I can do to fix it.
>
> Thanks for the help
>
> Paul
>
> On 2 February 2015 at 17:53, Dominique Dhumieres <domi...@lps.ens.fr> wrote:
>> Dear Paul,
>>
>> I have tested your patch at
>> https://gcc.gnu.org/ml/fortran/2015-01/txtwnaoa1115V.txt
>> (the latest version) and I found that the test type_to_class_3.f03 is
>> miscompiled
>> (FAIL) with -flto -O0 -m64 (this does not happens with -flto -O0 -m32 or
>> with -Ox and
>> x!=0).
>>
>> In addition, while the reduced test
>>
>> type :: Test
>> integer :: i
>> end type
>>
>> type :: TestReference
>> class(Test), allocatable :: test(:)
>> end type
>>
>> type(TestReference) :: testList
>> type(test), allocatable :: x(:)
>>
>> allocate (testList%test(2), source = [Test(99), Test(199)]) ! Works, of
>> course
>> print *, size(testList%test)
>> x = testList%test
>> print *, x
>> end
>>
>> gives what I expect, i.e.,
>>
>> 2
>> 99 199
>>
>> type :: Test
>> integer :: i
>> end type
>>
>> type :: TestReference
>> class(Test), allocatable :: test(:)
>> end type
>>
>> type(TestReference) :: testList
>> type(test), allocatable :: x(:)
>>
>> testList = TestReference([Test(99), Test(199)]) ! Gave: The rank of the
>> element in the
>> ! structure constructor
>> at (1) does not
>> ! match that of the
>> component (1/0)
>> print *, size(testList%test)
>> x = testList%test
>> print *, x
>> end
>>
>> gives
>>
>> 1
>> 99
>>
>> Last problem I see,
>>
>> print *, TestReference([Test(99), Test(199)])
>>
>> gives the following ICE
>>
>> f951: internal compiler error: Bad IO basetype (7)
>>
>> type_to_class_3_red_2.f03:12:0:
>>
>> print *, TestReference([Test(99), Test(199)])
>>
>>
>> Cheers,
>>
>> Dominique
>
>
>
> --
> Outside of a dog, a book is a man's best friend. Inside of a dog it's
> too dark to read.
>
> Groucho Marx
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 220305)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_structure_cons (gfc_expr *expr,
*** 1155,1160 ****
--- 1155,1163 ----
}
rank = comp->as ? comp->as->rank : 0;
+ if (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->as)
+ rank = CLASS_DATA (comp)->as->rank;
+
if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
&& (comp->attr.allocatable || cons->expr->rank))
{
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 220305)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_trans_alloc_subarray_assign (tree de
*** 6211,6216 ****
--- 6211,6230 ----
tmp = gfc_copy_alloc_comp (cm->ts.u.derived,
se.expr, dest,
cm->as->rank);
+ else if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED
+ && CLASS_DATA(cm)->attr.allocatable)
+ {
+ if (cm->ts.u.derived->attr.alloc_comp)
+ tmp = gfc_copy_alloc_comp (expr->ts.u.derived,
+ se.expr, dest,
+ expr->rank);
+ else
+ {
+ tmp = TREE_TYPE (dest);
+ tmp = gfc_duplicate_allocatable (dest, se.expr,
+ tmp, expr->rank);
+ }
+ }
else
tmp = gfc_duplicate_allocatable (dest, se.expr,
TREE_TYPE(cm->backend_decl),
*************** alloc_scalar_allocatable_for_subcomponen
*** 6335,6340 ****
--- 6349,6355 ----
gfc_symbol *sym)
{
tree tmp;
+ tree ptr;
tree size;
tree size_in_bytes;
tree lhs_cl_size = NULL_TREE;
*************** alloc_scalar_allocatable_for_subcomponen
*** 6400,6407 ****
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 (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
--- 6415,6426 ----
tmp = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MALLOC),
1, size_in_bytes);
! 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)
*************** gfc_trans_subcomponent_assign (tree dest
*** 6420,6425 ****
--- 6439,6445 ----
gfc_se lse;
stmtblock_t block;
tree tmp;
+ tree vtab;
gfc_start_block (&block);
*************** gfc_trans_subcomponent_assign (tree dest
*** 6483,6488 ****
--- 6503,6522 ----
gfc_add_expr_to_block (&block, tmp);
}
}
+ else if (cm->ts.type == BT_CLASS
+ && CLASS_DATA (cm)->attr.dimension
+ && CLASS_DATA (cm)->attr.allocatable
+ && expr->ts.type == BT_DERIVED)
+ {
+ vtab = gfc_get_symbol_decl (gfc_find_vtab (&expr->ts));
+ vtab = gfc_build_addr_expr (NULL_TREE, vtab);
+ tmp = gfc_class_vptr_get (dest);
+ gfc_add_modify (&block, tmp,
+ fold_convert (TREE_TYPE (tmp), vtab));
+ tmp = gfc_class_data_get (dest);
+ tmp = gfc_trans_alloc_subarray_assign (tmp, cm, expr);
+ gfc_add_expr_to_block (&block, tmp);
+ }
else if (init && (cm->attr.allocatable
|| (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable)))
{
*************** gfc_trans_subcomponent_assign (tree dest
*** 6504,6510 ****
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);
/* For deferred strings insert a memcpy. */
if (cm->ts.type == BT_CHARACTER && cm->ts.deferred)
{
--- 6538,6556 ----
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);
!
! if (cm->ts.type == BT_CLASS && expr->ts.type == BT_DERIVED)
! {
! 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/type_to_class_2.f03
===================================================================
*** gcc/testsuite/gfortran.dg/type_to_class_2.f03 (revision 0)
--- gcc/testsuite/gfortran.dg/type_to_class_2.f03 (working copy)
***************
*** 0 ****
--- 1,30 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR64757.
+ !
+ ! Contributed by Michael Lee Rilee <m...@rilee.net>
+ !
+ 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
+
+
Index: gcc/testsuite/gfortran.dg/type_to_class_3.f03
===================================================================
*** gcc/testsuite/gfortran.dg/type_to_class_3.f03 (revision 0)
--- gcc/testsuite/gfortran.dg/type_to_class_3.f03 (working copy)
***************
*** 0 ****
--- 1,33 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for the array version of PR64757.
+ !
+ ! Based on by Michael Lee Rilee <m...@rilee.net>
+ !
+ type :: Test
+ integer :: i
+ end type
+
+ type :: TestReference
+ class(Test), allocatable :: test(:)
+ end type
+
+ type(TestReference) :: testList
+ type(test), allocatable :: x(:)
+
+ testList = TestReference([Test(99), Test(199)]) ! Gave: The rank of the
element in the
+ ! structure constructor at
(1) does not
+ ! match that of the
component (1/0)
+ ! allocate (testList%test(2), source = [Test(99), Test(199)]) ! Works, of
course
+
+ x = testList%test
+
+ select type (y => testList%test) ! Check vptr set
+ type is (Test)
+ if (any(x%i .ne. y%i)) call abort
+ class default
+ call abort
+ end select
+ end
+
+
