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

Subversion Repositories openrisc

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

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


! { dg-do run }
!
! PR fortran/39427
!
module foo_module
  interface foo
    procedure constructor
  end interface
 
  type foo
    integer :: bar
  end type
contains
  type(foo) function constructor()
    constructor%bar = 1
  end function
 
  subroutine test_foo()
    type(foo) :: f
    f = foo()
    if (f%bar /= 1) call abort ()
    f = foo(2)
    if (f%bar /= 2) call abort ()
  end subroutine test_foo
end module foo_module
 
 
! Same as foo_module but order
! of INTERFACE and TYPE reversed
module bar_module
  type bar
    integer :: bar
  end type
 
  interface bar
    procedure constructor
  end interface
contains
  type(bar) function constructor()
    constructor%bar = 3
  end function
 
  subroutine test_bar()
    type(bar) :: f
    f = bar()
    if (f%bar /= 3) call abort ()
    f = bar(4)
    if (f%bar /= 4) call abort ()
  end subroutine test_bar
end module bar_module
 
program main
  use foo_module
  use bar_module
  implicit none
 
  type(foo) :: f
  type(bar) :: b
 
  call test_foo()
  f = foo()
  if (f%bar /= 1) call abort ()
  f = foo(2)
  if (f%bar /= 2) call abort ()
 
  call test_bar()
  b = bar()
  if (b%bar /= 3) call abort ()
  b = bar(4)
  if (b%bar /= 4) call abort ()
end program main
 
! { dg-final { cleanup-tree-dump "foo_module bar_module" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! PR fortran/39427`
4			`!`
5			`module foo_module`
6			`interface foo`
7			`procedure constructor`
8			`end interface`
9
10			`type foo`
11			`integer :: bar`
12			`end type`
13			`contains`
14			`type(foo) function constructor()`
15			`constructor%bar = 1`
16			`end function`
17
18			`subroutine test_foo()`
19			`type(foo) :: f`
20			`f = foo()`
21			`if (f%bar /= 1) call abort ()`
22			`f = foo(2)`
23			`if (f%bar /= 2) call abort ()`
24			`end subroutine test_foo`
25			`end module foo_module`
26
27
28			`! Same as foo_module but order`
29			`! of INTERFACE and TYPE reversed`
30			`module bar_module`
31			`type bar`
32			`integer :: bar`
33			`end type`
34
35			`interface bar`
36			`procedure constructor`
37			`end interface`
38			`contains`
39			`type(bar) function constructor()`
40			`constructor%bar = 3`
41			`end function`
42
43			`subroutine test_bar()`
44			`type(bar) :: f`
45			`f = bar()`
46			`if (f%bar /= 3) call abort ()`
47			`f = bar(4)`
48			`if (f%bar /= 4) call abort ()`
49			`end subroutine test_bar`
50			`end module bar_module`
51
52			`program main`
53			`use foo_module`
54			`use bar_module`
55			`implicit none`
56
57			`type(foo) :: f`
58			`type(bar) :: b`
59
60			`call test_foo()`
61			`f = foo()`
62			`if (f%bar /= 1) call abort ()`
63			`f = foo(2)`
64			`if (f%bar /= 2) call abort ()`
65
66			`call test_bar()`
67			`b = bar()`
68			`if (b%bar /= 3) call abort ()`
69			`b = bar(4)`
70			`if (b%bar /= 4) call abort ()`
71			`end program main`
72
73			`! { dg-final { cleanup-tree-dump "foo_module bar_module" } }`

Browse

Tools

Subversion Repositories openrisc

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