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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [coarray/] [poly_run_2.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
!
3
! Test for polymorphic coarrays
4
!
5
type t
6
end type t
7
class(t), allocatable :: A[:,:]
8
allocate (A[1:4,-5:*])
9
if (allocated(A)) stop
10
if (any (lcobound(A) /= [1, -5])) call abort ()
11
if (num_images() == 1) then
12
  if (any (ucobound(A) /= [4, -5])) call abort ()
13
else
14
  if (ucobound(A,dim=1) /= 4) call abort ()
15
end if
16
if (allocated(A)) i = 5
17
call s(A)
18
call st(A)
19
contains
20
subroutine s(x)
21
  class(t) :: x[4,2:*]
22
  if (any (lcobound(x) /= [1, 2])) call abort ()
23
  if (num_images() == 1) then
24
    if (any (ucobound(x) /= [4, 2])) call abort ()
25
  else
26
    if (ucobound(x,dim=1) /= 4) call abort ()
27
  end if
28
end subroutine s
29
subroutine st(x)
30
  class(t) :: x[:,:]
31
  if (any (lcobound(x) /= [1, -5])) call abort ()
32
  if (num_images() == 1) then
33
    if (any (ucobound(x) /= [4, -5])) call abort ()
34
  else
35
    if (ucobound(x,dim=1) /= 4) call abort ()
36
  end if
37
end subroutine st
38
end
39
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.