gcc/testsuite/gfortran.dg/bind-c-contiguous-1.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources bind-c-contiguous-1.c }
   3 ! { dg-additional-options "-fcheck=all" }
   4 ! { dg-additional-options -Wno-complain-wrong-lang }
   5
   6 ! Fortran demands that with bind(C), the callee ensure that for
   7 ! * 'contiguous'
   8 ! * len=* with explicit/assumed-size arrays
   9 ! noncontiguous actual arguments are handled.
  10 ! (in without bind(C) in gfortran, caller handles the copy in/out
  11
  12 ! Additionally, for a bind(C) callee, a Fortran-written caller
  13 ! has to ensure the same (for contiguous + len=* to explicit-/assumed-size arrays)
  14
  15 module m
  16   use iso_c_binding, only: c_intptr_t, c_bool, c_loc, c_int
  17   implicit none (type, external)
  18
  19   type, bind(C) :: loc_t
  20     integer(c_intptr_t) :: x, y, z
  21   end type loc_t
  22
  23 interface
  24   type(loc_t) function char_assumed_size_c (xx, yy, zz, n, num) bind(C)
  25     import :: loc_t, c_bool, c_int
  26     integer(c_int), value :: n, num
  27     character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*)
  28   end function
  29
  30   type(loc_t) function char_assumed_size_in_c (xx, yy, zz, n, num) bind(C)
  31     import :: loc_t, c_bool, c_int
  32     integer(c_int), value :: n, num
  33     character(len=*), intent(in) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*)
  34   end function
  35
  36   type(loc_t) function char_expl_size_c (xx, yy, zz, n, num) bind(c)
  37     import :: loc_t, c_bool, c_int
  38     integer(c_int), value :: n, num
  39     character(len=*) :: xx(n), yy(n:n+3), zz(6:6, 3:n, 3:n+3)
  40   end function
  41
  42   type(loc_t) function char_expl_size_in_c (xx, yy, zz, n, num) bind(c)
  43     import :: loc_t, c_bool, c_int
  44     integer(c_int), value :: n, num
  45     character(len=*), intent(in) :: xx(n), yy(n:n+3), zz(6:6, 3:n, 3:n+3)
  46   end function
  47
  48   type(loc_t) function char_assumed_rank_c (xx, yy, zz, k, num) bind(c)
  49     import :: loc_t, c_bool, c_int
  50     integer, value :: k, num
  51     character(len=*) :: xx(..)
  52     character(len=3) :: yy(..)
  53     character(len=k) :: zz(..)
  54   end function
  55
  56   type(loc_t) function char_assumed_rank_in_c (xx, yy, zz, k, num) bind(c)
  57     import :: loc_t, c_bool, c_int
  58     integer, value :: k, num
  59     character(len=*), intent(in) :: xx(..)
  60     character(len=3), intent(in) :: yy(..)
  61     character(len=k), intent(in) :: zz(..)
  62   end function
  63
  64   type(loc_t) function char_assumed_rank_cont_c (xx, yy, zz, k, num) bind(c)
  65     import :: loc_t, c_bool, c_int
  66     integer, value :: k, num
  67     character(len=*), contiguous :: xx(..)
  68     character(len=3), contiguous :: yy(..)
  69     character(len=k), contiguous :: zz(..)
  70   end function
  71
  72   type(loc_t) function char_assumed_rank_cont_in_c (xx, yy, zz, k, num) bind(c)
  73     import :: loc_t, c_bool, c_int
  74     integer, value :: k, num
  75     character(len=*), contiguous, intent(in) :: xx(..)
  76     character(len=3), contiguous, intent(in) :: yy(..)
  77     character(len=k), contiguous, intent(in) :: zz(..)
  78   end function
  79
  80   type(loc_t) function char_assumed_shape_c (xx, yy, zz, k, num) bind(c)
  81     import :: loc_t, c_bool, c_int
  82     integer, value :: k, num
  83     character(len=*) :: xx(:)
  84     character(len=3) :: yy(5:)
  85     character(len=k) :: zz(-k:)
  86   end function
  87
  88   type(loc_t) function char_assumed_shape_in_c (xx, yy, zz, k, num) bind(c)
  89     import :: loc_t, c_bool, c_int
  90     integer, value :: k, num
  91     character(len=*), intent(in) :: xx(:)
  92     character(len=3), intent(in) :: yy(5:)
  93     character(len=k), intent(in) :: zz(-k:)
  94   end function
  95
  96   type(loc_t) function char_assumed_shape_cont_c (xx, yy, zz, k, num) bind(c)
  97     import :: loc_t, c_bool, c_int
  98     integer, value :: k, num
  99     character(len=*), contiguous :: xx(:)
 100     character(len=3), contiguous :: yy(5:)
 101     character(len=k), contiguous :: zz(-k:)
 102   end function
 103
 104   type(loc_t) function char_assumed_shape_cont_in_c (xx, yy, zz, k, num) bind(c)
 105     import :: loc_t, c_bool, c_int
 106     integer, value :: k, num
 107     character(len=*), contiguous, intent(in) :: xx(:)
 108     character(len=3), contiguous, intent(in) :: yy(5:)
 109     character(len=k), contiguous, intent(in) :: zz(-k:)
 110   end function
 111 end interface
 112
 113 contains
 114
 115 type(loc_t) function char_assumed_size_f (xx, yy, zz, n, num) bind(c) result(res)
 116   integer, value :: num, n
 117   character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*)
 118   print *, xx(1:3)
 119   if (3 /= len(xx)) error stop 1
 120   if (3 /= len(yy)) error stop 1
 121   if (3 /= len(zz)) error stop 1
 122   if (1 /= lbound(xx,dim=1)) error stop 1
 123   if (3 /= lbound(yy,dim=1)) error stop 1
 124   if (6 /= lbound(zz,dim=1)) error stop 1
 125   if (3 /= lbound(zz,dim=2)) error stop 1
 126   if (3 /= lbound(zz,dim=3)) error stop 1
 127   if (1 /= size(zz,dim=1)) error stop 1
 128   if (1 /= size(zz,dim=2)) error stop 1
 129   if (6 /= ubound(zz,dim=1)) error stop 1
 130   if (3 /= ubound(zz,dim=2)) error stop 1
 131   if (num == 1) then
 132     if (xx(1) /= "abc") error stop 2
 133     if (xx(2) /= "ghi") error stop 3
 134     if (xx(3) /= "nop") error stop 4
 135     if (yy(3) /= "abc") error stop 2
 136     if (yy(4) /= "ghi") error stop 3
 137     if (yy(5) /= "nop") error stop 4
 138     if (zz(6,n,3) /= "abc") error stop 2
 139     if (zz(6,n,4) /= "ghi") error stop 3
 140     if (zz(6,n,5) /= "nop") error stop 4
 141   else if (num == 2) then
 142     if (xx(1) /= "def") error stop 2
 143     if (xx(2) /= "ghi") error stop 3
 144     if (xx(3) /= "jlm") error stop 4
 145     if (yy(3) /= "def") error stop 2
 146     if (yy(4) /= "ghi") error stop 3
 147     if (yy(5) /= "jlm") error stop 4
 148     if (zz(6,n,3) /= "def") error stop 2
 149     if (zz(6,n,4) /= "ghi") error stop 3
 150     if (zz(6,n,5) /= "jlm") error stop 4
 151   else
 152     error stop 8
 153   endif
 154   xx(1) = "ABC"
 155   xx(2) = "DEF"
 156   xx(3) = "GHI"
 157   yy(3) = "ABC"
 158   yy(4) = "DEF"
 159   yy(5) = "GHI"
 160   zz(6,n,3) = "ABC"
 161   zz(6,n,4) = "DEF"
 162   zz(6,n,5) = "GHI"
 163   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 164   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 165   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 166 end
 167
 168 type(loc_t) function char_assumed_size_in_f (xx, yy, zz, n, num) bind(c) result(res)
 169   integer, value :: num, n
 170   character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*)
 171   intent(in) :: xx, yy, zz
 172   print *, xx(1:3)
 173   if (3 /= len(xx)) error stop 1
 174   if (3 /= len(yy)) error stop 1
 175   if (3 /= len(zz)) error stop 1
 176   if (1 /= lbound(xx,dim=1)) error stop 1
 177   if (3 /= lbound(yy,dim=1)) error stop 1
 178   if (6 /= lbound(zz,dim=1)) error stop 1
 179   if (3 /= lbound(zz,dim=2)) error stop 1
 180   if (3 /= lbound(zz,dim=3)) error stop 1
 181   if (1 /= size(zz,dim=1)) error stop 1
 182   if (1 /= size(zz,dim=2)) error stop 1
 183   if (6 /= ubound(zz,dim=1)) error stop 1
 184   if (3 /= ubound(zz,dim=2)) error stop 1
 185   if (num == 1) then
 186     if (xx(1) /= "abc") error stop 2
 187     if (xx(2) /= "ghi") error stop 3
 188     if (xx(3) /= "nop") error stop 4
 189     if (yy(3) /= "abc") error stop 2
 190     if (yy(4) /= "ghi") error stop 3
 191     if (yy(5) /= "nop") error stop 4
 192     if (zz(6,n,3) /= "abc") error stop 2
 193     if (zz(6,n,4) /= "ghi") error stop 3
 194     if (zz(6,n,5) /= "nop") error stop 4
 195   else if (num == 2) then
 196     if (xx(1) /= "def") error stop 2
 197     if (xx(2) /= "ghi") error stop 3
 198     if (xx(3) /= "jlm") error stop 4
 199     if (yy(3) /= "def") error stop 2
 200     if (yy(4) /= "ghi") error stop 3
 201     if (yy(5) /= "jlm") error stop 4
 202     if (zz(6,n,3) /= "def") error stop 2
 203     if (zz(6,n,4) /= "ghi") error stop 3
 204     if (zz(6,n,5) /= "jlm") error stop 4
 205   else
 206     error stop 8
 207   endif
 208   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 209   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 210   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }  if (num == 1) then
 211 end
 212
 213 type(loc_t) function char_expl_size_f (xx, yy, zz, n, num) bind(c) result(res)
 214   integer, value :: num, n
 215   character(len=*) :: xx(n), yy(n:n+2), zz(6:6, 3:n, 3:n+2)
 216   print *, xx(1:3)
 217   if (3 /= len(xx)) error stop 1
 218   if (3 /= len(yy)) error stop 1
 219   if (3 /= len(zz)) error stop 1
 220   if (1 /= lbound(xx,dim=1)) error stop 1
 221   if (3 /= lbound(yy,dim=1)) error stop 1
 222   if (6 /= lbound(zz,dim=1)) error stop 1
 223   if (3 /= lbound(zz,dim=2)) error stop 1
 224   if (3 /= lbound(zz,dim=3)) error stop 1
 225   if (3 /= size(xx,dim=1)) error stop 1
 226   if (3 /= size(yy,dim=1)) error stop 1
 227   if (1 /= size(zz,dim=1)) error stop 1
 228   if (1 /= size(zz,dim=2)) error stop 1
 229   if (3 /= size(zz,dim=3)) error stop 1
 230   if (3 /= ubound(xx,dim=1)) error stop 1
 231   if (5 /= ubound(yy,dim=1)) error stop 1
 232   if (6 /= ubound(zz,dim=1)) error stop 1
 233   if (3 /= ubound(zz,dim=2)) error stop 1
 234   if (5 /= ubound(zz,dim=3)) error stop 1
 235   if (num == 1) then
 236     if (xx(1) /= "abc") error stop 2
 237     if (xx(2) /= "ghi") error stop 3
 238     if (xx(3) /= "nop") error stop 4
 239     if (yy(3) /= "abc") error stop 2
 240     if (yy(4) /= "ghi") error stop 3
 241     if (yy(5) /= "nop") error stop 4
 242     if (zz(6,n,3) /= "abc") error stop 2
 243     if (zz(6,n,4) /= "ghi") error stop 3
 244     if (zz(6,n,5) /= "nop") error stop 4
 245   else if (num == 2) then
 246     if (xx(1) /= "def") error stop 2
 247     if (xx(2) /= "ghi") error stop 3
 248     if (xx(3) /= "jlm") error stop 4
 249     if (yy(3) /= "def") error stop 2
 250     if (yy(4) /= "ghi") error stop 3
 251     if (yy(5) /= "jlm") error stop 4
 252     if (zz(6,n,3) /= "def") error stop 2
 253     if (zz(6,n,4) /= "ghi") error stop 3
 254     if (zz(6,n,5) /= "jlm") error stop 4
 255   else
 256     error stop 8
 257   endif
 258   xx(1) = "ABC"
 259   xx(2) = "DEF"
 260   xx(3) = "GHI"
 261   yy(3) = "ABC"
 262   yy(4) = "DEF"
 263   yy(5) = "GHI"
 264   zz(6,n,3) = "ABC"
 265   zz(6,n,4) = "DEF"
 266   zz(6,n,5) = "GHI"
 267   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 268   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 269   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 270 end
 271
 272 type(loc_t) function char_expl_size_in_f (xx, yy, zz, n, num) bind(c) result(res)
 273   integer, value :: num, n
 274   character(len=*) :: xx(n), yy(n:n+2), zz(6:6, 3:n, 3:n+2)
 275   intent(in) :: xx, yy, zz
 276   print *, xx(1:3)
 277   if (3 /= len(xx)) error stop 1
 278   if (3 /= len(yy)) error stop 1
 279   if (3 /= len(zz)) error stop 1
 280   if (1 /= lbound(xx,dim=1)) error stop 1
 281   if (3 /= lbound(yy,dim=1)) error stop 1
 282   if (6 /= lbound(zz,dim=1)) error stop 1
 283   if (3 /= lbound(zz,dim=2)) error stop 1
 284   if (3 /= lbound(zz,dim=3)) error stop 1
 285   if (3 /= size(xx,dim=1)) error stop 1
 286   if (3 /= size(yy,dim=1)) error stop 1
 287   if (1 /= size(zz,dim=1)) error stop 1
 288   if (1 /= size(zz,dim=2)) error stop 1
 289   if (3 /= size(zz,dim=3)) error stop 1
 290   if (3 /= ubound(xx,dim=1)) error stop 1
 291   if (5 /= ubound(yy,dim=1)) error stop 1
 292   if (6 /= ubound(zz,dim=1)) error stop 1
 293   if (3 /= ubound(zz,dim=2)) error stop 1
 294   if (5 /= ubound(zz,dim=3)) error stop 1
 295   if (num == 1) then
 296     if (xx(1) /= "abc") error stop 2
 297     if (xx(2) /= "ghi") error stop 3
 298     if (xx(3) /= "nop") error stop 4
 299     if (yy(3) /= "abc") error stop 2
 300     if (yy(4) /= "ghi") error stop 3
 301     if (yy(5) /= "nop") error stop 4
 302     if (zz(6,n,3) /= "abc") error stop 2
 303     if (zz(6,n,4) /= "ghi") error stop 3
 304     if (zz(6,n,5) /= "nop") error stop 4
 305   else if (num == 2) then
 306     if (xx(1) /= "def") error stop 2
 307     if (xx(2) /= "ghi") error stop 3
 308     if (xx(3) /= "jlm") error stop 4
 309     if (yy(3) /= "def") error stop 2
 310     if (yy(4) /= "ghi") error stop 3
 311     if (yy(5) /= "jlm") error stop 4
 312     if (zz(6,n,3) /= "def") error stop 2
 313     if (zz(6,n,4) /= "ghi") error stop 3
 314     if (zz(6,n,5) /= "jlm") error stop 4
 315   else
 316     error stop 8
 317   endif
 318   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 319   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 320   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 321 end
 322
 323
 324 type(loc_t) function char_assumed_rank_f (xx, yy, zz, k, num) bind(c) result(res)
 325   integer, value :: num, k
 326   character(len=*) :: xx(..)
 327   character(len=3) :: yy(..)
 328   character(len=k) :: zz(..)
 329   if (3 /= len(xx)) error stop 40
 330   if (3 /= len(yy)) error stop 40
 331   if (3 /= len(zz)) error stop 40
 332   if (3 /= size(xx)) error stop 41
 333   if (3 /= size(yy)) error stop 41
 334   if (3 /= size(zz)) error stop 41
 335   if (1 /= rank(xx)) error stop 49
 336   if (1 /= rank(yy)) error stop 49
 337   if (1 /= rank(zz)) error stop 49
 338   if (1 /= lbound(xx, dim=1)) stop 49
 339   if (1 /= lbound(yy, dim=1)) stop 49
 340   if (1 /= lbound(zz, dim=1)) stop 49
 341   if (3 /= ubound(xx, dim=1)) stop 49
 342   if (3 /= ubound(yy, dim=1)) stop 49
 343   if (3 /= ubound(zz, dim=1)) stop 49
 344   if (num == 1) then
 345     if (is_contiguous (xx)) error stop 49
 346     if (is_contiguous (yy)) error stop 49
 347     if (is_contiguous (zz)) error stop 49
 348   else if (num == 2) then
 349     if (.not. is_contiguous (xx)) error stop 49
 350     if (.not. is_contiguous (yy)) error stop 49
 351     if (.not. is_contiguous (zz)) error stop 49
 352   else
 353     error stop 48
 354   end if
 355   select rank (xx)
 356   rank (1)
 357     print *, xx(1:3)
 358     if (num == 1) then
 359       if (xx(1) /= "abc") error stop 42
 360       if (xx(2) /= "ghi") error stop 43
 361       if (xx(3) /= "nop") error stop 44
 362     else if (num == 2) then
 363       if (xx(1) /= "def") error stop 45
 364       if (xx(2) /= "ghi") error stop 46
 365       if (xx(3) /= "jlm") error stop 47
 366     else
 367       error stop 48
 368     endif
 369     xx(1) = "ABC"
 370     xx(2) = "DEF"
 371     xx(3) = "GHI"
 372     res%x = get_loc (xx)
 373   rank default
 374     error stop 99
 375   end select
 376   select rank (yy)
 377   rank (1)
 378     print *, yy(1:3)
 379     if (num == 1) then
 380       if (yy(1) /= "abc") error stop 42
 381       if (yy(2) /= "ghi") error stop 43
 382       if (yy(3) /= "nop") error stop 44
 383     else if (num == 2) then
 384       if (yy(1) /= "def") error stop 45
 385       if (yy(2) /= "ghi") error stop 46
 386       if (yy(3) /= "jlm") error stop 47
 387     else
 388       error stop 48
 389     endif
 390     yy(1) = "ABC"
 391     yy(2) = "DEF"
 392     yy(3) = "GHI"
 393     res%y = get_loc (yy)
 394   rank default
 395     error stop 99
 396   end select
 397   select rank (zz)
 398   rank (1)
 399     print *, zz(1:3)
 400     if (num == 1) then
 401       if (zz(1) /= "abc") error stop 42
 402       if (zz(2) /= "ghi") error stop 43
 403       if (zz(3) /= "nop") error stop 44
 404     else if (num == 2) then
 405       if (zz(1) /= "def") error stop 45
 406       if (zz(2) /= "ghi") error stop 46
 407       if (zz(3) /= "jlm") error stop 47
 408     else
 409       error stop 48
 410     endif
 411     zz(1) = "ABC"
 412     zz(2) = "DEF"
 413     zz(3) = "GHI"
 414     res%z = get_loc (zz)
 415   rank default
 416     error stop 99
 417   end select
 418 contains
 419   integer (c_intptr_t) function get_loc (arg)
 420     character(len=*), target :: arg(:)
 421     ! %loc does copy in/out if not simply contiguous
 422     ! extra func needed because of 'target' attribute
 423     get_loc = transfer (c_loc(arg), res%x)
 424   end
 425 end
 426
 427 type(loc_t) function char_assumed_rank_in_f (xx, yy, zz, k, num) bind(c) result(res)
 428   integer, value :: num, k
 429   character(len=*) :: xx(..)
 430   character(len=3) :: yy(..)
 431   character(len=k) :: zz(..)
 432   intent(in) :: xx, yy, zz
 433   if (3 /= size(yy)) error stop 50
 434   if (3 /= len(yy)) error stop 51
 435   if (1 /= rank(yy)) error stop 59
 436   if (1 /= lbound(xx, dim=1)) stop 49
 437   if (1 /= lbound(yy, dim=1)) stop 49
 438   if (1 /= lbound(zz, dim=1)) stop 49
 439   if (3 /= ubound(xx, dim=1)) stop 49
 440   if (3 /= ubound(yy, dim=1)) stop 49
 441   if (3 /= ubound(zz, dim=1)) stop 49
 442   if (num == 1) then
 443     if (is_contiguous (xx)) error stop 59
 444     if (is_contiguous (yy)) error stop 59
 445     if (is_contiguous (zz)) error stop 59
 446   else if (num == 2) then
 447     if (.not. is_contiguous (xx)) error stop 59
 448     if (.not. is_contiguous (yy)) error stop 59
 449     if (.not. is_contiguous (zz)) error stop 59
 450   else
 451     error stop 48
 452   end if
 453   select rank (xx)
 454   rank (1)
 455     print *, xx(1:3)
 456     if (num == 1) then
 457       if (xx(1) /= "abc") error stop 52
 458       if (xx(2) /= "ghi") error stop 53
 459       if (xx(3) /= "nop") error stop 54
 460     else if (num == 2) then
 461       if (xx(1) /= "def") error stop 55
 462       if (xx(2) /= "ghi") error stop 56
 463       if (xx(3) /= "jlm") error stop 57
 464     else
 465       error stop 58
 466     endif
 467     res%x = get_loc(xx)
 468   rank default
 469     error stop 99
 470   end select
 471   select rank (yy)
 472   rank (1)
 473     print *, yy(1:3)
 474     if (num == 1) then
 475       if (yy(1) /= "abc") error stop 52
 476       if (yy(2) /= "ghi") error stop 53
 477       if (yy(3) /= "nop") error stop 54
 478     else if (num == 2) then
 479       if (yy(1) /= "def") error stop 55
 480       if (yy(2) /= "ghi") error stop 56
 481       if (yy(3) /= "jlm") error stop 57
 482     else
 483       error stop 58
 484     endif
 485     res%y = get_loc(yy)
 486   rank default
 487     error stop 99
 488   end select
 489   select rank (zz)
 490   rank (1)
 491     print *, zz(1:3)
 492     if (num == 1) then
 493       if (zz(1) /= "abc") error stop 52
 494       if (zz(2) /= "ghi") error stop 53
 495       if (zz(3) /= "nop") error stop 54
 496     else if (num == 2) then
 497       if (zz(1) /= "def") error stop 55
 498       if (zz(2) /= "ghi") error stop 56
 499       if (zz(3) /= "jlm") error stop 57
 500     else
 501       error stop 58
 502     endif
 503     res%z = get_loc(zz)
 504   rank default
 505     error stop 99
 506   end select
 507 contains
 508   integer (c_intptr_t) function get_loc (arg)
 509     character(len=*), target :: arg(:)
 510     ! %loc does copy in/out if not simply contiguous
 511     ! extra func needed because of 'target' attribute
 512     get_loc = transfer (c_loc(arg), res%x)
 513   end
 514 end
 515
 516
 517
 518 type(loc_t) function char_assumed_rank_cont_f (xx, yy, zz, k, num) bind(c) result(res)
 519   integer, value :: num, k
 520   character(len=*) :: xx(..)
 521   character(len=3) :: yy(..)
 522   character(len=k) :: zz(..)
 523   contiguous :: xx, yy, zz
 524   if (3 /= len(xx)) error stop 60
 525   if (3 /= len(yy)) error stop 60
 526   if (3 /= len(zz)) error stop 60
 527   if (3 /= size(xx)) error stop 61
 528   if (3 /= size(yy)) error stop 61
 529   if (3 /= size(zz)) error stop 61
 530   if (1 /= rank(xx)) error stop 69
 531   if (1 /= rank(yy)) error stop 69
 532   if (1 /= rank(zz)) error stop 69
 533   if (1 /= lbound(xx, dim=1)) stop 49
 534   if (1 /= lbound(yy, dim=1)) stop 49
 535   if (1 /= lbound(zz, dim=1)) stop 49
 536   if (3 /= ubound(xx, dim=1)) stop 49
 537   if (3 /= ubound(yy, dim=1)) stop 49
 538   if (3 /= ubound(zz, dim=1)) stop 49
 539   select rank (xx)
 540   rank (1)
 541     print *, xx(1:3)
 542     if (num == 1) then
 543       if (xx(1) /= "abc") error stop 62
 544       if (xx(2) /= "ghi") error stop 63
 545       if (xx(3) /= "nop") error stop 64
 546     else if (num == 2) then
 547       if (xx(1) /= "def") error stop 65
 548       if (xx(2) /= "ghi") error stop 66
 549       if (xx(3) /= "jlm") error stop 67
 550     else
 551       error stop 68
 552     endif
 553     xx(1) = "ABC"
 554     xx(2) = "DEF"
 555     xx(3) = "GHI"
 556     res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 557   rank default
 558     error stop 99
 559   end select
 560   select rank (yy)
 561   rank (1)
 562     print *, yy(1:3)
 563     if (num == 1) then
 564       if (yy(1) /= "abc") error stop 62
 565       if (yy(2) /= "ghi") error stop 63
 566       if (yy(3) /= "nop") error stop 64
 567     else if (num == 2) then
 568       if (yy(1) /= "def") error stop 65
 569       if (yy(2) /= "ghi") error stop 66
 570       if (yy(3) /= "jlm") error stop 67
 571     else
 572       error stop 68
 573     endif
 574     yy(1) = "ABC"
 575     yy(2) = "DEF"
 576     yy(3) = "GHI"
 577     res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 578   rank default
 579     error stop 99
 580   end select
 581   select rank (zz)
 582   rank (1)
 583     print *, zz(1:3)
 584     if (num == 1) then
 585       if (zz(1) /= "abc") error stop 62
 586       if (zz(2) /= "ghi") error stop 63
 587       if (zz(3) /= "nop") error stop 64
 588     else if (num == 2) then
 589       if (zz(1) /= "def") error stop 65
 590       if (zz(2) /= "ghi") error stop 66
 591       if (zz(3) /= "jlm") error stop 67
 592     else
 593       error stop 68
 594     endif
 595     zz(1) = "ABC"
 596     zz(2) = "DEF"
 597     zz(3) = "GHI"
 598     res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 599   rank default
 600     error stop 99
 601   end select
 602 end
 603
 604 type(loc_t) function char_assumed_rank_cont_in_f (xx, yy, zz, k, num) bind(c) result(res)
 605   integer, value :: num, k
 606   character(len=*) :: xx(..)
 607   character(len=3) :: yy(..)
 608   character(len=k) :: zz(..)
 609   intent(in) :: xx, yy, zz
 610   contiguous :: xx, yy, zz
 611   if (3 /= size(xx)) error stop 30
 612   if (3 /= size(yy)) error stop 30
 613   if (3 /= size(zz)) error stop 30
 614   if (3 /= len(xx)) error stop 31
 615   if (3 /= len(yy)) error stop 31
 616   if (3 /= len(zz)) error stop 31
 617   if (1 /= rank(xx)) error stop 69
 618   if (1 /= rank(yy)) error stop 69
 619   if (1 /= rank(zz)) error stop 69
 620   if (1 /= lbound(xx, dim=1)) stop 49
 621   if (1 /= lbound(yy, dim=1)) stop 49
 622   if (1 /= lbound(zz, dim=1)) stop 49
 623   if (3 /= ubound(xx, dim=1)) stop 49
 624   if (3 /= ubound(yy, dim=1)) stop 49
 625   if (3 /= ubound(zz, dim=1)) stop 49
 626   select rank (xx)
 627   rank (1)
 628     print *, xx(1:3)
 629     if (num == 1) then
 630       if (xx(1) /= "abc") error stop 62
 631       if (xx(2) /= "ghi") error stop 63
 632       if (xx(3) /= "nop") error stop 64
 633     else if (num == 2) then
 634       if (xx(1) /= "def") error stop 65
 635       if (xx(2) /= "ghi") error stop 66
 636       if (xx(3) /= "jlm") error stop 67
 637     else
 638       error stop 68
 639     endif
 640     res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 641   rank default
 642     error stop 99
 643   end select
 644   select rank (yy)
 645   rank (1)
 646     print *, yy(1:3)
 647     if (num == 1) then
 648       if (yy(1) /= "abc") error stop 62
 649       if (yy(2) /= "ghi") error stop 63
 650       if (yy(3) /= "nop") error stop 64
 651     else if (num == 2) then
 652       if (yy(1) /= "def") error stop 65
 653       if (yy(2) /= "ghi") error stop 66
 654       if (yy(3) /= "jlm") error stop 67
 655     else
 656       error stop 68
 657     endif
 658     res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 659   rank default
 660     error stop 99
 661   end select
 662   select rank (zz)
 663   rank (1)
 664     print *, zz(1:3)
 665     if (num == 1) then
 666       if (zz(1) /= "abc") error stop 62
 667       if (zz(2) /= "ghi") error stop 63
 668       if (zz(3) /= "nop") error stop 64
 669     else if (num == 2) then
 670       if (zz(1) /= "def") error stop 65
 671       if (zz(2) /= "ghi") error stop 66
 672       if (zz(3) /= "jlm") error stop 67
 673     else
 674       error stop 68
 675     endif
 676     res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 677   rank default
 678     error stop 99
 679   end select
 680 end
 681
 682 type(loc_t) function char_assumed_shape_f (xx, yy, zz, k, num) bind(c) result(res)
 683   integer, value :: num, k
 684   character(len=*) :: xx(:)
 685   character(len=3) :: yy(5:)
 686   character(len=k) :: zz(-k:)
 687   print *, xx(1:3)
 688   if (3 /= len(xx)) error stop 70
 689   if (3 /= len(yy)) error stop 70
 690   if (3 /= len(zz)) error stop 70
 691   if (3 /= size(xx)) error stop 71
 692   if (3 /= size(yy)) error stop 71
 693   if (3 /= size(zz)) error stop 71
 694   if (1 /= lbound(xx, dim=1)) stop 49
 695   if (5 /= lbound(yy, dim=1)) stop 49
 696   if (-k /= lbound(zz, dim=1)) stop 49
 697   if (3 /= ubound(xx, dim=1)) stop 49
 698   if (7 /= ubound(yy, dim=1)) stop 49
 699   if (-k+2 /= ubound(zz, dim=1)) stop 49
 700   if (num == 1) then
 701     if (is_contiguous (xx)) error stop 79
 702     if (is_contiguous (yy)) error stop 79
 703     if (is_contiguous (zz)) error stop 79
 704     if (xx(1) /= "abc") error stop 72
 705     if (xx(2) /= "ghi") error stop 73
 706     if (xx(3) /= "nop") error stop 74
 707     if (yy(5) /= "abc") error stop 72
 708     if (yy(6) /= "ghi") error stop 73
 709     if (yy(7) /= "nop") error stop 74
 710     if (zz(-k) /= "abc") error stop 72
 711     if (zz(-k+1) /= "ghi") error stop 73
 712     if (zz(-k+2) /= "nop") error stop 74
 713   else if (num == 2) then
 714     if (.not.is_contiguous (xx)) error stop 79
 715     if (.not.is_contiguous (yy)) error stop 79
 716     if (.not.is_contiguous (zz)) error stop 79
 717     if (xx(1) /= "def") error stop 72
 718     if (xx(2) /= "ghi") error stop 73
 719     if (xx(3) /= "jlm") error stop 74
 720     if (yy(5) /= "def") error stop 72
 721     if (yy(6) /= "ghi") error stop 73
 722     if (yy(7) /= "jlm") error stop 74
 723     if (zz(-k) /= "def") error stop 72
 724     if (zz(-k+1) /= "ghi") error stop 73
 725     if (zz(-k+2) /= "jlm") error stop 74
 726   else
 727     error stop 78
 728   endif
 729   xx(1) = "ABC"
 730   xx(2) = "DEF"
 731   xx(3) = "GHI"
 732   yy(5) = "ABC"
 733   yy(6) = "DEF"
 734   yy(7) = "GHI"
 735   zz(-k) = "ABC"
 736   zz(-k+1) = "DEF"
 737   zz(-k+2) = "GHI"
 738   res%x = get_loc(xx)
 739   res%y = get_loc(yy)
 740   res%z = get_loc(zz)
 741 contains
 742   integer (c_intptr_t) function get_loc (arg)
 743     character(len=*), target :: arg(:)
 744     ! %loc does copy in/out if not simply contiguous
 745     ! extra func needed because of 'target' attribute
 746     get_loc = transfer (c_loc(arg), res%x)
 747   end
 748 end
 749
 750 type(loc_t) function char_assumed_shape_in_f (xx, yy, zz, k, num) bind(c) result(res)
 751   integer, value :: num, k
 752   character(len=*) :: xx(:)
 753   character(len=3) :: yy(5:)
 754   character(len=k) :: zz(-k:)
 755   intent(in) :: xx, yy, zz
 756   print *, xx(1:3)
 757   if (3 /= size(xx)) error stop 80
 758   if (3 /= size(yy)) error stop 80
 759   if (3 /= size(zz)) error stop 80
 760   if (3 /= len(xx)) error stop 81
 761   if (3 /= len(yy)) error stop 81
 762   if (3 /= len(zz)) error stop 81
 763   if (1 /= lbound(xx, dim=1)) stop 49
 764   if (5 /= lbound(yy, dim=1)) stop 49
 765   if (-k /= lbound(zz, dim=1)) stop 49
 766   if (3 /= ubound(xx, dim=1)) stop 49
 767   if (7 /= ubound(yy, dim=1)) stop 49
 768   if (-k+2 /= ubound(zz, dim=1)) stop 49
 769   if (num == 1) then
 770     if (is_contiguous (xx)) error stop 89
 771     if (is_contiguous (yy)) error stop 89
 772     if (is_contiguous (zz)) error stop 89
 773     if (xx(1) /= "abc") error stop 82
 774     if (xx(2) /= "ghi") error stop 83
 775     if (xx(3) /= "nop") error stop 84
 776     if (yy(5) /= "abc") error stop 82
 777     if (yy(6) /= "ghi") error stop 83
 778     if (yy(7) /= "nop") error stop 84
 779     if (zz(-k) /= "abc") error stop 82
 780     if (zz(-k+1) /= "ghi") error stop 83
 781     if (zz(-k+2) /= "nop") error stop 84
 782   else if (num == 2) then
 783     if (.not.is_contiguous (xx)) error stop 89
 784     if (.not.is_contiguous (yy)) error stop 89
 785     if (.not.is_contiguous (zz)) error stop 89
 786     if (xx(1) /= "def") error stop 85
 787     if (xx(2) /= "ghi") error stop 86
 788     if (xx(3) /= "jlm") error stop 87
 789     if (yy(5) /= "def") error stop 85
 790     if (yy(6) /= "ghi") error stop 86
 791     if (yy(7) /= "jlm") error stop 87
 792     if (zz(-k) /= "def") error stop 85
 793     if (zz(-k+1) /= "ghi") error stop 86
 794     if (zz(-k+2) /= "jlm") error stop 87
 795   else
 796     error stop 88
 797   endif
 798   res%x = get_loc(xx)
 799   res%y = get_loc(yy)
 800   res%z = get_loc(zz)
 801 contains
 802   integer (c_intptr_t) function get_loc (arg)
 803     character(len=*), target :: arg(:)
 804     ! %loc does copy in/out if not simply contiguous
 805     ! extra func needed because of 'target' attribute
 806     get_loc = transfer (c_loc(arg), res%x)
 807   end
 808 end
 809
 810
 811
 812 type(loc_t) function char_assumed_shape_cont_f (xx, yy, zz, k, num) bind(c) result(res)
 813   integer, value :: num, k
 814   character(len=*) :: xx(:)
 815   character(len=3) :: yy(5:)
 816   character(len=k) :: zz(-k:)
 817   contiguous :: xx, yy, zz
 818   print *, xx(1:3)
 819   if (3 /= len(xx)) error stop 90
 820   if (3 /= len(yy)) error stop 90
 821   if (3 /= len(zz)) error stop 90
 822   if (3 /= size(xx)) error stop 91
 823   if (3 /= size(yy)) error stop 91
 824   if (3 /= size(zz)) error stop 91
 825   if (1 /= lbound(xx, dim=1)) stop 49
 826   if (5 /= lbound(yy, dim=1)) stop 49
 827   if (-k /= lbound(zz, dim=1)) stop 49
 828   if (3 /= ubound(xx, dim=1)) stop 49
 829   if (7 /= ubound(yy, dim=1)) stop 49
 830   if (-k+2 /= ubound(zz, dim=1)) stop 49
 831   if (num == 1) then
 832     if (xx(1) /= "abc") error stop 92
 833     if (xx(2) /= "ghi") error stop 93
 834     if (xx(3) /= "nop") error stop 94
 835     if (yy(5) /= "abc") error stop 92
 836     if (yy(6) /= "ghi") error stop 93
 837     if (yy(7) /= "nop") error stop 94
 838     if (zz(-k) /= "abc") error stop 92
 839     if (zz(-k+1) /= "ghi") error stop 93
 840     if (zz(-k+2) /= "nop") error stop 94
 841   else if (num == 2) then
 842     if (xx(1) /= "def") error stop 92
 843     if (xx(2) /= "ghi") error stop 93
 844     if (xx(3) /= "jlm") error stop 94
 845     if (yy(5) /= "def") error stop 92
 846     if (yy(6) /= "ghi") error stop 93
 847     if (yy(7) /= "jlm") error stop 94
 848     if (zz(-k) /= "def") error stop 92
 849     if (zz(-k+1) /= "ghi") error stop 93
 850     if (zz(-k+2) /= "jlm") error stop 94
 851   else
 852     error stop 98
 853   endif
 854   xx(1) = "ABC"
 855   xx(2) = "DEF"
 856   xx(3) = "GHI"
 857   yy(5) = "ABC"
 858   yy(6) = "DEF"
 859   yy(7) = "GHI"
 860   zz(-k) = "ABC"
 861   zz(-k+1) = "DEF"
 862   zz(-k+2) = "GHI"
 863   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 864   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 865   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 866 end
 867
 868 type(loc_t) function char_assumed_shape_cont_in_f (xx, yy, zz, k, num) bind(c) result(res)
 869   integer, value :: num, k
 870   character(len=*) :: xx(:)
 871   character(len=3) :: yy(5:)
 872   character(len=k) :: zz(-k:)
 873   intent(in) :: xx, yy, zz
 874   contiguous :: xx, yy, zz
 875   print *, xx(1:3)
 876   if (3 /= size(xx)) error stop 100
 877   if (3 /= size(yy)) error stop 100
 878   if (3 /= size(zz)) error stop 100
 879   if (3 /= len(xx)) error stop 101
 880   if (3 /= len(yy)) error stop 101
 881   if (3 /= len(zz)) error stop 101
 882   if (1 /= lbound(xx, dim=1)) stop 49
 883   if (5 /= lbound(yy, dim=1)) stop 49
 884   if (-k /= lbound(zz, dim=1)) stop 49
 885   if (3 /= ubound(xx, dim=1)) stop 49
 886   if (7 /= ubound(yy, dim=1)) stop 49
 887   if (-k+2 /= ubound(zz, dim=1)) stop 49
 888   if (num == 1) then
 889     if (xx(1) /= "abc") error stop 102
 890     if (xx(2) /= "ghi") error stop 103
 891     if (xx(3) /= "nop") error stop 104
 892     if (yy(5) /= "abc") error stop 102
 893     if (yy(6) /= "ghi") error stop 103
 894     if (yy(7) /= "nop") error stop 104
 895     if (zz(-k) /= "abc") error stop 102
 896     if (zz(-k+1) /= "ghi") error stop 103
 897     if (zz(-k+2) /= "nop") error stop 104
 898   else if (num == 2) then
 899     if (xx(1) /= "def") error stop 105
 900     if (xx(2) /= "ghi") error stop 106
 901     if (xx(3) /= "jlm") error stop 107
 902     if (yy(5) /= "def") error stop 105
 903     if (yy(6) /= "ghi") error stop 106
 904     if (yy(7) /= "jlm") error stop 107
 905     if (zz(-k) /= "def") error stop 105
 906     if (zz(-k+1) /= "ghi") error stop 106
 907     if (zz(-k+2) /= "jlm") error stop 107
 908   else
 909     error stop 108
 910   endif
 911   res%x = %loc(xx)  ! { dg-warning "Legacy Extension" }
 912   res%y = %loc(yy)  ! { dg-warning "Legacy Extension" }
 913   res%z = %loc(zz)  ! { dg-warning "Legacy Extension" }
 914 end
 915
 916 end module
 917
 918
 919 use m
 920 implicit none (type, external)
 921 character(len=3) :: a(6), a2(6), a3(6), a_init(6)
 922 type(loc_t) :: loc3
 923
 924 a_init = ['abc', 'def', 'ghi', 'jlm', 'nop', 'qrs']
 925
 926 ! -- Fortran: assumed size
 927 a = a_init; a2 = a_init; a3 = a_init
 928 loc3 = char_assumed_size_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
 929 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
 930 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 931 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 932 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 933 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 934 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 935
 936 a = a_init; a2 = a_init; a3 = a_init
 937 loc3 = char_assumed_size_f (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2)
 938 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
 939 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 940 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 941 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 942 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 943 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 944
 945 a = a_init; a2 = a_init; a3 = a_init
 946 loc3 = char_assumed_size_in_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
 947 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
 948 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 949 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 950 if (any (a /= a_init)) error stop 56
 951 if (any (a2 /= a_init)) error stop 58
 952 if (any (a3 /= a_init)) error stop 58
 953
 954 a = a_init; a2 = a_init; a3 = a_init
 955 loc3 = char_assumed_size_in_f (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2)
 956 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
 957 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 958 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 959 if (any (a /= a_init)) error stop 58
 960 if (any (a2 /= a_init)) error stop 58
 961 if (any (a3 /= a_init)) error stop 58
 962
 963 ! -- Fortran: explicit shape
 964 a = a_init; a2 = a_init; a3 = a_init
 965 loc3 = char_expl_size_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
 966 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
 967 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 968 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 969 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 970 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 971 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
 972
 973 a = a_init; a2 = a_init; a3 = a_init
 974 loc3 = char_expl_size_f (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2)
 975 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
 976 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 977 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 978 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 979 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 980 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
 981
 982 a = a_init; a2 = a_init; a3 = a_init
 983 loc3 = char_expl_size_in_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
 984 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
 985 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 986 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 987 if (any (a /= a_init)) error stop 56
 988 if (any (a2 /= a_init)) error stop 58
 989 if (any (a3 /= a_init)) error stop 58
 990
 991 a = a_init; a2 = a_init; a3 = a_init
 992 loc3 = char_expl_size_in_f (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2)
 993 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
 994 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
 995 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
 996 if (any (a /= a_init)) error stop 58
 997 if (any (a2 /= a_init)) error stop 58
 998 if (any (a3 /= a_init)) error stop 58
 999
1000 ! -- Fortran: assumed rank
1001 a = a_init; a2 = a_init; a3 = a_init
1002 loc3 = char_assumed_rank_f (a(::2), a2(::2), a3(::2), len(a), num=1)
1003 if (loc3%x /= %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1004 if (loc3%y /= %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1005 if (loc3%z /= %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1006 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1007 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1008 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1009
1010 a = a_init; a2 = a_init; a3 = a_init
1011 loc3 = char_assumed_rank_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1012 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1013 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1014 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1015 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1016 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1017 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1018
1019 a = a_init; a2 = a_init; a3 = a_init
1020 loc3 = char_assumed_rank_in_f (a(::2), a2(::2), a3(::2), len(a), num=1)
1021 if (loc3%x /= %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1022 if (loc3%y /= %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1023 if (loc3%z /= %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1024 if (any (a /= a_init)) error stop 56
1025 if (any (a2 /= a_init)) error stop 56
1026 if (any (a3 /= a_init)) error stop 56
1027
1028 a = a_init; a2 = a_init; a3 = a_init
1029 loc3 = char_assumed_rank_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1030 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1031 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1032 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1033 if (any (a /= a_init)) error stop 58
1034 if (any (a2 /= a_init)) error stop 58
1035 if (any (a3 /= a_init)) error stop 58
1036
1037 ! -- Fortran: assumed rank contiguous
1038 a = a_init; a2 = a_init; a3 = a_init
1039 loc3 = char_assumed_rank_cont_f (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1040 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1041 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1042 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1043 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1044 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1045 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1046
1047 a = a_init; a2 = a_init; a3 = a_init
1048 loc3 = char_assumed_rank_cont_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1049 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1050 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1051 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1052 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1053 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1054 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1055
1056 a = a_init; a2 = a_init; a3 = a_init
1057 loc3 = char_assumed_rank_cont_in_f (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1058 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1059 if (loc3%y == %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1060 if (loc3%z == %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1061 if (any (a /= a_init)) error stop 56
1062 if (any (a2 /= a_init)) error stop 56
1063 if (any (a3 /= a_init)) error stop 56
1064
1065 a = a_init; a2 = a_init; a3 = a_init
1066 loc3 = char_assumed_rank_cont_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1067 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1068 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1069 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1070 if (any (a /= a_init)) error stop 58
1071 if (any (a2 /= a_init)) error stop 58
1072 if (any (a3 /= a_init)) error stop 58
1073
1074 ! -- Fortran: assumed shape
1075 a = a_init; a2 = a_init; a3 = a_init
1076 loc3 = char_assumed_shape_f (a(::2), a2(::2), a3(::2), len(a), num=1)
1077 if (loc3%x /= %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1078 if (loc3%y /= %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1079 if (loc3%z /= %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1080 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1081 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1082 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1083
1084 a = a_init; a2 = a_init; a3 = a_init
1085 loc3 = char_assumed_shape_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1086 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1087 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1088 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1089 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1090 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1091 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1092
1093 a = a_init; a2 = a_init; a3 = a_init
1094 loc3 = char_assumed_shape_in_f (a(::2), a2(::2), a3(::2), len(a), num=1)
1095 if (loc3%x /= %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1096 if (loc3%y /= %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1097 if (loc3%z /= %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1098 if (any (a /= a_init)) error stop 56
1099 if (any (a2 /= a_init)) error stop 56
1100 if (any (a3 /= a_init)) error stop 56
1101
1102 a = a_init; a2 = a_init; a3 = a_init
1103 loc3 = char_assumed_shape_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1104 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1105 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1106 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1107 if (any (a /= a_init)) error stop 58
1108 if (any (a2 /= a_init)) error stop 58
1109 if (any (a3 /= a_init)) error stop 58
1110
1111 ! -- Fortran: assumed shape contiguous
1112 a = a_init; a2 = a_init; a3 = a_init
1113 loc3 = char_assumed_shape_cont_f (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1114 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1115 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1116 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1117 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1118 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1119 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1120
1121 a = a_init; a2 = a_init; a3 = a_init
1122 loc3 = char_assumed_shape_cont_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1123 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1124 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1125 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1126 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1127 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1128 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1129
1130 a = a_init; a2 = a_init; a3 = a_init
1131 loc3 = char_assumed_shape_cont_in_f (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1132 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1133 if (loc3%y == %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1134 if (loc3%z == %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1135 if (any (a /= a_init)) error stop 56
1136 if (any (a2 /= a_init)) error stop 56
1137 if (any (a3 /= a_init)) error stop 56
1138
1139 a = a_init; a2 = a_init; a3 = a_init
1140 loc3 = char_assumed_shape_cont_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1141 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1142 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1143 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1144 if (any (a /= a_init)) error stop 58
1145 if (any (a2 /= a_init)) error stop 58
1146 if (any (a3 /= a_init)) error stop 58
1147
1148
1149 ! --- character - call C directly --
1150
1151 ! -- C: assumed size
1152 a = a_init; a2 = a_init; a3 = a_init
1153 loc3 = char_assumed_size_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
1154 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1155 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1156 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1157 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1158 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1159 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1160
1161 a = a_init; a2 = a_init; a3 = a_init
1162 loc3 = char_assumed_size_c (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2)
1163 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1164 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1165 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1166 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1167 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1168 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1169
1170 a = a_init; a2 = a_init; a3 = a_init
1171 loc3 = char_assumed_size_in_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
1172 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1173 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1174 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1175 if (any (a /= a_init)) error stop 56
1176 if (any (a2 /= a_init)) error stop 58
1177 if (any (a3 /= a_init)) error stop 58
1178
1179 a = a_init; a2 = a_init; a3 = a_init
1180 loc3 = char_assumed_size_in_c (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2)
1181 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1182 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1183 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1184 if (any (a /= a_init)) error stop 58
1185 if (any (a2 /= a_init)) error stop 58
1186 if (any (a3 /= a_init)) error stop 58
1187
1188 ! -- C: explicit shape
1189 a = a_init; a2 = a_init; a3 = a_init
1190 loc3 = char_expl_size_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
1191 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1192 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1193 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1194 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1195 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1196 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1197
1198 a = a_init; a2 = a_init; a3 = a_init
1199 loc3 = char_expl_size_c (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2)
1200 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1201 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1202 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1203 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1204 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1205 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1206
1207 a = a_init; a2 = a_init; a3 = a_init
1208 loc3 = char_expl_size_in_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1)   ! NOTE: run-time copy-in warning
1209 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1210 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1211 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1212 if (any (a /= a_init)) error stop 56
1213 if (any (a2 /= a_init)) error stop 58
1214 if (any (a3 /= a_init)) error stop 58
1215
1216 a = a_init; a2 = a_init; a3 = a_init
1217 loc3 = char_expl_size_in_c (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2)
1218 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1219 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1220 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1221 if (any (a /= a_init)) error stop 58
1222 if (any (a2 /= a_init)) error stop 58
1223 if (any (a3 /= a_init)) error stop 58
1224
1225 ! -- C: assumed rank
1226 a = a_init; a2 = a_init; a3 = a_init
1227 loc3 = char_assumed_rank_c (a(::2), a2(::2), a3(::2), len(a), num=1)
1228 if (loc3%x /= %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1229 if (loc3%y /= %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1230 if (loc3%z /= %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1231 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1232 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1233 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1234
1235 a = a_init; a2 = a_init; a3 = a_init
1236 loc3 = char_assumed_rank_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1237 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1238 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1239 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1240 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1241 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1242 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1243
1244 a = a_init; a2 = a_init; a3 = a_init
1245 loc3 = char_assumed_rank_in_c (a(::2), a2(::2), a3(::2), len(a), num=1)
1246 if (loc3%x /= %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1247 if (loc3%y /= %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1248 if (loc3%z /= %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1249 if (any (a /= a_init)) error stop 56
1250 if (any (a2 /= a_init)) error stop 56
1251 if (any (a3 /= a_init)) error stop 56
1252
1253 a = a_init; a2 = a_init; a3 = a_init
1254 loc3 = char_assumed_rank_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1255 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1256 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1257 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1258 if (any (a /= a_init)) error stop 58
1259 if (any (a2 /= a_init)) error stop 58
1260 if (any (a3 /= a_init)) error stop 58
1261
1262 ! -- C: assumed rank contiguous
1263 a = a_init; a2 = a_init; a3 = a_init
1264 loc3 = char_assumed_rank_cont_c (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1265 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1266 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1267 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1268 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1269 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1270 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1271
1272 a = a_init; a2 = a_init; a3 = a_init
1273 loc3 = char_assumed_rank_cont_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1274 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1275 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1276 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1277 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1278 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1279 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1280
1281 a = a_init; a2 = a_init; a3 = a_init
1282 loc3 = char_assumed_rank_cont_in_c (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1283 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1284 if (loc3%y == %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1285 if (loc3%z == %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1286 if (any (a /= a_init)) error stop 56
1287 if (any (a2 /= a_init)) error stop 56
1288 if (any (a3 /= a_init)) error stop 56
1289
1290 a = a_init; a2 = a_init; a3 = a_init
1291 loc3 = char_assumed_rank_cont_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1292 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1293 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1294 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1295 if (any (a /= a_init)) error stop 58
1296 if (any (a2 /= a_init)) error stop 58
1297 if (any (a3 /= a_init)) error stop 58
1298
1299 ! -- C: assumed shape
1300 a = a_init; a2 = a_init; a3 = a_init
1301 loc3 = char_assumed_shape_c (a(::2), a2(::2), a3(::2), len(a), num=1)
1302 if (loc3%x /= %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1303 if (loc3%y /= %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1304 if (loc3%z /= %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1305 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1306 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1307 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1308
1309 a = a_init; a2 = a_init; a3 = a_init
1310 loc3 = char_assumed_shape_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1311 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1312 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1313 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1314 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1315 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1316 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1317
1318 a = a_init; a2 = a_init; a3 = a_init
1319 loc3 = char_assumed_shape_in_c (a(::2), a2(::2), a3(::2), len(a), num=1)
1320 if (loc3%x /= %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1321 if (loc3%y /= %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1322 if (loc3%z /= %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1323 if (any (a /= a_init)) error stop 56
1324 if (any (a2 /= a_init)) error stop 56
1325 if (any (a3 /= a_init)) error stop 56
1326
1327 a = a_init; a2 = a_init; a3 = a_init
1328 loc3 = char_assumed_shape_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1329 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1330 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1331 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1332 if (any (a /= a_init)) error stop 58
1333 if (any (a2 /= a_init)) error stop 58
1334 if (any (a3 /= a_init)) error stop 58
1335
1336 ! -- C: assumed shape contiguous
1337 a = a_init; a2 = a_init; a3 = a_init
1338 loc3 = char_assumed_shape_cont_c (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1339 if (loc3%x == %loc(a)) error stop 51  ! { dg-warning "Legacy Extension" }
1340 if (loc3%y == %loc(a2)) error stop 51  ! { dg-warning "Legacy Extension" }
1341 if (loc3%z == %loc(a3)) error stop 51  ! { dg-warning "Legacy Extension" }
1342 if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1343 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1344 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52
1345
1346 a = a_init; a2 = a_init; a3 = a_init
1347 loc3 = char_assumed_shape_cont_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1348 if (loc3%x /= %loc(a(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1349 if (loc3%y /= %loc(a2(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1350 if (loc3%z /= %loc(a3(2))) error stop 53  ! { dg-warning "Legacy Extension" }
1351 if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1352 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1353 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54
1354
1355 a = a_init; a2 = a_init; a3 = a_init
1356 loc3 = char_assumed_shape_cont_in_c (a(::2), a2(::2), a3(::2), len(a), num=1)   ! NOTE: run-time copy-in warning
1357 if (loc3%x == %loc(a)) error stop 55  ! { dg-warning "Legacy Extension" }
1358 if (loc3%y == %loc(a2)) error stop 55  ! { dg-warning "Legacy Extension" }
1359 if (loc3%z == %loc(a3)) error stop 55  ! { dg-warning "Legacy Extension" }
1360 if (any (a /= a_init)) error stop 56
1361 if (any (a2 /= a_init)) error stop 56
1362 if (any (a3 /= a_init)) error stop 56
1363
1364 a = a_init; a2 = a_init; a3 = a_init
1365 loc3 = char_assumed_shape_cont_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2)
1366 if (loc3%x /= %loc(a(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1367 if (loc3%y /= %loc(a2(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1368 if (loc3%z /= %loc(a3(2))) error stop 57  ! { dg-warning "Legacy Extension" }
1369 if (any (a /= a_init)) error stop 58
1370 if (any (a2 /= a_init)) error stop 58
1371 if (any (a3 /= a_init)) error stop 58
1372 end
1373
1374
1375 ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1376 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_f'(\r*\n+)" }"
1377 ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1378 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_f'(\r*\n+)" }"
1379 ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1380 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_f'(\r*\n+)" }"
1381 ! { dg-output " abcghinop(\r*\n+)" }"
1382 ! { dg-output " defghijlm(\r*\n+)" }"
1383 ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1384 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_in_f'(\r*\n+)" }"
1385 ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1386 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_in_f'(\r*\n+)" }"
1387 ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1388 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_in_f'(\r*\n+)" }"
1389 ! { dg-output " abcghinop(\r*\n+)" }"
1390 ! { dg-output " defghijlm(\r*\n+)" }"
1391 ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1392 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_f'(\r*\n+)" }"
1393 ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1394 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_f'(\r*\n+)" }"
1395 ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1396 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_f'(\r*\n+)" }"
1397 ! { dg-output " abcghinop(\r*\n+)" }"
1398 ! { dg-output " defghijlm(\r*\n+)" }"
1399 ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1400 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_in_f'(\r*\n+)" }"
1401 ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1402 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_in_f'(\r*\n+)" }"
1403 ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1404 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_in_f'(\r*\n+)" }"
1405 ! { dg-output " abcghinop(\r*\n+)" }"
1406 ! { dg-output " defghijlm(\r*\n+)" }"
1407 ! { dg-output " abcghinop(\r*\n+)" }"
1408 ! { dg-output " abcghinop(\r*\n+)" }"
1409 ! { dg-output " abcghinop(\r*\n+)" }"
1410 ! { dg-output " defghijlm(\r*\n+)" }"
1411 ! { dg-output " defghijlm(\r*\n+)" }"
1412 ! { dg-output " defghijlm(\r*\n+)" }"
1413 ! { dg-output " abcghinop(\r*\n+)" }"
1414 ! { dg-output " abcghinop(\r*\n+)" }"
1415 ! { dg-output " abcghinop(\r*\n+)" }"
1416 ! { dg-output " defghijlm(\r*\n+)" }"
1417 ! { dg-output " defghijlm(\r*\n+)" }"
1418 ! { dg-output " defghijlm(\r*\n+)" }"
1419 ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1420 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }"
1421 ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1422 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }"
1423 ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1424 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }"
1425 ! { dg-output " abcghinop(\r*\n+)" }"
1426 ! { dg-output " abcghinop(\r*\n+)" }"
1427 ! { dg-output " abcghinop(\r*\n+)" }"
1428 ! { dg-output " defghijlm(\r*\n+)" }"
1429 ! { dg-output " defghijlm(\r*\n+)" }"
1430 ! { dg-output " defghijlm(\r*\n+)" }"
1431 ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1432 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }"
1433 ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1434 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }"
1435 ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1436 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }"
1437 ! { dg-output " abcghinop(\r*\n+)" }"
1438 ! { dg-output " abcghinop(\r*\n+)" }"
1439 ! { dg-output " abcghinop(\r*\n+)" }"
1440 ! { dg-output " defghijlm(\r*\n+)" }"
1441 ! { dg-output " defghijlm(\r*\n+)" }"
1442 ! { dg-output " defghijlm(\r*\n+)" }"
1443 ! { dg-output " abcghinop(\r*\n+)" }"
1444 ! { dg-output " defghijlm(\r*\n+)" }"
1445 ! { dg-output " abcghinop(\r*\n+)" }"
1446 ! { dg-output " defghijlm(\r*\n+)" }"
1447 ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1448 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }"
1449 ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1450 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }"
1451 ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1452 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }"
1453 ! { dg-output " abcghinop(\r*\n+)" }"
1454 ! { dg-output " defghijlm(\r*\n+)" }"
1455 ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1456 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }"
1457 ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1458 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }"
1459 ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1460 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }"
1461 ! { dg-output " abcghinop(\r*\n+)" }"
1462 ! { dg-output " defghijlm(\r*\n+)" }"
1463 ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1464 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_c'(\r*\n+)" }"
1465 ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1466 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_c'(\r*\n+)" }"
1467 ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1468 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_c'(\r*\n+)" }"
1469 ! { dg-output " abcghinop(\r*\n+)" }"
1470 ! { dg-output " defghijlm(\r*\n+)" }"
1471 ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1472 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_in_c'(\r*\n+)" }"
1473 ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1474 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_in_c'(\r*\n+)" }"
1475 ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1476 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_in_c'(\r*\n+)" }"
1477 ! { dg-output " abcghinop(\r*\n+)" }"
1478 ! { dg-output " defghijlm(\r*\n+)" }"
1479 ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1480 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_c'(\r*\n+)" }"
1481 ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1482 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_c'(\r*\n+)" }"
1483 ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1484 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_c'(\r*\n+)" }"
1485 ! { dg-output " abcghinop(\r*\n+)" }"
1486 ! { dg-output " defghijlm(\r*\n+)" }"
1487 ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1488 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_in_c'(\r*\n+)" }"
1489 ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1490 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_in_c'(\r*\n+)" }"
1491 ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1492 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_in_c'(\r*\n+)" }"
1493 ! { dg-output " abcghinop(\r*\n+)" }"
1494 ! { dg-output " defghijlm(\r*\n+)" }"
1495 ! { dg-output " abcghinop(\r*\n+)" }"
1496 ! { dg-output " abcghinop(\r*\n+)" }"
1497 ! { dg-output " abcghinop(\r*\n+)" }"
1498 ! { dg-output " defghijlm(\r*\n+)" }"
1499 ! { dg-output " defghijlm(\r*\n+)" }"
1500 ! { dg-output " defghijlm(\r*\n+)" }"
1501 ! { dg-output " abcghinop(\r*\n+)" }"
1502 ! { dg-output " abcghinop(\r*\n+)" }"
1503 ! { dg-output " abcghinop(\r*\n+)" }"
1504 ! { dg-output " defghijlm(\r*\n+)" }"
1505 ! { dg-output " defghijlm(\r*\n+)" }"
1506 ! { dg-output " defghijlm(\r*\n+)" }"
1507 ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1508 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }"
1509 ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1510 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }"
1511 ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1512 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }"
1513 ! { dg-output " abcghinop(\r*\n+)" }"
1514 ! { dg-output " abcghinop(\r*\n+)" }"
1515 ! { dg-output " abcghinop(\r*\n+)" }"
1516 ! { dg-output " defghijlm(\r*\n+)" }"
1517 ! { dg-output " defghijlm(\r*\n+)" }"
1518 ! { dg-output " defghijlm(\r*\n+)" }"
1519 ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1520 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }"
1521 ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1522 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }"
1523 ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1524 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }"
1525 ! { dg-output " abcghinop(\r*\n+)" }"
1526 ! { dg-output " abcghinop(\r*\n+)" }"
1527 ! { dg-output " abcghinop(\r*\n+)" }"
1528 ! { dg-output " defghijlm(\r*\n+)" }"
1529 ! { dg-output " defghijlm(\r*\n+)" }"
1530 ! { dg-output " defghijlm(\r*\n+)" }"
1531 ! { dg-output " abcghinop(\r*\n+)" }"
1532 ! { dg-output " abcghinop(\r*\n+)" }"
1533 ! { dg-output " abcghinop(\r*\n+)" }"
1534 ! { dg-output " abcghinop(\r*\n+)" }"
1535 ! { dg-output " abcghinop(\r*\n+)" }"
1536 ! { dg-output " abcghinop(\r*\n+)" }"
1537 ! { dg-output " abcghinop(\r*\n+)" }"
1538 ! { dg-output " abcghinop(\r*\n+)" }"
1539 ! { dg-output " abcghinop(\r*\n+)" }"
1540 ! { dg-output " abcghinop(\r*\n+)" }"
1541 ! { dg-output " abcghinop(\r*\n+)" }"
1542 ! { dg-output " abcghinop(\r*\n+)" }"
1543 ! { dg-output " abcghinop(\r*\n+)" }"
1544 ! { dg-output " defghijlm(\r*\n+)" }"
1545 ! { dg-output " defghijlm(\r*\n+)" }"
1546 ! { dg-output " defghijlm(\r*\n+)" }"
1547 ! { dg-output " defghijlm(\r*\n+)" }"
1548 ! { dg-output " defghijlm(\r*\n+)" }"
1549 ! { dg-output " defghijlm(\r*\n+)" }"
1550 ! { dg-output " defghijlm(\r*\n+)" }"
1551 ! { dg-output " defghijlm(\r*\n+)" }"
1552 ! { dg-output " defghijlm(\r*\n+)" }"
1553 ! { dg-output " defghijlm(\r*\n+)" }"
1554 ! { dg-output " defghijlm(\r*\n+)" }"
1555 ! { dg-output " defghijlm(\r*\n+)" }"
1556 ! { dg-output " defghijlm(\r*\n+)" }"
1557 ! { dg-output " abcghinop(\r*\n+)" }"
1558 ! { dg-output " defghijlm(\r*\n+)" }"
1559 ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1560 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }"
1561 ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1562 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }"
1563 ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1564 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }"
1565 ! { dg-output " abcghinop(\r*\n+)" }"
1566 ! { dg-output " defghijlm(\r*\n+)" }"
1567 ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1568 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }"
1569 ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1570 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }"
1571 ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }"
1572 ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }"
1573 ! { dg-output " abcghinop(\r*\n+)" }"
1574 ! { dg-output " defghijlm(\r*\n+)" }"