! Test alternate entry points for functions when the result types
|
! Test alternate entry points for functions when the result types
|
! of all entry points match
|
! of all entry points match
|
|
|
function f1 (str, i, j) result (r)
|
function f1 (str, i, j) result (r)
|
character str*(*), r1*(*), r2*(*), r*(*)
|
character str*(*), r1*(*), r2*(*), r*(*)
|
integer i, j
|
integer i, j
|
r = str (i:j)
|
r = str (i:j)
|
return
|
return
|
entry e1 (str, i, j) result (r1)
|
entry e1 (str, i, j) result (r1)
|
i = i + 1
|
i = i + 1
|
entry e2 (str, i, j) result (r2)
|
entry e2 (str, i, j) result (r2)
|
j = j - 1
|
j = j - 1
|
r2 = str (i:j)
|
r2 = str (i:j)
|
end function
|
end function
|
|
|
function f3 () result (r)
|
function f3 () result (r)
|
character r3*5, r4*5, r*5
|
character r3*5, r4*5, r*5
|
integer i
|
integer i
|
r = 'ABCDE'
|
r = 'ABCDE'
|
return
|
return
|
entry e3 (i) result (r3)
|
entry e3 (i) result (r3)
|
entry e4 (i) result (r4)
|
entry e4 (i) result (r4)
|
if (i .gt. 0) then
|
if (i .gt. 0) then
|
r3 = 'abcde'
|
r3 = 'abcde'
|
else
|
else
|
r4 = 'UVWXY'
|
r4 = 'UVWXY'
|
endif
|
endif
|
end function
|
end function
|
|
|
program entrytest
|
program entrytest
|
character f1*16, e1*16, e2*16, str*16, ret*16
|
character f1*16, e1*16, e2*16, str*16, ret*16
|
character f3*5, e3*5, e4*5
|
character f3*5, e3*5, e4*5
|
integer i, j
|
integer i, j
|
str = 'ABCDEFGHIJ'
|
str = 'ABCDEFGHIJ'
|
i = 2
|
i = 2
|
j = 6
|
j = 6
|
ret = f1 (str, i, j)
|
ret = f1 (str, i, j)
|
if ((i .ne. 2) .or. (j .ne. 6)) call abort ()
|
if ((i .ne. 2) .or. (j .ne. 6)) call abort ()
|
if (ret .ne. 'BCDEF') call abort ()
|
if (ret .ne. 'BCDEF') call abort ()
|
ret = e1 (str, i, j)
|
ret = e1 (str, i, j)
|
if ((i .ne. 3) .or. (j .ne. 5)) call abort ()
|
if ((i .ne. 3) .or. (j .ne. 5)) call abort ()
|
if (ret .ne. 'CDE') call abort ()
|
if (ret .ne. 'CDE') call abort ()
|
ret = e2 (str, i, j)
|
ret = e2 (str, i, j)
|
if ((i .ne. 3) .or. (j .ne. 4)) call abort ()
|
if ((i .ne. 3) .or. (j .ne. 4)) call abort ()
|
if (ret .ne. 'CD') call abort ()
|
if (ret .ne. 'CD') call abort ()
|
if (f3 () .ne. 'ABCDE') call abort ()
|
if (f3 () .ne. 'ABCDE') call abort ()
|
if (e3 (1) .ne. 'abcde') call abort ()
|
if (e3 (1) .ne. 'abcde') call abort ()
|
if (e4 (1) .ne. 'abcde') call abort ()
|
if (e4 (1) .ne. 'abcde') call abort ()
|
if (e3 (0) .ne. 'UVWXY') call abort ()
|
if (e3 (0) .ne. 'UVWXY') call abort ()
|
if (e4 (0) .ne. 'UVWXY') call abort ()
|
if (e4 (0) .ne. 'UVWXY') call abort ()
|
end program
|
end program
|
|
|
