1! { dg-do compile }
2! Verify that initialization of c_ptr components works.  This is based on 
3! code from fgsl: 
4! http://www.lrz-muenchen.de/services/software/mathematik/gsl/fortran/
5! and tests PR 33395.
6module fgsl
7  use, intrinsic :: iso_c_binding
8  implicit none
9!
10!
11! Kind and length parameters are default integer
12!
13  integer, parameter, public :: fgsl_double = c_double
14
15!
16! Types : Array support
17!
18  type, public :: fgsl_vector
19     private
20     type(c_ptr) :: gsl_vector = c_null_ptr
21  end type fgsl_vector
22
23contains
24  function fgsl_vector_align(p_x, f_x)
25    real(fgsl_double), pointer :: p_x(:)
26    type(fgsl_vector) :: f_x
27    integer :: fgsl_vector_align
28    fgsl_vector_align = 4
29  end function fgsl_vector_align
30end module fgsl
31
32module tmod
33  use fgsl
34  implicit none
35contains
36  subroutine expb_df() bind(c)
37    type(fgsl_vector) :: f_x
38    real(fgsl_double), pointer :: p_x(:)
39    integer :: status
40    status = fgsl_vector_align(p_x, f_x)
41  end subroutine expb_df
42end module tmod
43