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
