The patch for PR 51972 fixed some issues with intrinsic assignment,
which involved polymorphic components.
However, I couldn't check the correctness in some cases as I run ICEs.
Those were fixed by Mikael's recent patch (cf. PR 51754 et alia).
The committed (Rev. ) and attached patch adds the missing checks. On the
way, I run into another issue (now: PR 52102), which I worked around.
However, as MALLOC_PERTURB_ or valgrind shows, the issue also affects
the current version. Thus, in the committed patch, only test3() has
proper checking, for test4() I have added a commented out test case,
which without MALLOC_PERTURB_ should work.
Committed as Rev. 183904.
Tobias
Index: gcc/testsuite/gfortran.dg/class_48.f90
===================================================================
--- gcc/testsuite/gfortran.dg/class_48.f90 (Revision 183903)
+++ gcc/testsuite/gfortran.dg/class_48.f90 (Arbeitskopie)
@@ -70,14 +70,16 @@
type(t2) :: one, two
- one = two
+ allocate (two%a(2))
+ two%a(1)%x = 4
+ two%a(2)%x = 6
if (allocated (one%a)) call abort ()
-
- allocate (two%a(2), source=[t(4), t(6)])
one = two
if (.not.allocated (one%a)) call abort ()
-! FIXME: Check value
+ if ((one%a(1)%x /= 4)) call abort ()
+ if ((one%a(2)%x /= 6)) call abort ()
+
deallocate (two%a)
one = two
if (allocated (one%a)) call abort ()
@@ -94,12 +96,43 @@
type(t2) :: one, two
- one = two
if (allocated (one%a)) call abort ()
-
-! allocate (two%a(2)) ! ICE: SEGFAULT
+ if (allocated (two%a)) call abort ()
+!
+! FIXME: Fails due to PR 51754
+!
+! NOTE: Might be only visible with MALLOC_PERTURB_ or with valgrind
+!
+! allocate (two%a(2))
+! if (allocated (two%a(1)%x)) call abort ()
+! if (allocated (two%a(2)%x)) call abort ()
+! allocate (two%a(1)%x(3), source=[1,2,3])
+! allocate (two%a(2)%x(5), source=[5,6,7,8,9])
! one = two
! if (.not. allocated (one%a)) call abort ()
+! if (.not. allocated (one%a(1)%x)) call abort ()
+! if (.not. allocated (one%a(2)%x)) call abort ()
+!
+! if (size(one%a) /= 2) call abort()
+! if (size(one%a(1)%x) /= 3) call abort()
+! if (size(one%a(2)%x) /= 5) call abort()
+! if (any (one%a(1)%x /= [1,2,3])) call abort ()
+! if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+!
+! deallocate (two%a(1)%x)
+! one = two
+! if (.not. allocated (one%a)) call abort ()
+! if (allocated (one%a(1)%x)) call abort ()
+! if (.not. allocated (one%a(2)%x)) call abort ()
+!
+! if (size(one%a) /= 2) call abort()
+! if (size(one%a(2)%x) /= 5) call abort()
+! if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+!
+! deallocate (two%a)
+ one = two
+ if (allocated (one%a)) call abort ()
+ if (allocated (two%a)) call abort ()
end subroutine test4
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 183903)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,8 @@
+2012-02-05 Tobias Burnus <bur...@net-b.de>
+
+ PR fortran/51972
+ * gfortran.dg/class_48.f90: Add some further checks.
+
2012-02-05 Ira Rosen <i...@il.ibm.com>
PR tree-optimization/52091
