URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [class_allocate_3.f03] - Diff between revs 302 and 384

Rev 302	Rev 384
`! { dg-do run }`	`! { dg-do run }`
`!`	`!`
`! PR 41581: [OOP] Allocation of a CLASS with SOURCE= does not work`	`! PR 41581: [OOP] Allocation of a CLASS with SOURCE= does not work`
`!`	`!`
`! Contributed by Tobias Burnus`	`! Contributed by Tobias Burnus`

`type t`	`type t`
`end type t`	`end type t`

`type,extends(t) :: t2`	`type,extends(t) :: t2`
`integer :: i = 54`	`integer :: i = 54`
`real :: r = 384.02`	`real :: r = 384.02`
`end type t2`	`end type t2`

`class(t), allocatable :: m1, m2`	`class(t), allocatable :: m1, m2`

`allocate(t2 :: m2)`	`allocate(t2 :: m2)`
`select type(m2)`	`select type(m2)`
`type is (t2)`	`type is (t2)`
`print *, m2%i, m2%r`	`print *, m2%i, m2%r`
`if (m2%i/=54) call abort()`	`if (m2%i/=54) call abort()`
`if (abs(m2%r-384.02)>1E-3) call abort()`	`if (abs(m2%r-384.02)>1E-3) call abort()`
`m2%i = 42`	`m2%i = 42`
`m2%r = -4.0`	`m2%r = -4.0`
`class default`	`class default`
`call abort()`	`call abort()`
`end select`	`end select`

`allocate(m1, source=m2)`	`allocate(m1, source=m2)`
`select type(m1)`	`select type(m1)`
`type is (t2)`	`type is (t2)`
`print *, m1%i, m1%r`	`print *, m1%i, m1%r`
`if (m1%i/=42) call abort()`	`if (m1%i/=42) call abort()`
`if (abs(m1%r+4.0)>1E-3) call abort()`	`if (abs(m1%r+4.0)>1E-3) call abort()`
`class default`	`class default`
`call abort()`	`call abort()`
`end select`	`end select`

`end`	`end`