Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/type_to_class_1.f03 @ 127:4c56639505ff
fix function.c and add CbC-example Makefile
author | mir3636 |
---|---|
date | Wed, 11 Apr 2018 18:46:58 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! { dg-do run } ! ! Passing TYPE to CLASS ! implicit none type t integer :: A real, allocatable :: B(:) end type t type(t), allocatable :: x(:) type(t) :: y(10) integer :: i allocate(x(10)) if (size (x) /= 10) call abort () x = [(t(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 end do y = x ! TODO: Segfaults in runtime without 'y' being set call class(x) call classExplicit(x, size(x)) call class(y) call classExplicit(y, size(y)) contains subroutine class(z) class(t), intent(in) :: z(:) select type(z) type is(t) 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 end do class default call abort() end select end subroutine class subroutine classExplicit(u, n) integer, intent(in) :: n class(t), intent(in) :: u(n) select type(u) type is(t) 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 end do class default call abort() end select end subroutine classExplicit end