1! { dg-do run } 2! { dg-options "-O2" } 3! { dg-skip-if "NaN not supported" { spu-*-* } } 4! Tests that the PRs caused by the lack of gfc_simplify_transfer are 5! now fixed. These were brought together in the meta-bug PR31237 6! (TRANSFER intrinsic). 7! Remaining PRs on 20070409 :-18769 30881 31194 31216 31424 31427 8! 9program simplify_transfer 10 CHARACTER(LEN=100) :: buffer="1.0 3.0" 11 call pr18769 () 12 call pr30881 () 13 call pr31194 () 14 call pr31216 () 15 call pr31427 () 16contains 17 subroutine pr18769 () 18! 19! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 20! 21 implicit none 22 type t 23 integer :: i 24 end type t 25 type (t), parameter :: u = t (42) 26 integer, parameter :: idx_list(1) = (/ 1 /) 27 integer :: j(1) = transfer (u, idx_list) 28 if (j(1) .ne. 42) STOP 1 29 end subroutine pr18769 30 31 subroutine pr30881 () 32! 33! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 34! 35 INTEGER, PARAMETER :: K=1 36 INTEGER :: I 37 I=TRANSFER(.TRUE.,K) 38 SELECT CASE(I) 39 CASE(TRANSFER(.TRUE.,K)) 40 CASE(TRANSFER(.FALSE.,K)) 41 STOP 2 42 CASE DEFAULT 43 STOP 3 44 END SELECT 45 I=TRANSFER(.FALSE.,K) 46 SELECT CASE(I) 47 CASE(TRANSFER(.TRUE.,K)) 48 STOP 4 49 CASE(TRANSFER(.FALSE.,K)) 50 CASE DEFAULT 51 STOP 5 52 END SELECT 53 END subroutine pr30881 54 55 subroutine pr31194 () 56! 57! Contributed by Tobias Burnus <burnus@gcc.gnu.org> 58! 59 real(kind(0d0)) :: NaN = transfer(ishft(int(z'FFF80000',8),32),0d0) 60 write (buffer,'(e12.5)') NaN 61 if (buffer(10:12) .ne. "NaN") STOP 6 62 end subroutine pr31194 63 64 subroutine pr31216 () 65! 66! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 67! 68 INTEGER :: I 69 REAL :: C,D 70 buffer = " 1.0 3.0" 71 READ(buffer,*) C,D 72 I=TRANSFER(C/D,I) 73 SELECT CASE(I) 74 CASE (TRANSFER(1.0/3.0,1)) 75 CASE DEFAULT 76 STOP 7 77 END SELECT 78 END subroutine pr31216 79 80 subroutine pr31427 () 81! 82! Contributed by Michael Richmond <michael.a.richmond@nasa.gov> 83! 84 INTEGER(KIND=1) :: i(1) 85 i = (/ TRANSFER("a", 0_1) /) 86 if (i(1) .ne. ichar ("a")) STOP 8 87 END subroutine pr31427 88end program simplify_transfer 89