Subversion Repositories openrisc

! { dg-do compile }

! { dg-options "-fdump-tree-original" }

!

! PR fortran/34079

! Character bind(c) arguments shall not pass the length as additional argument

!

subroutine multiArgTest()

  implicit none

interface ! Array

  subroutine multiso_array(x,y) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1), dimension(*) :: x,y

  end subroutine multiso_array

  subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1), dimension(*) :: x,y

  end subroutine multiso2_array

  subroutine mult_array(x,y)

    use iso_c_binding

    character(kind=c_char,len=1), dimension(*) :: x,y

  end subroutine mult_array

end interface

interface ! Scalar: call by reference

  subroutine multiso(x,y) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1) :: x,y

  end subroutine multiso

  subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1) :: x,y

  end subroutine multiso2

  subroutine mult(x,y)

    use iso_c_binding

    character(kind=c_char,len=1) :: x,y

  end subroutine mult

end interface

interface ! Scalar: call by VALUE

  subroutine multiso_val(x,y) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1), value :: x,y

  end subroutine multiso_val

  subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1), value :: x,y

  end subroutine multiso2_val

  subroutine mult_val(x,y)

    use iso_c_binding

    character(kind=c_char,len=1), value :: x,y

  end subroutine mult_val

end interface

call mult_array    ("abc","ab")

call multiso_array ("ABCDEF","ab")

call multiso2_array("AbCdEfGhIj","ab")

call mult    ("u","x")

call multiso ("v","x")

call multiso2("w","x")

call mult_val    ("x","x")

call multiso_val ("y","x")

call multiso2_val("z","x")

end subroutine multiArgTest

program test

implicit none

interface ! Array

  subroutine subiso_array(x) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1), dimension(*) :: x

  end subroutine subiso_array

  subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1), dimension(*) :: x

  end subroutine subiso2_array

  subroutine sub_array(x)

    use iso_c_binding

    character(kind=c_char,len=1), dimension(*) :: x

  end subroutine sub_array

end interface

interface ! Scalar: call by reference

  subroutine subiso(x) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1) :: x

  end subroutine subiso

  subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1) :: x

  end subroutine subiso2

  subroutine sub(x)

    use iso_c_binding

    character(kind=c_char,len=1) :: x

  end subroutine sub

end interface

interface ! Scalar: call by VALUE

  subroutine subiso_val(x) bind(c)

    use iso_c_binding

    character(kind=c_char,len=1), value :: x

  end subroutine subiso_val

  subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" }

    character(len=1), value :: x

  end subroutine subiso2_val

  subroutine sub_val(x)

    use iso_c_binding

    character(kind=c_char,len=1), value :: x

  end subroutine sub_val

end interface

call sub_array    ("abc")

call subiso_array ("ABCDEF")

call subiso2_array("AbCdEfGhIj")

call sub    ("u")

call subiso ("v")

call subiso2("w")

call sub_val    ("x")

call subiso_val ("y")

call subiso2_val("z")

end program test

! Double argument dump:

!

! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } }

! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }

! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }

!

! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } }

! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }

! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }

!

! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }

! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }

! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }

!

! Single argument dump:

!

! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } }

! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } }

! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } }

!

! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } }

! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }

! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }

!

! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }

! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }

! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }

!

! { dg-final { cleanup-tree-dump "original" } }