! Related to PR 15326. Test calls to string functions whose lengths
|
! Related to PR 15326. Test calls to string functions whose lengths
|
! depend on various types of scalar value.
|
! depend on various types of scalar value.
|
! { dg-do run }
|
! { dg-do run }
|
pure function select (selector, iftrue, iffalse)
|
pure function select (selector, iftrue, iffalse)
|
logical, intent (in) :: selector
|
logical, intent (in) :: selector
|
integer, intent (in) :: iftrue, iffalse
|
integer, intent (in) :: iftrue, iffalse
|
integer :: select
|
integer :: select
|
|
|
if (selector) then
|
if (selector) then
|
select = iftrue
|
select = iftrue
|
else
|
else
|
select = iffalse
|
select = iffalse
|
end if
|
end if
|
end function select
|
end function select
|
|
|
program main
|
program main
|
implicit none
|
implicit none
|
|
|
interface
|
interface
|
pure function select (selector, iftrue, iffalse)
|
pure function select (selector, iftrue, iffalse)
|
logical, intent (in) :: selector
|
logical, intent (in) :: selector
|
integer, intent (in) :: iftrue, iffalse
|
integer, intent (in) :: iftrue, iffalse
|
integer :: select
|
integer :: select
|
end function select
|
end function select
|
end interface
|
end interface
|
|
|
type pair
|
type pair
|
integer :: left, right
|
integer :: left, right
|
end type pair
|
end type pair
|
|
|
integer, target :: i
|
integer, target :: i
|
integer, pointer :: ip
|
integer, pointer :: ip
|
real, target :: r
|
real, target :: r
|
real, pointer :: rp
|
real, pointer :: rp
|
logical, target :: l
|
logical, target :: l
|
logical, pointer :: lp
|
logical, pointer :: lp
|
complex, target :: c
|
complex, target :: c
|
complex, pointer :: cp
|
complex, pointer :: cp
|
character, target :: ch
|
character, target :: ch
|
character, pointer :: chp
|
character, pointer :: chp
|
type (pair), target :: p
|
type (pair), target :: p
|
type (pair), pointer :: pp
|
type (pair), pointer :: pp
|
|
|
character (len = 10) :: dig
|
character (len = 10) :: dig
|
|
|
i = 100
|
i = 100
|
r = 50.5
|
r = 50.5
|
l = .true.
|
l = .true.
|
c = (10.9, 11.2)
|
c = (10.9, 11.2)
|
ch = '1'
|
ch = '1'
|
p%left = 40
|
p%left = 40
|
p%right = 50
|
p%right = 50
|
|
|
ip => i
|
ip => i
|
rp => r
|
rp => r
|
lp => l
|
lp => l
|
cp => c
|
cp => c
|
chp => ch
|
chp => ch
|
pp => p
|
pp => p
|
|
|
dig = '1234567890'
|
dig = '1234567890'
|
|
|
call test (f1 (i), 200)
|
call test (f1 (i), 200)
|
call test (f1 (ip), 200)
|
call test (f1 (ip), 200)
|
call test (f1 (-30), 60)
|
call test (f1 (-30), 60)
|
call test (f1 (i / (-4)), 50)
|
call test (f1 (i / (-4)), 50)
|
|
|
call test (f2 (r), 100)
|
call test (f2 (r), 100)
|
call test (f2 (rp), 100)
|
call test (f2 (rp), 100)
|
call test (f2 (70.1), 140)
|
call test (f2 (70.1), 140)
|
call test (f2 (r / 4), 24)
|
call test (f2 (r / 4), 24)
|
call test (f2 (real (i)), 200)
|
call test (f2 (real (i)), 200)
|
|
|
call test (f3 (l), 50)
|
call test (f3 (l), 50)
|
call test (f3 (lp), 50)
|
call test (f3 (lp), 50)
|
call test (f3 (.false.), 55)
|
call test (f3 (.false.), 55)
|
call test (f3 (i < 30), 55)
|
call test (f3 (i < 30), 55)
|
|
|
call test (f4 (c), 10)
|
call test (f4 (c), 10)
|
call test (f4 (cp), 10)
|
call test (f4 (cp), 10)
|
call test (f4 (cmplx (60.0, r)), 60)
|
call test (f4 (cmplx (60.0, r)), 60)
|
call test (f4 (cmplx (r, 1.0)), 50)
|
call test (f4 (cmplx (r, 1.0)), 50)
|
|
|
call test (f5 (ch), 11)
|
call test (f5 (ch), 11)
|
call test (f5 (chp), 11)
|
call test (f5 (chp), 11)
|
call test (f5 ('23'), 12)
|
call test (f5 ('23'), 12)
|
call test (f5 (dig (3:)), 13)
|
call test (f5 (dig (3:)), 13)
|
call test (f5 (dig (10:)), 10)
|
call test (f5 (dig (10:)), 10)
|
|
|
call test (f6 (p), 145)
|
call test (f6 (p), 145)
|
call test (f6 (pp), 145)
|
call test (f6 (pp), 145)
|
call test (f6 (pair (20, 10)), 85)
|
call test (f6 (pair (20, 10)), 85)
|
call test (f6 (pair (i / 2, 1)), 106)
|
call test (f6 (pair (i / 2, 1)), 106)
|
contains
|
contains
|
function f1 (i)
|
function f1 (i)
|
integer :: i
|
integer :: i
|
character (len = abs (i) * 2) :: f1
|
character (len = abs (i) * 2) :: f1
|
f1 = ''
|
f1 = ''
|
end function f1
|
end function f1
|
|
|
function f2 (r)
|
function f2 (r)
|
real :: r
|
real :: r
|
character (len = floor (r) * 2) :: f2
|
character (len = floor (r) * 2) :: f2
|
f2 = ''
|
f2 = ''
|
end function f2
|
end function f2
|
|
|
function f3 (l)
|
function f3 (l)
|
logical :: l
|
logical :: l
|
character (len = select (l, 50, 55)) :: f3
|
character (len = select (l, 50, 55)) :: f3
|
f3 = ''
|
f3 = ''
|
end function f3
|
end function f3
|
|
|
function f4 (c)
|
function f4 (c)
|
complex :: c
|
complex :: c
|
character (len = int (c)) :: f4
|
character (len = int (c)) :: f4
|
f4 = ''
|
f4 = ''
|
end function f4
|
end function f4
|
|
|
function f5 (c)
|
function f5 (c)
|
character :: c
|
character :: c
|
character (len = scan ('123456789', c) + 10) :: f5
|
character (len = scan ('123456789', c) + 10) :: f5
|
f5 = ''
|
f5 = ''
|
end function f5
|
end function f5
|
|
|
function f6 (p)
|
function f6 (p)
|
type (pair) :: p
|
type (pair) :: p
|
integer :: i
|
integer :: i
|
character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
|
character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
|
f6 = ''
|
f6 = ''
|
end function f6
|
end function f6
|
|
|
subroutine test (string, length)
|
subroutine test (string, length)
|
character (len = *) :: string
|
character (len = *) :: string
|
integer, intent (in) :: length
|
integer, intent (in) :: length
|
if (len (string) .ne. length) call abort
|
if (len (string) .ne. length) call abort
|
end subroutine test
|
end subroutine test
|
end program main
|
end program main
|
|
|
