Dear All,
This one is trivial. The ICE was caused by an assert that turns out
to be spurious and has been removed.
Bootstrapped and regtested on FC17/x86_64 - OK for trunk and 4.8?
Cheers
Paul
2013-11-01 Paul Thomas <[email protected]>
PR fortran/57445
* trans-expr.c (gfc_conv_class_to_class): Remove spurious
assert.
2013-11-01 Paul Thomas <[email protected]>
PR fortran/57445
* gfortran.dg/optional_class_1.f90 : New test
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 204285)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_class_to_class (gfc_se *parmse,
*** 737,743 ****
gfc_add_modify (&parmse->post, vptr,
fold_convert (TREE_TYPE (vptr), ctree));
- gcc_assert (!optional || (optional && !copyback));
if (optional)
{
tree tmp2;
--- 737,742 ----
*************** is_runtime_conformable (gfc_expr *expr1,
*** 7769,7775 ****
e1 = a->expr;
if (e1->rank > 0 && !is_runtime_conformable (expr1, e1))
return false;
! }
return true;
}
else if (expr2->value.function.isym
--- 7768,7774 ----
e1 = a->expr;
if (e1->rank > 0 && !is_runtime_conformable (expr1, e1))
return false;
! }
return true;
}
else if (expr2->value.function.isym
Index: gcc/testsuite/gfortran.dg/optional_class_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/optional_class_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/optional_class_1.f90 (working copy)
***************
*** 0 ****
--- 1,45 ----
+ ! { dg-do run }
+ !
+ ! PR fortran/57445
+ !
+ ! Contributed by Tobias Burnus <[email protected]>
+ !
+ ! Spurious assert was added at revision 192495
+ !
+ module m
+ implicit none
+ type t
+ integer :: i
+ end type t
+ contains
+ subroutine opt(xa, xc, xaa, xca)
+ type(t), allocatable, intent(out), optional :: xa
+ class(t), allocatable, intent(out), optional :: xc
+ type(t), allocatable, intent(out), optional :: xaa(:)
+ class(t), allocatable, intent(out), optional :: xca(:)
+ if (present (xca)) call foo_opt(xca=xca)
+ end subroutine opt
+ subroutine foo_opt(xa, xc, xaa, xca)
+ type(t), allocatable, intent(out), optional :: xa
+ class(t), allocatable, intent(out), optional :: xc
+ type(t), allocatable, intent(out), optional :: xaa(:)
+ class(t), allocatable, intent(out), optional :: xca(:)
+ if (present (xca)) then
+ if (allocated (xca)) deallocate (xca)
+ allocate (xca(3), source = [t(9),t(99),t(999)])
+ end if
+ end subroutine foo_opt
+ end module m
+ use m
+ class(t), allocatable :: xca(:)
+ allocate (xca(1), source = t(42))
+ select type (xca)
+ type is (t)
+ if (any (xca%i .ne. [42])) call abort
+ end select
+ call opt (xca = xca)
+ select type (xca)
+ type is (t)
+ if (any (xca%i .ne. [9,99,999])) call abort
+ end select
+ end
