1! { dg-do compile }
2! { dg-options "-fcoarray=lib -fdump-tree-original" }
3!
4! Check whether TOKEN and OFFSET are correctly propagated
5!
6
7program main
8  implicit none
9  type t
10    integer(4) :: a, b
11  end type t
12  integer :: caf[*]
13  type(t) :: caf_dt[*]
14
15  caf = 42
16  caf_dt = t (1,2)
17  call sub (caf, caf_dt%b)
18  print *,caf, caf_dt%b
19  if (caf /= -99 .or. caf_dt%b /= -101) call abort ()
20  call sub_opt ()
21  call sub_opt (caf)
22  if (caf /= 124) call abort ()
23contains
24
25  subroutine sub (x1, x2)
26    integer :: x1[*], x2[*]
27
28    call sub2 (x1, x2)
29  end subroutine sub
30
31  subroutine sub2 (y1, y2)
32    integer :: y1[*], y2[*]
33
34    print *, y1, y2
35    if (y1 /= 42 .or. y2 /= 2) call abort ()
36    y1 = -99
37    y2 = -101
38  end subroutine sub2
39
40  subroutine sub_opt (z)
41    integer, optional :: z[*]
42    if (present (z)) then
43      if (z /= -99) call abort ()
44      z = 124
45    end if
46  end subroutine sub_opt
47
48end program main
49
50! SCAN TREE DUMP AND CLEANUP
51!
52! PROTOTYPE 1:
53!
54! sub (integer(kind=4) * restrict x1, integer(kind=4) * restrict x2,
55!      void * restrict caf_token.4, integer(kind=8) caf_offset.5,
56!      void * restrict caf_token.6, integer(kind=8) caf_offset.7)
57!
58! { 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" } }
59!
60! PROTOTYPE 2:
61!
62! sub2 (integer(kind=4) * restrict y1, integer(kind=4) * restrict y2,
63!       void * restrict caf_token.0, integer(kind=8) caf_offset.1,
64!       void * restrict caf_token.2, integer(kind=8) caf_offset.3)
65!
66! { 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" } }
67!
68! CALL 1
69!
70!  sub ((integer(kind=4) *) caf, &caf_dt->b, caf_token.9, 0, caf_token.10, 4);
71!
72! { dg-final { scan-tree-dump-times "sub \\(\[^,\]*caf, &caf_dt->b, caf_token.\[0-9\]+, 0, caf_token.\[0-9\]+, 4\\)" 1 "original" } }
73!
74!  sub2 ((integer(kind=4) *) x1, (integer(kind=4) *) x2,
75!        caf_token.4, NON_LVALUE_EXPR <caf_offset.5>,
76!        caf_token.6, NON_LVALUE_EXPR <caf_offset.7>);
77!
78! { dg-final { scan-tree-dump-times "sub2 \\(\[^,\]*x1, \[^,\]*x2, caf_token.\[0-9]+, \[^,\]*caf_offset\[^,\]*, caf_token.\[0-9\]+, \[^,\]*caf_offset\[^,\]*\\)" 1 "original" } }
79!
80! CALL 3
81!
82! { dg-final { scan-tree-dump-times "sub_opt \\(0B, 0B, 0\\)" 1 "original" } }
83!
84! CALL 4
85!
86! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf, caf_token.\[0-9\]+, 0\\)" 1 "original" } }
87!
88! { dg-final { cleanup-tree-dump "original" } }
89