! { dg-do run } ! { dg-additional-sources bind-c-contiguous-1.c } ! { dg-additional-options "-fcheck=all" } ! { dg-additional-options -Wno-complain-wrong-lang } ! Fortran demands that with bind(C), the callee ensure that for ! * 'contiguous' ! * len=* with explicit/assumed-size arrays ! noncontiguous actual arguments are handled. ! (in without bind(C) in gfortran, caller handles the copy in/out ! Additionally, for a bind(C) callee, a Fortran-written caller ! has to ensure the same (for contiguous + len=* to explicit-/assumed-size arrays) module m use iso_c_binding, only: c_intptr_t, c_bool, c_loc, c_int implicit none (type, external) type, bind(C) :: loc_t integer(c_intptr_t) :: x, y, z end type loc_t interface type(loc_t) function char_assumed_size_c (xx, yy, zz, n, num) bind(C) import :: loc_t, c_bool, c_int integer(c_int), value :: n, num character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*) end function type(loc_t) function char_assumed_size_in_c (xx, yy, zz, n, num) bind(C) import :: loc_t, c_bool, c_int integer(c_int), value :: n, num character(len=*), intent(in) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*) end function type(loc_t) function char_expl_size_c (xx, yy, zz, n, num) bind(c) import :: loc_t, c_bool, c_int integer(c_int), value :: n, num character(len=*) :: xx(n), yy(n:n+3), zz(6:6, 3:n, 3:n+3) end function type(loc_t) function char_expl_size_in_c (xx, yy, zz, n, num) bind(c) import :: loc_t, c_bool, c_int integer(c_int), value :: n, num character(len=*), intent(in) :: xx(n), yy(n:n+3), zz(6:6, 3:n, 3:n+3) end function type(loc_t) function char_assumed_rank_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*) :: xx(..) character(len=3) :: yy(..) character(len=k) :: zz(..) end function type(loc_t) function char_assumed_rank_in_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), intent(in) :: xx(..) character(len=3), intent(in) :: yy(..) character(len=k), intent(in) :: zz(..) end function type(loc_t) function char_assumed_rank_cont_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), contiguous :: xx(..) character(len=3), contiguous :: yy(..) character(len=k), contiguous :: zz(..) end function type(loc_t) function char_assumed_rank_cont_in_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), contiguous, intent(in) :: xx(..) character(len=3), contiguous, intent(in) :: yy(..) character(len=k), contiguous, intent(in) :: zz(..) end function type(loc_t) function char_assumed_shape_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*) :: xx(:) character(len=3) :: yy(5:) character(len=k) :: zz(-k:) end function type(loc_t) function char_assumed_shape_in_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), intent(in) :: xx(:) character(len=3), intent(in) :: yy(5:) character(len=k), intent(in) :: zz(-k:) end function type(loc_t) function char_assumed_shape_cont_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), contiguous :: xx(:) character(len=3), contiguous :: yy(5:) character(len=k), contiguous :: zz(-k:) end function type(loc_t) function char_assumed_shape_cont_in_c (xx, yy, zz, k, num) bind(c) import :: loc_t, c_bool, c_int integer, value :: k, num character(len=*), contiguous, intent(in) :: xx(:) character(len=3), contiguous, intent(in) :: yy(5:) character(len=k), contiguous, intent(in) :: zz(-k:) end function end interface contains type(loc_t) function char_assumed_size_f (xx, yy, zz, n, num) bind(c) result(res) integer, value :: num, n character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*) print *, xx(1:3) if (3 /= len(xx)) error stop 1 if (3 /= len(yy)) error stop 1 if (3 /= len(zz)) error stop 1 if (1 /= lbound(xx,dim=1)) error stop 1 if (3 /= lbound(yy,dim=1)) error stop 1 if (6 /= lbound(zz,dim=1)) error stop 1 if (3 /= lbound(zz,dim=2)) error stop 1 if (3 /= lbound(zz,dim=3)) error stop 1 if (1 /= size(zz,dim=1)) error stop 1 if (1 /= size(zz,dim=2)) error stop 1 if (6 /= ubound(zz,dim=1)) error stop 1 if (3 /= ubound(zz,dim=2)) error stop 1 if (num == 1) then if (xx(1) /= "abc") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "nop") error stop 4 if (yy(3) /= "abc") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "nop") error stop 4 if (zz(6,n,3) /= "abc") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "nop") error stop 4 else if (num == 2) then if (xx(1) /= "def") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "jlm") error stop 4 if (yy(3) /= "def") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "jlm") error stop 4 if (zz(6,n,3) /= "def") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "jlm") error stop 4 else error stop 8 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" yy(3) = "ABC" yy(4) = "DEF" yy(5) = "GHI" zz(6,n,3) = "ABC" zz(6,n,4) = "DEF" zz(6,n,5) = "GHI" res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } end type(loc_t) function char_assumed_size_in_f (xx, yy, zz, n, num) bind(c) result(res) integer, value :: num, n character(len=*) :: xx(*), yy(n:*), zz(6:6, 3:n, 3:*) intent(in) :: xx, yy, zz print *, xx(1:3) if (3 /= len(xx)) error stop 1 if (3 /= len(yy)) error stop 1 if (3 /= len(zz)) error stop 1 if (1 /= lbound(xx,dim=1)) error stop 1 if (3 /= lbound(yy,dim=1)) error stop 1 if (6 /= lbound(zz,dim=1)) error stop 1 if (3 /= lbound(zz,dim=2)) error stop 1 if (3 /= lbound(zz,dim=3)) error stop 1 if (1 /= size(zz,dim=1)) error stop 1 if (1 /= size(zz,dim=2)) error stop 1 if (6 /= ubound(zz,dim=1)) error stop 1 if (3 /= ubound(zz,dim=2)) error stop 1 if (num == 1) then if (xx(1) /= "abc") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "nop") error stop 4 if (yy(3) /= "abc") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "nop") error stop 4 if (zz(6,n,3) /= "abc") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "nop") error stop 4 else if (num == 2) then if (xx(1) /= "def") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "jlm") error stop 4 if (yy(3) /= "def") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "jlm") error stop 4 if (zz(6,n,3) /= "def") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "jlm") error stop 4 else error stop 8 endif res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } if (num == 1) then end type(loc_t) function char_expl_size_f (xx, yy, zz, n, num) bind(c) result(res) integer, value :: num, n character(len=*) :: xx(n), yy(n:n+2), zz(6:6, 3:n, 3:n+2) print *, xx(1:3) if (3 /= len(xx)) error stop 1 if (3 /= len(yy)) error stop 1 if (3 /= len(zz)) error stop 1 if (1 /= lbound(xx,dim=1)) error stop 1 if (3 /= lbound(yy,dim=1)) error stop 1 if (6 /= lbound(zz,dim=1)) error stop 1 if (3 /= lbound(zz,dim=2)) error stop 1 if (3 /= lbound(zz,dim=3)) error stop 1 if (3 /= size(xx,dim=1)) error stop 1 if (3 /= size(yy,dim=1)) error stop 1 if (1 /= size(zz,dim=1)) error stop 1 if (1 /= size(zz,dim=2)) error stop 1 if (3 /= size(zz,dim=3)) error stop 1 if (3 /= ubound(xx,dim=1)) error stop 1 if (5 /= ubound(yy,dim=1)) error stop 1 if (6 /= ubound(zz,dim=1)) error stop 1 if (3 /= ubound(zz,dim=2)) error stop 1 if (5 /= ubound(zz,dim=3)) error stop 1 if (num == 1) then if (xx(1) /= "abc") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "nop") error stop 4 if (yy(3) /= "abc") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "nop") error stop 4 if (zz(6,n,3) /= "abc") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "nop") error stop 4 else if (num == 2) then if (xx(1) /= "def") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "jlm") error stop 4 if (yy(3) /= "def") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "jlm") error stop 4 if (zz(6,n,3) /= "def") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "jlm") error stop 4 else error stop 8 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" yy(3) = "ABC" yy(4) = "DEF" yy(5) = "GHI" zz(6,n,3) = "ABC" zz(6,n,4) = "DEF" zz(6,n,5) = "GHI" res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } end type(loc_t) function char_expl_size_in_f (xx, yy, zz, n, num) bind(c) result(res) integer, value :: num, n character(len=*) :: xx(n), yy(n:n+2), zz(6:6, 3:n, 3:n+2) intent(in) :: xx, yy, zz print *, xx(1:3) if (3 /= len(xx)) error stop 1 if (3 /= len(yy)) error stop 1 if (3 /= len(zz)) error stop 1 if (1 /= lbound(xx,dim=1)) error stop 1 if (3 /= lbound(yy,dim=1)) error stop 1 if (6 /= lbound(zz,dim=1)) error stop 1 if (3 /= lbound(zz,dim=2)) error stop 1 if (3 /= lbound(zz,dim=3)) error stop 1 if (3 /= size(xx,dim=1)) error stop 1 if (3 /= size(yy,dim=1)) error stop 1 if (1 /= size(zz,dim=1)) error stop 1 if (1 /= size(zz,dim=2)) error stop 1 if (3 /= size(zz,dim=3)) error stop 1 if (3 /= ubound(xx,dim=1)) error stop 1 if (5 /= ubound(yy,dim=1)) error stop 1 if (6 /= ubound(zz,dim=1)) error stop 1 if (3 /= ubound(zz,dim=2)) error stop 1 if (5 /= ubound(zz,dim=3)) error stop 1 if (num == 1) then if (xx(1) /= "abc") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "nop") error stop 4 if (yy(3) /= "abc") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "nop") error stop 4 if (zz(6,n,3) /= "abc") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "nop") error stop 4 else if (num == 2) then if (xx(1) /= "def") error stop 2 if (xx(2) /= "ghi") error stop 3 if (xx(3) /= "jlm") error stop 4 if (yy(3) /= "def") error stop 2 if (yy(4) /= "ghi") error stop 3 if (yy(5) /= "jlm") error stop 4 if (zz(6,n,3) /= "def") error stop 2 if (zz(6,n,4) /= "ghi") error stop 3 if (zz(6,n,5) /= "jlm") error stop 4 else error stop 8 endif res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } end type(loc_t) function char_assumed_rank_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(..) character(len=3) :: yy(..) character(len=k) :: zz(..) if (3 /= len(xx)) error stop 40 if (3 /= len(yy)) error stop 40 if (3 /= len(zz)) error stop 40 if (3 /= size(xx)) error stop 41 if (3 /= size(yy)) error stop 41 if (3 /= size(zz)) error stop 41 if (1 /= rank(xx)) error stop 49 if (1 /= rank(yy)) error stop 49 if (1 /= rank(zz)) error stop 49 if (1 /= lbound(xx, dim=1)) stop 49 if (1 /= lbound(yy, dim=1)) stop 49 if (1 /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (3 /= ubound(yy, dim=1)) stop 49 if (3 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (is_contiguous (xx)) error stop 49 if (is_contiguous (yy)) error stop 49 if (is_contiguous (zz)) error stop 49 else if (num == 2) then if (.not. is_contiguous (xx)) error stop 49 if (.not. is_contiguous (yy)) error stop 49 if (.not. is_contiguous (zz)) error stop 49 else error stop 48 end if select rank (xx) rank (1) print *, xx(1:3) if (num == 1) then if (xx(1) /= "abc") error stop 42 if (xx(2) /= "ghi") error stop 43 if (xx(3) /= "nop") error stop 44 else if (num == 2) then if (xx(1) /= "def") error stop 45 if (xx(2) /= "ghi") error stop 46 if (xx(3) /= "jlm") error stop 47 else error stop 48 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" res%x = get_loc (xx) rank default error stop 99 end select select rank (yy) rank (1) print *, yy(1:3) if (num == 1) then if (yy(1) /= "abc") error stop 42 if (yy(2) /= "ghi") error stop 43 if (yy(3) /= "nop") error stop 44 else if (num == 2) then if (yy(1) /= "def") error stop 45 if (yy(2) /= "ghi") error stop 46 if (yy(3) /= "jlm") error stop 47 else error stop 48 endif yy(1) = "ABC" yy(2) = "DEF" yy(3) = "GHI" res%y = get_loc (yy) rank default error stop 99 end select select rank (zz) rank (1) print *, zz(1:3) if (num == 1) then if (zz(1) /= "abc") error stop 42 if (zz(2) /= "ghi") error stop 43 if (zz(3) /= "nop") error stop 44 else if (num == 2) then if (zz(1) /= "def") error stop 45 if (zz(2) /= "ghi") error stop 46 if (zz(3) /= "jlm") error stop 47 else error stop 48 endif zz(1) = "ABC" zz(2) = "DEF" zz(3) = "GHI" res%z = get_loc (zz) rank default error stop 99 end select contains integer (c_intptr_t) function get_loc (arg) character(len=*), target :: arg(:) ! %loc does copy in/out if not simply contiguous ! extra func needed because of 'target' attribute get_loc = transfer (c_loc(arg), res%x) end end type(loc_t) function char_assumed_rank_in_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(..) character(len=3) :: yy(..) character(len=k) :: zz(..) intent(in) :: xx, yy, zz if (3 /= size(yy)) error stop 50 if (3 /= len(yy)) error stop 51 if (1 /= rank(yy)) error stop 59 if (1 /= lbound(xx, dim=1)) stop 49 if (1 /= lbound(yy, dim=1)) stop 49 if (1 /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (3 /= ubound(yy, dim=1)) stop 49 if (3 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (is_contiguous (xx)) error stop 59 if (is_contiguous (yy)) error stop 59 if (is_contiguous (zz)) error stop 59 else if (num == 2) then if (.not. is_contiguous (xx)) error stop 59 if (.not. is_contiguous (yy)) error stop 59 if (.not. is_contiguous (zz)) error stop 59 else error stop 48 end if select rank (xx) rank (1) print *, xx(1:3) if (num == 1) then if (xx(1) /= "abc") error stop 52 if (xx(2) /= "ghi") error stop 53 if (xx(3) /= "nop") error stop 54 else if (num == 2) then if (xx(1) /= "def") error stop 55 if (xx(2) /= "ghi") error stop 56 if (xx(3) /= "jlm") error stop 57 else error stop 58 endif res%x = get_loc(xx) rank default error stop 99 end select select rank (yy) rank (1) print *, yy(1:3) if (num == 1) then if (yy(1) /= "abc") error stop 52 if (yy(2) /= "ghi") error stop 53 if (yy(3) /= "nop") error stop 54 else if (num == 2) then if (yy(1) /= "def") error stop 55 if (yy(2) /= "ghi") error stop 56 if (yy(3) /= "jlm") error stop 57 else error stop 58 endif res%y = get_loc(yy) rank default error stop 99 end select select rank (zz) rank (1) print *, zz(1:3) if (num == 1) then if (zz(1) /= "abc") error stop 52 if (zz(2) /= "ghi") error stop 53 if (zz(3) /= "nop") error stop 54 else if (num == 2) then if (zz(1) /= "def") error stop 55 if (zz(2) /= "ghi") error stop 56 if (zz(3) /= "jlm") error stop 57 else error stop 58 endif res%z = get_loc(zz) rank default error stop 99 end select contains integer (c_intptr_t) function get_loc (arg) character(len=*), target :: arg(:) ! %loc does copy in/out if not simply contiguous ! extra func needed because of 'target' attribute get_loc = transfer (c_loc(arg), res%x) end end type(loc_t) function char_assumed_rank_cont_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(..) character(len=3) :: yy(..) character(len=k) :: zz(..) contiguous :: xx, yy, zz if (3 /= len(xx)) error stop 60 if (3 /= len(yy)) error stop 60 if (3 /= len(zz)) error stop 60 if (3 /= size(xx)) error stop 61 if (3 /= size(yy)) error stop 61 if (3 /= size(zz)) error stop 61 if (1 /= rank(xx)) error stop 69 if (1 /= rank(yy)) error stop 69 if (1 /= rank(zz)) error stop 69 if (1 /= lbound(xx, dim=1)) stop 49 if (1 /= lbound(yy, dim=1)) stop 49 if (1 /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (3 /= ubound(yy, dim=1)) stop 49 if (3 /= ubound(zz, dim=1)) stop 49 select rank (xx) rank (1) print *, xx(1:3) if (num == 1) then if (xx(1) /= "abc") error stop 62 if (xx(2) /= "ghi") error stop 63 if (xx(3) /= "nop") error stop 64 else if (num == 2) then if (xx(1) /= "def") error stop 65 if (xx(2) /= "ghi") error stop 66 if (xx(3) /= "jlm") error stop 67 else error stop 68 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" res%x = %loc(xx) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select select rank (yy) rank (1) print *, yy(1:3) if (num == 1) then if (yy(1) /= "abc") error stop 62 if (yy(2) /= "ghi") error stop 63 if (yy(3) /= "nop") error stop 64 else if (num == 2) then if (yy(1) /= "def") error stop 65 if (yy(2) /= "ghi") error stop 66 if (yy(3) /= "jlm") error stop 67 else error stop 68 endif yy(1) = "ABC" yy(2) = "DEF" yy(3) = "GHI" res%y = %loc(yy) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select select rank (zz) rank (1) print *, zz(1:3) if (num == 1) then if (zz(1) /= "abc") error stop 62 if (zz(2) /= "ghi") error stop 63 if (zz(3) /= "nop") error stop 64 else if (num == 2) then if (zz(1) /= "def") error stop 65 if (zz(2) /= "ghi") error stop 66 if (zz(3) /= "jlm") error stop 67 else error stop 68 endif zz(1) = "ABC" zz(2) = "DEF" zz(3) = "GHI" res%z = %loc(zz) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select end type(loc_t) function char_assumed_rank_cont_in_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(..) character(len=3) :: yy(..) character(len=k) :: zz(..) intent(in) :: xx, yy, zz contiguous :: xx, yy, zz if (3 /= size(xx)) error stop 30 if (3 /= size(yy)) error stop 30 if (3 /= size(zz)) error stop 30 if (3 /= len(xx)) error stop 31 if (3 /= len(yy)) error stop 31 if (3 /= len(zz)) error stop 31 if (1 /= rank(xx)) error stop 69 if (1 /= rank(yy)) error stop 69 if (1 /= rank(zz)) error stop 69 if (1 /= lbound(xx, dim=1)) stop 49 if (1 /= lbound(yy, dim=1)) stop 49 if (1 /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (3 /= ubound(yy, dim=1)) stop 49 if (3 /= ubound(zz, dim=1)) stop 49 select rank (xx) rank (1) print *, xx(1:3) if (num == 1) then if (xx(1) /= "abc") error stop 62 if (xx(2) /= "ghi") error stop 63 if (xx(3) /= "nop") error stop 64 else if (num == 2) then if (xx(1) /= "def") error stop 65 if (xx(2) /= "ghi") error stop 66 if (xx(3) /= "jlm") error stop 67 else error stop 68 endif res%x = %loc(xx) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select select rank (yy) rank (1) print *, yy(1:3) if (num == 1) then if (yy(1) /= "abc") error stop 62 if (yy(2) /= "ghi") error stop 63 if (yy(3) /= "nop") error stop 64 else if (num == 2) then if (yy(1) /= "def") error stop 65 if (yy(2) /= "ghi") error stop 66 if (yy(3) /= "jlm") error stop 67 else error stop 68 endif res%y = %loc(yy) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select select rank (zz) rank (1) print *, zz(1:3) if (num == 1) then if (zz(1) /= "abc") error stop 62 if (zz(2) /= "ghi") error stop 63 if (zz(3) /= "nop") error stop 64 else if (num == 2) then if (zz(1) /= "def") error stop 65 if (zz(2) /= "ghi") error stop 66 if (zz(3) /= "jlm") error stop 67 else error stop 68 endif res%z = %loc(zz) ! { dg-warning "Legacy Extension" } rank default error stop 99 end select end type(loc_t) function char_assumed_shape_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(:) character(len=3) :: yy(5:) character(len=k) :: zz(-k:) print *, xx(1:3) if (3 /= len(xx)) error stop 70 if (3 /= len(yy)) error stop 70 if (3 /= len(zz)) error stop 70 if (3 /= size(xx)) error stop 71 if (3 /= size(yy)) error stop 71 if (3 /= size(zz)) error stop 71 if (1 /= lbound(xx, dim=1)) stop 49 if (5 /= lbound(yy, dim=1)) stop 49 if (-k /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (7 /= ubound(yy, dim=1)) stop 49 if (-k+2 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (is_contiguous (xx)) error stop 79 if (is_contiguous (yy)) error stop 79 if (is_contiguous (zz)) error stop 79 if (xx(1) /= "abc") error stop 72 if (xx(2) /= "ghi") error stop 73 if (xx(3) /= "nop") error stop 74 if (yy(5) /= "abc") error stop 72 if (yy(6) /= "ghi") error stop 73 if (yy(7) /= "nop") error stop 74 if (zz(-k) /= "abc") error stop 72 if (zz(-k+1) /= "ghi") error stop 73 if (zz(-k+2) /= "nop") error stop 74 else if (num == 2) then if (.not.is_contiguous (xx)) error stop 79 if (.not.is_contiguous (yy)) error stop 79 if (.not.is_contiguous (zz)) error stop 79 if (xx(1) /= "def") error stop 72 if (xx(2) /= "ghi") error stop 73 if (xx(3) /= "jlm") error stop 74 if (yy(5) /= "def") error stop 72 if (yy(6) /= "ghi") error stop 73 if (yy(7) /= "jlm") error stop 74 if (zz(-k) /= "def") error stop 72 if (zz(-k+1) /= "ghi") error stop 73 if (zz(-k+2) /= "jlm") error stop 74 else error stop 78 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" yy(5) = "ABC" yy(6) = "DEF" yy(7) = "GHI" zz(-k) = "ABC" zz(-k+1) = "DEF" zz(-k+2) = "GHI" res%x = get_loc(xx) res%y = get_loc(yy) res%z = get_loc(zz) contains integer (c_intptr_t) function get_loc (arg) character(len=*), target :: arg(:) ! %loc does copy in/out if not simply contiguous ! extra func needed because of 'target' attribute get_loc = transfer (c_loc(arg), res%x) end end type(loc_t) function char_assumed_shape_in_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(:) character(len=3) :: yy(5:) character(len=k) :: zz(-k:) intent(in) :: xx, yy, zz print *, xx(1:3) if (3 /= size(xx)) error stop 80 if (3 /= size(yy)) error stop 80 if (3 /= size(zz)) error stop 80 if (3 /= len(xx)) error stop 81 if (3 /= len(yy)) error stop 81 if (3 /= len(zz)) error stop 81 if (1 /= lbound(xx, dim=1)) stop 49 if (5 /= lbound(yy, dim=1)) stop 49 if (-k /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (7 /= ubound(yy, dim=1)) stop 49 if (-k+2 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (is_contiguous (xx)) error stop 89 if (is_contiguous (yy)) error stop 89 if (is_contiguous (zz)) error stop 89 if (xx(1) /= "abc") error stop 82 if (xx(2) /= "ghi") error stop 83 if (xx(3) /= "nop") error stop 84 if (yy(5) /= "abc") error stop 82 if (yy(6) /= "ghi") error stop 83 if (yy(7) /= "nop") error stop 84 if (zz(-k) /= "abc") error stop 82 if (zz(-k+1) /= "ghi") error stop 83 if (zz(-k+2) /= "nop") error stop 84 else if (num == 2) then if (.not.is_contiguous (xx)) error stop 89 if (.not.is_contiguous (yy)) error stop 89 if (.not.is_contiguous (zz)) error stop 89 if (xx(1) /= "def") error stop 85 if (xx(2) /= "ghi") error stop 86 if (xx(3) /= "jlm") error stop 87 if (yy(5) /= "def") error stop 85 if (yy(6) /= "ghi") error stop 86 if (yy(7) /= "jlm") error stop 87 if (zz(-k) /= "def") error stop 85 if (zz(-k+1) /= "ghi") error stop 86 if (zz(-k+2) /= "jlm") error stop 87 else error stop 88 endif res%x = get_loc(xx) res%y = get_loc(yy) res%z = get_loc(zz) contains integer (c_intptr_t) function get_loc (arg) character(len=*), target :: arg(:) ! %loc does copy in/out if not simply contiguous ! extra func needed because of 'target' attribute get_loc = transfer (c_loc(arg), res%x) end end type(loc_t) function char_assumed_shape_cont_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(:) character(len=3) :: yy(5:) character(len=k) :: zz(-k:) contiguous :: xx, yy, zz print *, xx(1:3) if (3 /= len(xx)) error stop 90 if (3 /= len(yy)) error stop 90 if (3 /= len(zz)) error stop 90 if (3 /= size(xx)) error stop 91 if (3 /= size(yy)) error stop 91 if (3 /= size(zz)) error stop 91 if (1 /= lbound(xx, dim=1)) stop 49 if (5 /= lbound(yy, dim=1)) stop 49 if (-k /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (7 /= ubound(yy, dim=1)) stop 49 if (-k+2 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (xx(1) /= "abc") error stop 92 if (xx(2) /= "ghi") error stop 93 if (xx(3) /= "nop") error stop 94 if (yy(5) /= "abc") error stop 92 if (yy(6) /= "ghi") error stop 93 if (yy(7) /= "nop") error stop 94 if (zz(-k) /= "abc") error stop 92 if (zz(-k+1) /= "ghi") error stop 93 if (zz(-k+2) /= "nop") error stop 94 else if (num == 2) then if (xx(1) /= "def") error stop 92 if (xx(2) /= "ghi") error stop 93 if (xx(3) /= "jlm") error stop 94 if (yy(5) /= "def") error stop 92 if (yy(6) /= "ghi") error stop 93 if (yy(7) /= "jlm") error stop 94 if (zz(-k) /= "def") error stop 92 if (zz(-k+1) /= "ghi") error stop 93 if (zz(-k+2) /= "jlm") error stop 94 else error stop 98 endif xx(1) = "ABC" xx(2) = "DEF" xx(3) = "GHI" yy(5) = "ABC" yy(6) = "DEF" yy(7) = "GHI" zz(-k) = "ABC" zz(-k+1) = "DEF" zz(-k+2) = "GHI" res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } end type(loc_t) function char_assumed_shape_cont_in_f (xx, yy, zz, k, num) bind(c) result(res) integer, value :: num, k character(len=*) :: xx(:) character(len=3) :: yy(5:) character(len=k) :: zz(-k:) intent(in) :: xx, yy, zz contiguous :: xx, yy, zz print *, xx(1:3) if (3 /= size(xx)) error stop 100 if (3 /= size(yy)) error stop 100 if (3 /= size(zz)) error stop 100 if (3 /= len(xx)) error stop 101 if (3 /= len(yy)) error stop 101 if (3 /= len(zz)) error stop 101 if (1 /= lbound(xx, dim=1)) stop 49 if (5 /= lbound(yy, dim=1)) stop 49 if (-k /= lbound(zz, dim=1)) stop 49 if (3 /= ubound(xx, dim=1)) stop 49 if (7 /= ubound(yy, dim=1)) stop 49 if (-k+2 /= ubound(zz, dim=1)) stop 49 if (num == 1) then if (xx(1) /= "abc") error stop 102 if (xx(2) /= "ghi") error stop 103 if (xx(3) /= "nop") error stop 104 if (yy(5) /= "abc") error stop 102 if (yy(6) /= "ghi") error stop 103 if (yy(7) /= "nop") error stop 104 if (zz(-k) /= "abc") error stop 102 if (zz(-k+1) /= "ghi") error stop 103 if (zz(-k+2) /= "nop") error stop 104 else if (num == 2) then if (xx(1) /= "def") error stop 105 if (xx(2) /= "ghi") error stop 106 if (xx(3) /= "jlm") error stop 107 if (yy(5) /= "def") error stop 105 if (yy(6) /= "ghi") error stop 106 if (yy(7) /= "jlm") error stop 107 if (zz(-k) /= "def") error stop 105 if (zz(-k+1) /= "ghi") error stop 106 if (zz(-k+2) /= "jlm") error stop 107 else error stop 108 endif res%x = %loc(xx) ! { dg-warning "Legacy Extension" } res%y = %loc(yy) ! { dg-warning "Legacy Extension" } res%z = %loc(zz) ! { dg-warning "Legacy Extension" } end end module use m implicit none (type, external) character(len=3) :: a(6), a2(6), a3(6), a_init(6) type(loc_t) :: loc3 a_init = ['abc', 'def', 'ghi', 'jlm', 'nop', 'qrs'] ! -- Fortran: assumed size a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_f (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_in_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_in_f (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- Fortran: explicit shape a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_f (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_in_f (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_in_f (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- Fortran: assumed rank a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_f (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_in_f (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- Fortran: assumed rank contiguous a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_f (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_in_f (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- Fortran: assumed shape a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_f (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_in_f (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- Fortran: assumed shape contiguous a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_f (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_in_f (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_in_f (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! --- character - call C directly -- ! -- C: assumed size a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_c (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_in_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_size_in_c (a(2:4), a2(2:4), a3(2:4), size(a(2:4)), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- C: explicit shape a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_c (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_in_c (a(::2), a2(::2), a3(::2), size(a(::2)), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 a = a_init; a2 = a_init; a3 = a_init loc3 = char_expl_size_in_c (a(2:4), a2(2:4), a3(2:4), size(a(::2)), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- C: assumed rank a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_c (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_in_c (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- C: assumed rank contiguous a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_c (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_in_c (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_rank_cont_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- C: assumed shape a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_c (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_in_c (a(::2), a2(::2), a3(::2), len(a), num=1) if (loc3%x /= %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 ! -- C: assumed shape contiguous a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_c (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 51 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 51 ! { dg-warning "Legacy Extension" } if (any (a /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a2 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 if (any (a3 /= ['ABC', 'def', 'DEF', 'jlm', 'GHI', 'qrs'])) error stop 52 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 53 ! { dg-warning "Legacy Extension" } if (any (a /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a2 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 if (any (a3 /= ['abc', 'ABC', 'DEF', 'GHI', 'nop', 'qrs'])) error stop 54 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_in_c (a(::2), a2(::2), a3(::2), len(a), num=1) ! NOTE: run-time copy-in warning if (loc3%x == %loc(a)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%y == %loc(a2)) error stop 55 ! { dg-warning "Legacy Extension" } if (loc3%z == %loc(a3)) error stop 55 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 56 if (any (a2 /= a_init)) error stop 56 if (any (a3 /= a_init)) error stop 56 a = a_init; a2 = a_init; a3 = a_init loc3 = char_assumed_shape_cont_in_c (a(2:4), a2(2:4), a3(2:4), len(a), num=2) if (loc3%x /= %loc(a(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%y /= %loc(a2(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (loc3%z /= %loc(a3(2))) error stop 57 ! { dg-warning "Legacy Extension" } if (any (a /= a_init)) error stop 58 if (any (a2 /= a_init)) error stop 58 if (any (a3 /= a_init)) error stop 58 end ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_f'(\r*\n+)" }" ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_f'(\r*\n+)" }" ! { dg-output "At line 928 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_in_f'(\r*\n+)" }" ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_in_f'(\r*\n+)" }" ! { dg-output "At line 946 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_in_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_f'(\r*\n+)" }" ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_f'(\r*\n+)" }" ! { dg-output "At line 965 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_in_f'(\r*\n+)" }" ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_in_f'(\r*\n+)" }" ! { dg-output "At line 983 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_in_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }" ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }" ! { dg-output "At line 1039 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }" ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }" ! { dg-output "At line 1057 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_in_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }" ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }" ! { dg-output "At line 1113 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }" ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }" ! { dg-output "At line 1131 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_in_f'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_c'(\r*\n+)" }" ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_c'(\r*\n+)" }" ! { dg-output "At line 1153 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_size_in_c'(\r*\n+)" }" ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_size_in_c'(\r*\n+)" }" ! { dg-output "At line 1171 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_size_in_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_c'(\r*\n+)" }" ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_c'(\r*\n+)" }" ! { dg-output "At line 1190 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_expl_size_in_c'(\r*\n+)" }" ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_expl_size_in_c'(\r*\n+)" }" ! { dg-output "At line 1208 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_expl_size_in_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }" ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }" ! { dg-output "At line 1264 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }" ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }" ! { dg-output "At line 1282 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_rank_cont_in_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }" ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }" ! { dg-output "At line 1338 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }" ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'xx' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }" ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'yy' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }" ! { dg-output "At line 1356 of file .*bind-c-contiguous-1.f90(\r*\n+)" }" ! { dg-output "Fortran runtime warning: An array temporary was created for argument 'zz' of procedure 'char_assumed_shape_cont_in_c'(\r*\n+)" }" ! { dg-output " abcghinop(\r*\n+)" }" ! { dg-output " defghijlm(\r*\n+)" }"