re PR fortran/57445 ([OOP] ICE in gfc_conv_class_to_class - for OPTIONAL polymorphic array)

2013-11-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57445
	* trans-expr.c (gfc_conv_class_to_class): Remove spurious
	assert.

2013-11-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57445
	* gfortran.dg/optional_class_1.f90 : New test

From-SVN: r204356

gcc/fortran/ChangeLog

+2013-11-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/57445
+	* trans-expr.c (gfc_conv_class_to_class): Remove spurious
+	assert.
+
 2013-10-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/44350

gcc/fortran/trans-expr.c

@@ -737,7 +737,6 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
     gfc_add_modify (&parmse->post, vptr,
 		    fold_convert (TREE_TYPE (vptr), ctree));
 
-  gcc_assert (!optional || (optional && !copyback));
   if (optional)
     {
       tree tmp2;
@@ -7769,7 +7768,7 @@ is_runtime_conformable (gfc_expr *expr1, gfc_expr *expr2)
 	      e1 = a->expr;
 	      if (e1->rank > 0 && !is_runtime_conformable (expr1, e1))
 		return false;
-	    }	 
+	    }
 	  return true;
 	}
       else if (expr2->value.function.isym

gcc/testsuite/ChangeLog

+2013-11-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/57445
+	* gfortran.dg/optional_class_1.f90 : New test
+
 2013-11-04  Vladimir Makarov  <vmakarov@redhat.com>
 
 	PR rtl-optimization/58968

gcc/testsuite/gfortran.dg/optional_class_1.f90

+! { dg-do run }
+!
+! PR fortran/57445
+!
+! Contributed by Tobias Burnus  <burnus@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