gcc/testsuite/gfortran.dg/coarray_lib_token_1.f90

   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 program 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) STOP 1
  20   call sub_opt ()
  21   call sub_opt (caf)
  22   if (caf /= 124) STOP 2
  23 contains
  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) STOP 3
  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) STOP 4
  44       z = 124
  45     end if
  46   end subroutine sub_opt
  47
  48 end 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 !