Artifact 4a5f2429e1a7d9c0dc671d8121074c3ce6d75980:

• File fmt/test-round.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 705)

0000: 0a 28 75 73 65 20 66 6d 74 20 74 65 73 74 29 0a  .(use fmt test).
0010: 3b 3b 28 75 73 65 20 6e 75 6d 62 65 72 73 29 20  ;;(use numbers) 
0020: 3b 20 74 65 73 74 20 77 69 74 68 20 61 6e 64 20  ; test with and 
0030: 77 69 74 68 6f 75 74 20 6e 75 6d 62 65 72 73 20  without numbers 
0040: 76 69 61 20 2d 52 20 6e 75 6d 62 65 72 73 0a 0a  via -R numbers..
0050: 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 72  (define (check-r
0060: 65 70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6e 29  epresentation n)
0070: 0a 20 20 28 64 65 66 69 6e 65 20 70 65 6e 63 65  .  (define pence
0080: 0a 20 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65  .    (inexact->e
0090: 78 61 63 74 20 28 72 6f 75 6e 64 20 28 2f 20 28  xact (round (/ (
00a0: 6d 6f 64 75 6c 6f 20 6e 20 31 30 30 30 29 20 31  modulo n 1000) 1
00b0: 30 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20  0)))).  (define 
00c0: 70 6f 75 6e 64 73 20 28 71 75 6f 74 69 65 6e 74  pounds (quotient
00d0: 20 6e 20 31 30 30 30 29 29 0a 0a 20 20 28 69 66   n 1000))..  (if
00e0: 20 28 3e 20 70 65 6e 63 65 20 39 39 29 0a 20 20   (> pence 99).  
00f0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20      (begin.     
0100: 20 20 20 28 73 65 74 21 20 70 65 6e 63 65 20 28     (set! pence (
0110: 2d 20 31 30 30 20 70 65 6e 63 65 29 29 0a 20 20  - 100 pence)).  
0120: 20 20 20 20 20 20 28 73 65 74 21 20 70 6f 75 6e        (set! poun
0130: 64 73 20 28 61 64 64 31 20 70 6f 75 6e 64 73 29  ds (add1 pounds)
0140: 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 65  )))..  (define e
0150: 78 70 65 63 74 65 64 2d 72 65 73 75 6c 74 0a 20  xpected-result. 
0160: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28     (cond.     ((
0170: 3d 20 70 65 6e 63 65 20 30 29 20 28 73 70 72 69  = pence 0) (spri
0180: 6e 74 66 20 22 7e 53 2e 30 30 22 20 70 6f 75 6e  ntf "~S.00" poun
0190: 64 73 29 29 0a 20 20 20 20 20 28 28 3c 20 70 65  ds)).     ((< pe
01a0: 6e 63 65 20 31 30 29 20 28 73 70 72 69 6e 74 66  nce 10) (sprintf
01b0: 20 22 7e 53 2e 30 7e 53 22 20 70 6f 75 6e 64 73   "~S.0~S" pounds
01c0: 20 70 65 6e 63 65 29 29 0a 20 20 20 20 20 28 65   pence)).     (e
01d0: 6c 73 65 20 28 73 70 72 69 6e 74 66 20 22 7e 53  lse (sprintf "~S
01e0: 2e 7e 53 22 20 70 6f 75 6e 64 73 20 70 65 6e 63  .~S" pounds penc
01f0: 65 29 29 29 29 0a 0a 20 20 28 74 65 73 74 20 28  e))))..  (test (
0200: 73 70 72 69 6e 74 66 20 22 7e 53 20 3d 20 7e 53  sprintf "~S = ~S
0210: 3f 22 20 28 65 78 61 63 74 2d 3e 69 6e 65 78 61  ?" (exact->inexa
0220: 63 74 20 28 2f 20 6e 20 31 30 30 30 29 29 20 65  ct (/ n 1000)) e
0230: 78 70 65 63 74 65 64 2d 72 65 73 75 6c 74 29 0a  xpected-result).
0240: 20 20 20 20 20 20 65 78 70 65 63 74 65 64 2d 72        expected-r
0250: 65 73 75 6c 74 0a 20 20 20 20 28 66 6d 74 20 23  esult.    (fmt #
0260: 66 20 28 6e 75 6d 20 28 2f 20 6e 20 31 30 30 30  f (num (/ n 1000
0270: 29 20 31 30 20 32 29 29 29 29 0a 0a 28 74 65 73  ) 10 2))))..(tes
0280: 74 2d 62 65 67 69 6e 29 0a 28 66 6f 72 2d 65 61  t-begin).(for-ea
0290: 63 68 20 63 68 65 63 6b 2d 72 65 70 72 65 73 65  ch check-represe
02a0: 6e 74 61 74 69 6f 6e 20 28 69 6f 74 61 20 31 30  ntation (iota 10
02b0: 30 30 30 29 29 0a 28 74 65 73 74 2d 65 6e 64 29  000)).(test-end)
02c0: 0a                                               .