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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [coarray/] [scalar_alloc_1.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
implicit none
4
integer, allocatable :: A[:], B[:,:]
5
integer :: n1, n2, n3
6
 
7
if (allocated (a)) call abort ()
8
if (allocated (b)) call abort ()
9
 
10
allocate(a[*])
11
a = 5 + this_image ()
12
if (a[this_image ()] /= 5 + this_image ()) call abort
13
 
14
a[this_image ()] = 8 - 2*this_image ()
15
if (a[this_image ()] /= 8 - 2*this_image ()) call abort
16
 
17
if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
18
  call abort ()
19
deallocate(a)
20
 
21
allocate(a[4:*])
22
a[this_image ()] = 8 - 2*this_image ()
23
 
24
if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
25
  call abort ()
26
 
27
n1 = -1
28
n2 = 5
29
n3 = 3
30
allocate (B[n1:n2, n3:*])
31
if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
32
  call abort()
33
call sub(A, B)
34
 
35
if (allocated (a)) call abort ()
36
if (.not.allocated (b)) call abort ()
37
 
38
call two(.true.)
39
call two(.false.)
40
 
41
! automatically deallocate "B"
42
contains
43
  subroutine sub(x, y)
44
    integer, allocatable :: x[:], y[:,:]
45
 
46
    if (any (lcobound(y) /= [-1, 3]) .or. lcobound(y, dim=2) /= n3) &
47
      call abort()
48
    if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
49
      call abort ()
50
    if (x[this_image ()] /= 8 - 2*this_image ()) call abort
51
    deallocate(x)
52
  end subroutine sub
53
 
54
  subroutine two(init)
55
    logical, intent(in) :: init
56
    integer, allocatable, SAVE :: a[:]
57
 
58
    if (init) then
59
      if (allocated(a)) call abort()
60
      allocate(a[*])
61
      a = 45
62
   else
63
      if (.not. allocated(a)) call abort()
64
      if (a /= 45) call abort()
65
      deallocate(a)
66
    end if
67
  end subroutine two
68
end

powered by: WebSVN 2.1.0

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