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

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