[Bug fortran/104048] ICE with recursively defined derived type

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=104048

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Assignee|unassigned at gcc dot gnu.org      |pault at gcc dot gnu.org

--- Comment #5 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to Martin Liška from comment #4)
> Started with r7-4096-gbf9f15ee55f5b291, it was rejected before the revision
> with:

The fix is (This chunk is lifted from a much bigger patch):

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2e15a7e874c..3f786e91a2f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -11419,6 +11562,8 @@ trans_class_assignment (stmtblock_t *block, gfc_expr
*lhs, gfc_expr *rhs,
        old_vptr = build_int_cst (TREE_TYPE (vptr), 0);

       size = gfc_vptr_size_get (vptr);
+      lse->expr = TREE_CODE (lse->expr) == INDIRECT_REF ?
+                 TREE_OPERAND (lse->expr, 0) : lse->expr;
       class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))
          ? gfc_class_data_get (lse->expr) : lse->expr;


with it this runs correctly:


MODULE moa_view_types

    IMPLICIT NONE

    TYPE moa_basic_view
        integer, allocatable :: shp(:)
    END TYPE moa_basic_view

    TYPE :: moa_view_type
        TYPE(moa_basic_view)             :: left_array
        TYPE(moa_basic_view)             :: right_array
        TYPE(moa_view_type), ALLOCATABLE :: left_view
        TYPE(moa_view_type), ALLOCATABLE :: right_view
    END TYPE moa_view_type

CONTAINS

FUNCTION catenate_view_view( view1, view2 ) result(new_view)
    CLASS(moa_view_type), TARGET, INTENT(IN) :: view1
    CLASS(moa_view_type), TARGET, INTENT(IN) :: view2
    CLASS(moa_view_type),  ALLOCATABLE        :: new_view

    ALLOCATE( new_view )

    new_view%left_view  = view1 ! Used to cause an ICE
    new_view%right_view = view2 !      -ditto-
END FUNCTION catenate_view_view

END MODULE moa_view_types

    use moa_view_types
    class(moa_view_type), allocatable :: view1, view2, new_view
    allocate (view1, view2)
    view1%left_array%shp = [1 , 2]
    view2%right_array%shp = [3 , 4]
    new_view = catenate_view_view( view1, view2 )
    select type (new_view)
      type is (moa_view_type)
        if (any (new_view%left_view%left_array%shp .ne. [1,2])) stop 1
        if (any (new_view%right_view%right_array%shp .ne. [3,4])) stop 2
    end select
end


Paul