OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/51972 ([OOP] Wrong code as _copy does not honor CLASS components) 

2012-02-05  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51972
        * gfortran.dg/class_48.f90: Add some further checks.

From-SVN: r183904
This commit is contained in:
Tobias Burnus 2012-02-05 10:46:20 +01:00 committed by Tobias Burnus
parent 24ee13842e
commit b1c02fdc55
2 changed files with 45 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2012-02-05 Tobias Burnus <burnus@net-b.de>
PR fortran/51972
* gfortran.dg/class_48.f90: Add some further checks.
2012-02-05 Ira Rosen <irar@il.ibm.com>
PR tree-optimization/52091

47
gcc/testsuite/gfortran.dg/class_48.f90
View File

@ -70,13 +70,15 @@ subroutine test3 ()
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
@ -94,12 +96,43 @@ subroutine test4 ()
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