1! Test alternate entry points for functions when the result types 2! of all entry points match 3 4 character*(*) function f1 (str, i, j) 5 character str*(*), e1*(*), e2*(*) 6 integer i, j 7 f1 = str (i:j) 8 return 9 entry e1 (str, i, j) 10 i = i + 1 11 entry e2 (str, i, j) 12 j = j - 1 13 e2 = str (i:j) 14 end function 15 16 character*5 function f3 () 17 character e3*(*), e4*(*) 18 integer i 19 f3 = 'ABCDE' 20 return 21 entry e3 (i) 22 entry e4 (i) 23 if (i .gt. 0) then 24 e3 = 'abcde' 25 else 26 e4 = 'UVWXY' 27 endif 28 end function 29 30 program entrytest 31 character f1*16, e1*16, e2*16, str*16, ret*16 32 character f3*5, e3*5, e4*5 33 integer i, j 34 str = 'ABCDEFGHIJ' 35 i = 2 36 j = 6 37 ret = f1 (str, i, j) 38 if ((i .ne. 2) .or. (j .ne. 6)) call abort () 39 if (ret .ne. 'BCDEF') call abort () 40 ret = e1 (str, i, j) 41 if ((i .ne. 3) .or. (j .ne. 5)) call abort () 42 if (ret .ne. 'CDE') call abort () 43 ret = e2 (str, i, j) 44 if ((i .ne. 3) .or. (j .ne. 4)) call abort () 45 if (ret .ne. 'CD') call abort () 46 if (f3 () .ne. 'ABCDE') call abort () 47 if (e3 (1) .ne. 'abcde') call abort () 48 if (e4 (1) .ne. 'abcde') call abort () 49 if (e3 (0) .ne. 'UVWXY') call abort () 50 if (e4 (0) .ne. 'UVWXY') call abort () 51 end program 52