URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [class_to_type_1.f03] - Blame information for rev 720

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do run }
!
! Passing CLASS to TYPE
!
implicit none
type t
  integer :: A
  real, allocatable :: B(:)
end type t
 
type, extends(t) ::  t2
  complex :: z = cmplx(3.3, 4.4)
end type t2
integer :: i
class(t), allocatable :: x(:)
 
allocate(t2 :: x(10))
select type(x)
 type is(t2)
  if (size (x) /= 10) call abort ()
  x = [(t2(a=-i, B=[1*i,2*i,3*i,4*i]), i = 1, 10)]
  do i = 1, 10
    if (x(i)%a /= -i .or. size (x(i)%b) /= 4 &
        .or. any (x(i)%b /= [1*i,2*i,3*i,4*i])) then
        call abort()
    end if
    if (x(i)%z /= cmplx(3.3, 4.4)) call abort()
  end do
  class default
    call abort()
end select
 
call base(x)
call baseExplicit(x, size(x))
call class(x)
call classExplicit(x, size(x))
contains
  subroutine base(y)
    type(t) :: y(:)
    if (size (y) /= 10) call abort ()
    do i = 1, 10
      if (y(i)%a /= -i .or. size (y(i)%b) /= 4 &
          .or. any (y(i)%b /= [1*i,2*i,3*i,4*i])) then
        call abort()
      end if
    end do
  end subroutine base
  subroutine baseExplicit(v, n)
    integer, intent(in) :: n
    type(t) :: v(n)
    if (size (v) /= 10) call abort ()
    do i = 1, 10
      if (v(i)%a /= -i .or. size (v(i)%b) /= 4 &
          .or. any (v(i)%b /= [1*i,2*i,3*i,4*i])) then
        call abort()
      end if
    end do
  end subroutine baseExplicit
  subroutine class(z)
    class(t), intent(in) :: z(:)
    select type(z)
     type is(t2)
      if (size (z) /= 10) call abort ()
      do i = 1, 10
        if (z(i)%a /= -i .or. size (z(i)%b) /= 4 &
            .or. any (z(i)%b /= [1*i,2*i,3*i,4*i])) then
            call abort()
        end if
        if (z(i)%z /= cmplx(3.3, 4.4)) call abort()
      end do
      class default
        call abort()
    end select
    call base(z)
    call baseExplicit(z, size(z))
  end subroutine class
  subroutine classExplicit(u, n)
    integer, intent(in) :: n
    class(t), intent(in) :: u(n)
    select type(u)
     type is(t2)
      if (size (u) /= 10) call abort ()
      do i = 1, 10
        if (u(i)%a /= -i .or. size (u(i)%b) /= 4 &
            .or. any (u(i)%b /= [1*i,2*i,3*i,4*i])) then
            call abort()
        end if
        if (u(i)%z /= cmplx(3.3, 4.4)) call abort()
      end do
      class default
        call abort()
    end select
    call base(u)
    call baseExplicit(u, n)
  end subroutine classExplicit
end
 

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! Passing CLASS to TYPE`
4			`!`
5			`implicit none`
6			`type t`
7			`integer :: A`
8			`real, allocatable :: B(:)`
9			`end type t`
10
11			`type, extends(t) :: t2`
12			`complex :: z = cmplx(3.3, 4.4)`
13			`end type t2`
14			`integer :: i`
15			`class(t), allocatable :: x(:)`
16
17			`allocate(t2 :: x(10))`
18			`select type(x)`
19			`type is(t2)`
20			`if (size (x) /= 10) call abort ()`
21			`x = [(t2(a=-i, B=[1i,2i,3i,4i]), i = 1, 10)]`
22			`do i = 1, 10`
23			`if (x(i)%a /= -i .or. size (x(i)%b) /= 4 &`
24			`.or. any (x(i)%b /= [1i,2i,3i,4i])) then`
25			`call abort()`
26			`end if`
27			`if (x(i)%z /= cmplx(3.3, 4.4)) call abort()`
28			`end do`
29			`class default`
30			`call abort()`
31			`end select`
32
33			`call base(x)`
34			`call baseExplicit(x, size(x))`
35			`call class(x)`
36			`call classExplicit(x, size(x))`
37			`contains`
38			`subroutine base(y)`
39			`type(t) :: y(:)`
40			`if (size (y) /= 10) call abort ()`
41			`do i = 1, 10`
42			`if (y(i)%a /= -i .or. size (y(i)%b) /= 4 &`
43			`.or. any (y(i)%b /= [1i,2i,3i,4i])) then`
44			`call abort()`
45			`end if`
46			`end do`
47			`end subroutine base`
48			`subroutine baseExplicit(v, n)`
49			`integer, intent(in) :: n`
50			`type(t) :: v(n)`
51			`if (size (v) /= 10) call abort ()`
52			`do i = 1, 10`
53			`if (v(i)%a /= -i .or. size (v(i)%b) /= 4 &`
54			`.or. any (v(i)%b /= [1i,2i,3i,4i])) then`
55			`call abort()`
56			`end if`
57			`end do`
58			`end subroutine baseExplicit`
59			`subroutine class(z)`
60			`class(t), intent(in) :: z(:)`
61			`select type(z)`
62			`type is(t2)`
63			`if (size (z) /= 10) call abort ()`
64			`do i = 1, 10`
65			`if (z(i)%a /= -i .or. size (z(i)%b) /= 4 &`
66			`.or. any (z(i)%b /= [1i,2i,3i,4i])) then`
67			`call abort()`
68			`end if`
69			`if (z(i)%z /= cmplx(3.3, 4.4)) call abort()`
70			`end do`
71			`class default`
72			`call abort()`
73			`end select`
74			`call base(z)`
75			`call baseExplicit(z, size(z))`
76			`end subroutine class`
77			`subroutine classExplicit(u, n)`
78			`integer, intent(in) :: n`
79			`class(t), intent(in) :: u(n)`
80			`select type(u)`
81			`type is(t2)`
82			`if (size (u) /= 10) call abort ()`
83			`do i = 1, 10`
84			`if (u(i)%a /= -i .or. size (u(i)%b) /= 4 &`
85			`.or. any (u(i)%b /= [1i,2i,3i,4i])) then`
86			`call abort()`
87			`end if`
88			`if (u(i)%z /= cmplx(3.3, 4.4)) call abort()`
89			`end do`
90			`class default`
91			`call abort()`
92			`end select`
93			`call base(u)`
94			`call baseExplicit(u, n)`
95			`end subroutine classExplicit`
96			`end`
97

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [class_to_type_1.f03] - Blame information for rev 720