1! { dg-do compile }
2!
3! PR fortran/56969
4!
5! Contributed by Salvatore Filippone
6!
7! Was before rejected as the different c_associated weren't recognized to
8! come from the same module.
9!
10module test_mod
11  use iso_c_binding
12
13  type(c_ptr), save :: test_context = c_null_ptr
14
15  type, bind(c) :: s_Cmat
16    type(c_ptr) :: Mat = c_null_ptr
17  end type s_Cmat
18
19
20  interface
21    function FtestCreate(context) &
22         & bind(c,name="FtestCreate") result(res)
23      use iso_c_binding
24      type(c_ptr)    :: context
25      integer(c_int) :: res
26    end function FtestCreate
27  end interface
28contains
29
30  function initFtest() result(res)
31    implicit none
32    integer(c_int) :: res
33    if (c_associated(test_context)) then
34      res = 0
35    else
36      res = FtestCreate(test_context)
37    end if
38  end function initFtest
39end module test_mod
40
41module base_mat_mod
42  type base_sparse_mat
43    integer, allocatable :: ia(:)
44  end type base_sparse_mat
45end module base_mat_mod
46
47module extd_mat_mod
48
49  use iso_c_binding
50  use test_mod
51  use base_mat_mod
52
53  type, extends(base_sparse_mat) :: extd_sparse_mat
54    type(s_Cmat) :: deviceMat
55  end type extd_sparse_mat
56
57end module extd_mat_mod
58
59subroutine extd_foo(a)
60
61  use extd_mat_mod
62  implicit none
63  class(extd_sparse_mat), intent(inout) :: a
64
65  if (c_associated(a%deviceMat%Mat)) then
66    write(*,*) 'C Associated'
67  end if
68
69end subroutine extd_foo
70