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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [interface_10.f90] - Blame information for rev 841

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

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do compile }
2
! PR fortran/30683
3
! Code contributed by Salvatore Filippone.
4
!
5
module class_fld
6
   integer, parameter :: int_ = 1
7
  integer, parameter :: bnd_ = 2
8
  type fld
9
     integer                 :: size(2)
10
  end type fld
11
  !
12
  !  This interface is renaming the SIZE intrinsic procedure,
13
  !  which led to a segmentation fault when trying to resolve
14
  !  the intrinsic symbol name.
15
  !
16
  interface size
17
     module procedure get_fld_size
18
  end interface
19
contains
20
  function get_fld_size(f)
21
    integer :: get_fld_size(2)
22
    type(fld), intent(in) :: f
23
    get_fld_size(int_) = f%size(int_)
24
    get_fld_size(bnd_) = f%size(bnd_)
25
  end function get_fld_size
26
end module class_fld
27
 
28
module class_s_fld
29
  use class_fld
30
  type s_fld
31
     type(fld) :: base
32
     real(kind(1.d0)), pointer :: x(:)  => null()
33
  end type s_fld
34
  interface x_
35
     module procedure get_s_fld_x
36
  end interface
37
contains
38
  function get_s_fld_x(fld)
39
    real(kind(1.d0)), pointer :: get_s_fld_x(:)
40
    type(s_fld), intent(in) :: fld
41
    get_s_fld_x => fld%x
42
  end function get_s_fld_x
43
end module class_s_fld
44
 
45
module class_s_foo
46
contains
47
  subroutine solve_s_foo(phi,var)
48
    use class_s_fld
49
    type(s_fld), intent(inout) :: phi
50
    real(kind(1.d0)), intent(out), optional :: var
51
    integer :: nsz
52
    real(kind(1.d0)), pointer :: x(:)
53
    x => x_(phi)
54
    nsz=size(x)
55
  end subroutine solve_s_foo
56
end module class_s_foo
57
! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }

powered by: WebSVN 2.1.0

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