Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ! { dg-do run } | |
| 2 ! testcase from PR 19032 adapted for testsuite | |
| 3 ! Our implementation of modulo was wrong for P = 1 and P = -1, | |
| 4 ! both in the real and the integer case | |
| 5 program main | |
| 6 integer, parameter :: n=16 | |
| 7 real, dimension(n) :: ar, br, modulo_result, floor_result | |
| 8 integer, dimension(n) :: ai, bi , imodulo_result, ifloor_result | |
| 9 | |
| 10 ai(1:4) = 5 | |
| 11 ai(5:8) = -5 | |
| 12 ai(9:12) = 1 | |
| 13 ai(13:16) = -1 | |
| 14 bi(1:4) = (/ 3,-3, 1, -1/) | |
| 15 bi(5:8) = bi(1:4) | |
| 16 bi(9:12) = bi(1:4) | |
| 17 bi(13:16) = bi(1:4) | |
| 18 ar = ai | |
| 19 br = bi | |
| 20 modulo_result = modulo(ar,br) | |
| 21 imodulo_result = modulo(ai,bi) | |
| 22 floor_result = ar-floor(ar/br)*br | |
| 23 ifloor_result = nint(real(ai-floor(real(ai)/real(bi))*bi)) | |
| 24 | |
| 25 do i=1,n | |
| 26 if (modulo_result(i) /= floor_result(i) ) then | |
| 27 ! print "(A,4F5.0)" ,"real case failed: ", & | |
| 28 ! ar(i),br(i), modulo_result(i), floor_result(i) | |
| 29 call abort() | |
| 30 end if | |
| 31 if (imodulo_result(i) /= ifloor_result(i)) then | |
| 32 ! print "(A,4I5)", "int case failed: ", & | |
| 33 ! ai(i), bi(i), imodulo_result(i), ifloor_result(i) | |
| 34 call abort () | |
| 35 end if | |
| 36 end do | |
| 37 end program main |