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 <pa...@gcc.gnu.org> PR fortran/57445 * trans-expr.c (gfc_conv_class_to_class): Remove spurious assert. 2013-11-01 Paul Thomas <pa...@gcc.gnu.org> 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 <bur...@gcc.gnu.org> + ! + ! 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