re PR fortran/63553 ([OOP] Wrong code when assigning a CLASS to a TYPE)

2014-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/63553
	* resolve.c (resolve_ordinary_assign): Add data component to
	rvalue expression for class to type assignment.

2014-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/63553
	* gfortran.dg/class_to_type_3.f03 : New test

From-SVN: r216427

gcc/fortran/ChangeLog

+2014-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/63553
+	* resolve.c (resolve_ordinary_assign): Add data component to
+	rvalue expression for class to type assignment.
+
 2014-10-16  Andrew MacLeod  <amacleod@redhat.com>
 
 	* f95-lang.c: Adjust include files.

gcc/fortran/resolve.c

@@ -9341,6 +9341,11 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 
   gfc_check_assign (lhs, rhs, 1);
 
+  /* Assign the 'data' of a class object to a derived type.  */
+  if (lhs->ts.type == BT_DERIVED
+      && rhs->ts.type == BT_CLASS)
+    gfc_add_data_component (rhs);
+
   /* Insert a GFC_ISYM_CAF_SEND intrinsic, when the LHS is a coindexed variable.
      Additionally, insert this code when the RHS is a CAF as we then use the
      GFC_ISYM_CAF_SEND intrinsic just to avoid a temporary; but do not do so if

gcc/testsuite/ChangeLog

+2014-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/63553
+	* gfortran.dg/class_to_type_3.f03 : New test
+
 2014-10-18  Oleg Endo  <olegendo@gcc.gnu.org>
 
 	* gcc.target/sh/torture/pr58314.c: Fix excess failures caused by switch

gcc/testsuite/gfortran.dg/class_to_type_3.f03

+! { dg-do run }
+! Tests the fix for pr63553 in which the class container was being
+! assigned to derived types, rather than the data.
+!
+! Contributed by <patnel97269-gfortran@yahoo.fr>
+!
+program toto
+  implicit none
+  type mother
+    integer :: i
+  end type mother
+  type,extends(mother) :: child
+  end type child
+
+  call comment1
+  call comment2
+
+contains
+  subroutine comment1
+    type(mother) :: tm
+    class(mother),allocatable :: cm
+
+    allocate (cm)
+    cm%i = 77
+    tm = cm
+    if (tm%i .ne. cm%i) call abort
+  end subroutine
+
+  subroutine comment2
+    class(mother),allocatable :: cm,cm2
+
+    allocate(cm)
+    allocate(child::cm2)
+    cm%i=10
+    select type (cm2)
+       type is (child)
+         cm2%mother=cm
+    end select
+    if (cm2%i .ne. cm%i) call abort
+  end subroutine
+end program