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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_scalar_4.f90] - Blame information for rev 858

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


! { dg-do run }
!
! PR fortran/41872
!
!
program test
  implicit none
  integer, allocatable :: a
  integer, allocatable :: b
  allocate(a)
  call foo(a)
  if(.not. allocated(a)) call abort()
  if (a /= 5) call abort()
 
  call bar(a)
  if (a /= 7) call abort()
 
  deallocate(a)
  if(allocated(a)) call abort()
  call check3(a)
  if(.not. allocated(a)) call abort()
  if(a /= 6874) call abort()
  call check4(a)
  if(.not. allocated(a)) call abort()
  if(a /= -478) call abort()
 
  allocate(b)
  b = 7482
  call checkOptional(.false.,.true., 7482)
  if (b /= 7482) call abort()
  call checkOptional(.true., .true., 7482, b)
  if (b /= 46) call abort()
contains
  subroutine foo(a)
    integer, allocatable, intent(out)  :: a
    if(allocated(a)) call abort()
    allocate(a)
    a = 5
  end subroutine foo
 
  subroutine bar(a)
    integer, allocatable, intent(inout)  :: a
    if(.not. allocated(a)) call abort()
    if (a /= 5) call abort()
    a = 7
  end subroutine bar
 
  subroutine check3(a)
    integer, allocatable, intent(inout)  :: a
    if(allocated(a)) call abort()
    allocate(a)
    a = 6874
  end subroutine check3
 
  subroutine check4(a)
    integer, allocatable, intent(inout)  :: a
    if(.not.allocated(a)) call abort()
    if (a /= 6874) call abort
    deallocate(a)
    if(allocated(a)) call abort()
    allocate(a)
    if(.not.allocated(a)) call abort()
    a = -478
  end subroutine check4
 
  subroutine checkOptional(prsnt, alloc, val, x)
    logical, intent(in) :: prsnt, alloc
    integer, allocatable, optional :: x
    integer, intent(in) :: val
    if (present(x) .neqv. prsnt) call abort()
    if (present(x)) then
      if (allocated(x) .neqv. alloc) call abort()
    end if
    if (present(x)) then
      if (allocated(x)) then
        if (x /= val) call abort()
      end if
    end if
    call checkOptional2(x)
    if (present(x)) then
      if (.not. allocated(x)) call abort()
      if (x /= -6784) call abort()
      x = 46
    end if
    call checkOptional2()
  end subroutine checkOptional
  subroutine checkOptional2(x)
    integer, allocatable, optional, intent(out) :: x
    if (present(x)) then
      if (allocated(x)) call abort()
      allocate(x)
      x = -6784
    end if
  end subroutine checkOptional2
end program test

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! PR fortran/41872`
4			`!`
5			`!`
6			`program test`
7			`implicit none`
8			`integer, allocatable :: a`
9			`integer, allocatable :: b`
10			`allocate(a)`
11			`call foo(a)`
12			`if(.not. allocated(a)) call abort()`
13			`if (a /= 5) call abort()`
14
15			`call bar(a)`
16			`if (a /= 7) call abort()`
17
18			`deallocate(a)`
19			`if(allocated(a)) call abort()`
20			`call check3(a)`
21			`if(.not. allocated(a)) call abort()`
22			`if(a /= 6874) call abort()`
23			`call check4(a)`
24			`if(.not. allocated(a)) call abort()`
25			`if(a /= -478) call abort()`
26
27			`allocate(b)`
28			`b = 7482`
29			`call checkOptional(.false.,.true., 7482)`
30			`if (b /= 7482) call abort()`
31			`call checkOptional(.true., .true., 7482, b)`
32			`if (b /= 46) call abort()`
33			`contains`
34			`subroutine foo(a)`
35			`integer, allocatable, intent(out) :: a`
36			`if(allocated(a)) call abort()`
37			`allocate(a)`
38			`a = 5`
39			`end subroutine foo`
40
41			`subroutine bar(a)`
42			`integer, allocatable, intent(inout) :: a`
43			`if(.not. allocated(a)) call abort()`
44			`if (a /= 5) call abort()`
45			`a = 7`
46			`end subroutine bar`
47
48			`subroutine check3(a)`
49			`integer, allocatable, intent(inout) :: a`
50			`if(allocated(a)) call abort()`
51			`allocate(a)`
52			`a = 6874`
53			`end subroutine check3`
54
55			`subroutine check4(a)`
56			`integer, allocatable, intent(inout) :: a`
57			`if(.not.allocated(a)) call abort()`
58			`if (a /= 6874) call abort`
59			`deallocate(a)`
60			`if(allocated(a)) call abort()`
61			`allocate(a)`
62			`if(.not.allocated(a)) call abort()`
63			`a = -478`
64			`end subroutine check4`
65
66			`subroutine checkOptional(prsnt, alloc, val, x)`
67			`logical, intent(in) :: prsnt, alloc`
68			`integer, allocatable, optional :: x`
69			`integer, intent(in) :: val`
70			`if (present(x) .neqv. prsnt) call abort()`
71			`if (present(x)) then`
72			`if (allocated(x) .neqv. alloc) call abort()`
73			`end if`
74			`if (present(x)) then`
75			`if (allocated(x)) then`
76			`if (x /= val) call abort()`
77			`end if`
78			`end if`
79			`call checkOptional2(x)`
80			`if (present(x)) then`
81			`if (.not. allocated(x)) call abort()`
82			`if (x /= -6784) call abort()`
83			`x = 46`
84			`end if`
85			`call checkOptional2()`
86			`end subroutine checkOptional`
87			`subroutine checkOptional2(x)`
88			`integer, allocatable, optional, intent(out) :: x`
89			`if (present(x)) then`
90			`if (allocated(x)) call abort()`
91			`allocate(x)`
92			`x = -6784`
93			`end if`
94			`end subroutine checkOptional2`
95			`end program test`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_scalar_4.f90] - Blame information for rev 858