[Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 1017 bytes --]

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  <pault@gcc.gnu.org>

    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  <pault@gcc.gnu.org>

    PR fortran/640757
    * gfortran.dg/class_to_type_5.f90: New test

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 2558 bytes --]

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  <mike@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
+
+

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 1889 bytes --]

Dear All,

I noticed last night that the component array version of Michael's
testcase doesn't even get past resolution. The attached is an updated
version of the patch that fixes that. Although the additional bits of
the patch do not fix a regression, I think that it is worth having the
extra functionality; especially since it is somewhat clearer than
using allocate with a source expression.

A ChangeLog will follow later on. Please note that I changed the name
of the original testcase because it had class and type the wrong way
round :-)

Bootstraps and regtests on x86_64 - OK for trunk?

Best regards

Paul

On 28 January 2015 at 21:09, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> 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  <pault@gcc.gnu.org>
>
>     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  <pault@gcc.gnu.org>
>
>     PR fortran/640757
>     * gfortran.dg/class_to_type_5.f90: New test



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

[-- Attachment #2: submit2.diff --]
[-- Type: text/plain, Size: 6509 bytes --]

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 220083)
--- 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 220083)
--- gcc/fortran/trans-expr.c	(working copy)
*************** alloc_scalar_allocatable_for_subcomponen
*** 6335,6340 ****
--- 6335,6341 ----
  						      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)
--- 6401,6412 ----
        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
*** 6498,6510 ****
        /* The remainder of these instructions follow the if (cm->attr.pointer)
  	 if (!cm->attr.dimension) part above.  */
        gfc_init_se (&se, NULL);
!       gfc_conv_expr (&se, expr);
        gfc_add_block_to_block (&block, &se.pre);
  
        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)
  	{
--- 6503,6533 ----
        /* The remainder of these instructions follow the if (cm->attr.pointer)
  	 if (!cm->attr.dimension) part above.  */
        gfc_init_se (&se, NULL);
!       if (expr->rank)
! 	gfc_conv_expr_descriptor (&se, expr);
!       else
! 	gfc_conv_expr (&se, expr);
        gfc_add_block_to_block (&block, &se.pre);
  
        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 (GFC_CLASS_TYPE_P (TREE_TYPE (dest)) && expr->ts.type == BT_DERIVED)
! 	{
! 	  tree vtab;
! 	  tmp = gfc_class_data_get (dest);
! 	  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
! 	    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)
  	{
*************** gfc_trans_subcomponent_assign (tree dest
*** 6516,6524 ****
--- 6539,6558 ----
  	  tmp = gfc_build_memcpy_call (tmp, se.expr, size);
  	  gfc_add_expr_to_block (&block, tmp);
  	}
+       else if (expr->rank)
+ 	{
+ 	  if (expr->ts.u.derived->attr.alloc_comp)
+ 	    tmp = gfc_copy_alloc_comp (expr->ts.u.derived, se.expr,
+ 				       tmp, expr->rank);
+ 	  else
+ 	    tmp = gfc_duplicate_allocatable (tmp, se.expr,
+ 					     TREE_TYPE (tmp), expr->rank);
+ 	  gfc_add_expr_to_block (&block, tmp);
+ 	}
        else
  	gfc_add_modify (&block, tmp,
  			fold_convert (TREE_TYPE (tmp), se.expr));
+ 
        gfc_add_block_to_block (&block, &se.post);
      }
    else if (expr->ts.type == BT_DERIVED && expr->ts.f90_type != BT_VOID)
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  <mike@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  <mike@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
+ 
+ 

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Tobias Burnus]

Dear Paul, dear all,

Paul Richard Thomas wrote:
> Please find attached a reworked version of the patch for this PR. [...]
> In this version, the treatment of scalar and array components is cleanly
> separated.
>
> Bootstrapped and regtested on FC21/x86_64. OK for trunk?

Looks good to me. Thanks for the patch.

  * * *

However, as follow up, one should check also the initialization of a 
(polymorphic) pointer component. Quoting the standard:

"For a pointer component, the corresponding component-data-source shall 
be an allowable data-target or proctarget for such a pointer in a 
pointer assignment statement (7.2.2). If the component data source is a 
pointer, the association of the component is that of the pointer; 
otherwise, the component is pointer associated with the component data 
source."

Thus, one should check CLASS => CLASS and CLASS <-> TYPE.

  * * *

And, finally, I wonder whether we need to take care of:

type m
end type m
type t
   CLASS(m), allocatable :: caf[:]
end type t
type(t), save :: x = t(m())
end

We probably do. I think that's valid as it is (kind of) statically 
allocated. That means we need to call for -fcoarray=lib the 
_gfortran_caf_register function for x%caf as constructor (in the C 
sense) - such that the address is registered at program start up. The 
(pointer) assignment of that address to x%caf can be done later, e.g. 
when the procedure (or __MAIN) is actually entered.

Tobias

> 2015-02-04  Paul Thomas  <pault@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  <pault@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.thomas@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 <dominiq@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
>
>

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 3711 bytes --]

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  <pault@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  <pault@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.thomas@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 <dominiq@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

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 6857 bytes --]

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  <mike@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  <mike@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
+ 
+ 

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Paul Richard Thomas]

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 <dominiq@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

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Paul Richard Thomas]

Dear Dominique,

On transferring from my laptop to my workstation, I find that it
segfaults in runtime - both are x86_64/FC21. If I can, I intend to
investigate tonight.

Thanks for the report.

Paul

On 2 February 2015 at 17:53, Dominique Dhumieres <dominiq@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

Re: [Patch, fortran] PR 64757 - [5 Regression] ICE in fold_convert_loc, at fold-const.c:2353

[Dominique Dhumieres]

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