URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_scalar_5.f90] - Blame information for rev 437

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


! { dg-do run }
! { dg-options "-Wall -pedantic" }
!
! PR fortran/41872
!
!  More tests for allocatable scalars
!
program test
  implicit none
  integer, allocatable :: a
  integer :: b
 
  if (allocated (a)) call abort ()
  if (allocated (func (.false.))) call abort ()
  if (.not.allocated (func (.true.))) call abort ()
  b = 7
  b = func(.true.)
  if (b /= 5332) call abort ()
  b = 7
  b = func(.true.) + 1
  if (b /= 5333) call abort ()
 
  call intout (a, .false.)
  if (allocated (a)) call abort ()
  call intout (a, .true.)
  if (.not.allocated (a)) call abort ()
  if (a /= 764) call abort ()
  call intout2 (a)
  if (allocated (a)) call abort ()
 
  if (allocated (func2 ())) call abort ()
contains
 
  function func (alloc)
    integer, allocatable ::  func
    logical :: alloc
    if (allocated (func)) call abort ()
    if (alloc) then
      allocate(func)
      func = 5332
    end if
  end function func
 
  function func2 ()
    integer, allocatable ::  func2
  end function func2
 
  subroutine intout (dum, alloc)
    implicit none
    integer, allocatable,intent(out) :: dum
    logical :: alloc
    if (allocated (dum)) call abort()
    if (alloc) then
      allocate (dum)
      dum = 764
    end if
  end subroutine intout
 
  subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
    integer, allocatable,intent(out) :: dum
  end subroutine intout2
end program test

Line No.	Rev	Author	Line
1	302	jeremybenn	`! { dg-do run }`
2			`! { dg-options "-Wall -pedantic" }`
3			`!`
4			`! PR fortran/41872`
5			`!`
6			`! More tests for allocatable scalars`
7			`!`
8			`program test`
9			`implicit none`
10			`integer, allocatable :: a`
11			`integer :: b`
12
13			`if (allocated (a)) call abort ()`
14			`if (allocated (func (.false.))) call abort ()`
15			`if (.not.allocated (func (.true.))) call abort ()`
16			`b = 7`
17			`b = func(.true.)`
18			`if (b /= 5332) call abort ()`
19			`b = 7`
20			`b = func(.true.) + 1`
21			`if (b /= 5333) call abort ()`
22
23			`call intout (a, .false.)`
24			`if (allocated (a)) call abort ()`
25			`call intout (a, .true.)`
26			`if (.not.allocated (a)) call abort ()`
27			`if (a /= 764) call abort ()`
28			`call intout2 (a)`
29			`if (allocated (a)) call abort ()`
30
31			`if (allocated (func2 ())) call abort ()`
32			`contains`
33
34			`function func (alloc)`
35			`integer, allocatable :: func`
36			`logical :: alloc`
37			`if (allocated (func)) call abort ()`
38			`if (alloc) then`
39			`allocate(func)`
40			`func = 5332`
41			`end if`
42			`end function func`
43
44			`function func2 ()`
45			`integer, allocatable :: func2`
46			`end function func2`
47
48			`subroutine intout (dum, alloc)`
49			`implicit none`
50			`integer, allocatable,intent(out) :: dum`
51			`logical :: alloc`
52			`if (allocated (dum)) call abort()`
53			`if (alloc) then`
54			`allocate (dum)`
55			`dum = 764`
56			`end if`
57			`end subroutine intout`
58
59			`subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }`
60			`integer, allocatable,intent(out) :: dum`
61			`end subroutine intout2`
62			`end program test`

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_scalar_5.f90] - Blame information for rev 437