1! { dg-do compile }
2! { dg-options "-fcoarray=lib -fdump-tree-original" }
3!
4! Check whether TOKEN and OFFSET are correctly propagated
5!
6
7! THIS PART FAILED (ICE) DUE TO TYPE SHARING
8
9module matrix_data
10   implicit none
11   type sparse_CSR_matrix
12      integer, allocatable :: a(:)
13   end type sparse_CSR_matrix
14CONTAINS
15
16subroutine build_CSR_matrix(CSR)
17   type(sparse_CSR_matrix), intent(out) :: CSR
18   integer, allocatable :: CAF_begin[:]
19   call global_to_local_index(CAF_begin)
20end subroutine build_CSR_matrix
21
22subroutine global_to_local_index(CAF_begin)
23   integer, intent(out) :: CAF_begin[*]
24end subroutine  global_to_local_index
25
26end module matrix_data
27
28
29! DUMP TESTING
30
31program main
32  implicit none
33  type t
34    integer(4) :: a, b
35  end type t
36  integer, allocatable :: caf[:]
37  type(t), allocatable :: caf_dt[:]
38
39  allocate (caf[*])
40  allocate (caf_dt[*])
41
42  caf = 42
43  caf_dt = t (1,2)
44  call sub (caf, caf_dt%b)
45  print *,caf, caf_dt%b
46  if (caf /= -99 .or. caf_dt%b /= -101) STOP 1
47  call sub_opt ()
48  call sub_opt (caf)
49  if (caf /= 124) STOP 2
50contains
51
52  subroutine sub (x1, x2)
53    integer :: x1[*], x2[*]
54    call sub2 (x1, x2)
55  end subroutine sub
56
57  subroutine sub2 (y1, y2)
58    integer :: y1[*], y2[*]
59
60    print *, y1, y2
61    if (y1 /= 42 .or. y2 /= 2) STOP 3
62    y1 = -99
63    y2 = -101
64  end subroutine sub2
65
66  subroutine sub_opt (z)
67    integer, optional :: z[*]
68    if (present (z)) then
69      if (z /= -99) STOP 4
70      z = 124
71    end if
72  end subroutine sub_opt
73
74end program main
75
76! SCAN TREE DUMP AND CLEANUP
77!
78! PROTOTYPE 1:
79!
80! sub (integer(kind=4) * restrict x1, integer(kind=4) * restrict x2,
81!      void * restrict caf_token.4, integer(kind=8) caf_offset.5,
82!      void * restrict caf_token.6, integer(kind=8) caf_offset.7)
83!
84! { dg-final { scan-tree-dump-times "sub \\(integer.kind=4. . restrict x1, integer.kind=4. . restrict x2, void . restrict caf_token.\[0-9\]+, integer.kind=.. caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer.kind=.. caf_offset.\[0-9\]+\\)" 1 "original" } }
85!
86! PROTOTYPE 2:
87!
88! sub2 (integer(kind=4) * restrict y1, integer(kind=4) * restrict y2,
89!       void * restrict caf_token.0, integer(kind=8) caf_offset.1,
90!       void * restrict caf_token.2, integer(kind=8) caf_offset.3)
91!
92! { dg-final { scan-tree-dump-times "sub2 \\(integer.kind=4. . restrict y1, integer.kind=4. . restrict y2, void . restrict caf_token.\[0-9\]+, integer.kind=.. caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer.kind=.. caf_offset.\[0-9\]+\\)" 1 "original" } }
93!
94! CALL 1
95!
96!  sub ((integer(kind=4) *) caf.data, &((struct t * restrict) caf_dt.data)->b,
97!       caf.token, 0, caf_dt.token, 4);
98!
99! { dg-final { scan-tree-dump-times "sub \\(\[^,\]*caf.data, &\[^,\]*caf_dt.data.->b, caf.token, 0, caf_dt.token, 4\\)" 1 "original" } }
100!
101!  sub2 ((integer(kind=4) *) x1, (integer(kind=4) *) x2,
102!        caf_token.4, NON_LVALUE_EXPR <caf_offset.5>,
103!        caf_token.6, NON_LVALUE_EXPR <caf_offset.7>);
104!
105! { dg-final { scan-tree-dump-times "sub2 \\(\[^,\]*x1, \[^,\]*x2, caf_token.\[0-9]+, \[^,\]*caf_offset\[^,\]*, caf_token.\[0-9\]+, \[^,\]*caf_offset\[^,\]*\\)" 1 "original" } }
106!
107! CALL 3
108!
109! { dg-final { scan-tree-dump-times "sub_opt \\(0B, 0B, 0\\)" 1 "original" } }
110!
111! CALL 4
112!
113! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf.data, caf.token, 0\\)" 1 "original" } }
114!
115