gcc/testsuite/gfortran.dg/generic_24.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/48889
   4 !
   5 ! Thanks for
   6 ! reporting to Lawrence Mitchell
   7 ! for the test case to David Ham
   8 !
   9 module sparse_tools
  10   implicit none
  11   private
  12
  13   type csr_foo
  14      integer, dimension(:), pointer :: colm=>null()
  15   end type csr_foo
  16
  17   type block_csr_matrix
  18      type(csr_foo) :: sparsity
  19   end type block_csr_matrix
  20
  21   interface attach_block
  22      module procedure block_csr_attach_block
  23   end interface
  24
  25   interface size
  26      module procedure  sparsity_size
  27   end interface
  28
  29   public :: size, attach_block
  30 contains
  31   subroutine block_csr_attach_block(matrix, val)
  32     type(block_csr_matrix), intent(inout) :: matrix
  33     real, dimension(size(matrix%sparsity%colm)), intent(in), target :: val
  34   end subroutine block_csr_attach_block
  35
  36   pure function sparsity_size(sparsity, dim)
  37     integer :: sparsity_size
  38     type(csr_foo), intent(in) :: sparsity
  39     integer, optional, intent(in) :: dim
  40   end function sparsity_size
  41 end module sparse_tools
  42
  43 module global_numbering
  44   use sparse_tools
  45   implicit none
  46
  47   type ele_numbering_type
  48      integer :: boundaries
  49   end type ele_numbering_type
  50
  51   type element_type
  52      integer :: loc
  53      type(ele_numbering_type), pointer :: numbering=>null()
  54   end type element_type
  55
  56   type csr_sparsity
  57   end type csr_sparsity
  58
  59   interface size
  60      module procedure sparsity_size
  61   end interface size
  62 contains
  63   pure function sparsity_size(sparsity, dim)
  64     integer :: sparsity_size
  65     type(csr_sparsity), intent(in) :: sparsity
  66     integer, optional, intent(in) :: dim
  67   end function sparsity_size
  68
  69   subroutine make_boundary_numbering(EEList, xndglno, ele_n)
  70     type(csr_sparsity), intent(in) :: EEList
  71     type(element_type), intent(in) :: ele_n
  72     integer, dimension(size(EEList,1)*ele_n%loc), intent(in), target ::&
  73          & xndglno
  74     integer, dimension(ele_n%numbering%boundaries) :: neigh
  75     integer :: j
  76     j=size(neigh)
  77   end subroutine make_boundary_numbering
  78 end module global_numbering
  79
  80 module sparse_matrices_fields
  81   use sparse_tools
  82 implicit none
  83    type scalar_field
  84       real, dimension(:), pointer :: val
  85    end type scalar_field
  86 contains
  87   subroutine csr_mult_T_scalar(x)
  88     type(scalar_field), intent(inout) :: x
  89     real, dimension(:), allocatable :: tmp
  90     integer :: i
  91     i=size(x%val)
  92   end subroutine csr_mult_T_scalar
  93 end module sparse_matrices_fields
  94
  95 program test
  96   use sparse_matrices_fields
  97   use global_numbering
  98 end program test