Megatest

Hex Artifact Content
Login

Artifact e4ff5d5a7ee378177766250d3e3117b695840ec9:


0000: 28 75 73 65 20 73 72 66 69 2d 39 29 0a 0a 28 64  (use srfi-9)..(d
0010: 65 66 69 6e 65 20 6e 75 6d 74 6f 64 6f 20 28 73  efine numtodo (s
0020: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63  tring->number (c
0030: 61 64 64 72 20 28 61 72 67 76 29 29 29 29 0a 0a  addr (argv))))..
0040: 3b 3b 20 75 73 69 6e 67 20 76 65 63 74 6f 72 73  ;; using vectors
0050: 0a 28 64 65 66 69 6e 65 20 74 65 73 74 76 61 6c  .(define testval
0060: 76 65 63 20 28 76 65 63 74 6f 72 20 30 20 31 20  vec (vector 0 1 
0070: 32 20 33 20 34 20 35 29 29 0a 28 64 65 66 69 6e  2 3 4 5)).(defin
0080: 65 2d 69 6e 6c 69 6e 65 20 28 74 65 73 74 69 6e  e-inline (testin
0090: 67 3a 67 65 74 2d 66 69 72 73 74 20 20 76 65 63  g:get-first  vec
00a0: 20 20 20 20 29 28 76 65 63 74 6f 72 2d 72 65 66      )(vector-ref
00b0: 20 20 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e    vec 0)).(defin
00c0: 65 2d 69 6e 6c 69 6e 65 20 28 74 65 73 74 69 6e  e-inline (testin
00d0: 67 3a 67 65 74 2d 63 6f 75 6e 74 20 20 76 65 63  g:get-count  vec
00e0: 20 20 20 20 29 28 76 65 63 74 6f 72 2d 72 65 66      )(vector-ref
00f0: 20 20 76 65 63 20 35 29 29 0a 28 64 65 66 69 6e    vec 5)).(defin
0100: 65 2d 69 6e 6c 69 6e 65 20 28 74 65 73 74 69 6e  e-inline (testin
0110: 67 3a 73 65 74 2d 66 69 72 73 74 21 20 76 65 63  g:set-first! vec
0120: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74   val)(vector-set
0130: 21 20 76 65 63 20 30 20 76 61 6c 29 29 0a 28 64  ! vec 0 val)).(d
0140: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 65  efine-inline (te
0150: 73 74 69 6e 67 3a 73 65 74 2d 63 6f 75 6e 74 21  sting:set-count!
0160: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72   vec val)(vector
0170: 2d 73 65 74 21 20 76 65 63 20 35 20 76 61 6c 29  -set! vec 5 val)
0180: 29 0a 0a 28 69 66 20 28 65 71 75 61 6c 3f 20 28  )..(if (equal? (
0190: 63 61 64 72 20 28 61 72 67 76 29 29 20 22 76 65  cadr (argv)) "ve
01a0: 63 74 6f 72 73 22 29 0a 20 20 20 20 28 62 65 67  ctors").    (beg
01b0: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20  in.      (print 
01c0: 22 54 65 73 74 69 6e 67 20 22 20 6e 75 6d 74 6f  "Testing " numto
01d0: 64 6f 20 22 20 76 65 63 74 6f 72 73 22 29 0a 20  do " vectors"). 
01e0: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28       (let loop (
01f0: 28 69 20 30 29 29 09 0a 20 20 20 20 20 20 20 20  (i 0))..        
0200: 28 74 65 73 74 69 6e 67 3a 73 65 74 2d 63 6f 75  (testing:set-cou
0210: 6e 74 21 20 74 65 73 74 76 61 6c 76 65 63 20 69  nt! testvalvec i
0220: 29 0a 20 20 20 20 20 20 20 20 28 74 65 73 74 69  ).        (testi
0230: 6e 67 3a 73 65 74 2d 66 69 72 73 74 21 20 74 65  ng:set-first! te
0240: 73 74 76 61 6c 76 65 63 20 28 74 65 73 74 69 6e  stvalvec (testin
0250: 67 3a 67 65 74 2d 63 6f 75 6e 74 20 74 65 73 74  g:get-count test
0260: 76 61 6c 76 65 63 29 29 0a 20 20 20 20 20 20 20  valvec)).       
0270: 20 28 69 66 20 28 3c 20 69 20 6e 75 6d 74 6f 64   (if (< i numtod
0280: 6f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28  o).            (
0290: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29  loop (+ i 1)))))
02a0: 29 0a 0a 3b 3b 20 75 73 69 6e 67 20 72 65 63 6f  )..;; using reco
02b0: 72 64 73 0a 28 64 65 66 69 6e 65 2d 72 65 63 6f  rds.(define-reco
02c0: 72 64 2d 74 79 70 65 20 20 74 65 73 74 69 6e 67  rd-type  testing
02d0: 0a 20 20 28 6d 61 6b 65 2d 74 65 73 74 69 6e 67  .  (make-testing
02e0: 20 7a 65 72 6f 65 74 68 20 66 69 72 73 74 20 73   zeroeth first s
02f0: 65 63 6f 6e 64 20 74 68 69 72 64 20 66 6f 75 72  econd third four
0300: 74 68 20 63 6f 75 6e 74 29 0a 20 20 74 65 73 74  th count).  test
0310: 69 6e 67 3f 0a 20 20 28 63 6f 75 6e 74 20 67 65  ing?.  (count ge
0320: 74 3a 63 6f 75 6e 74 20 73 65 74 3a 63 6f 75 6e  t:count set:coun
0330: 74 29 0a 20 20 28 66 69 72 73 74 20 67 65 74 3a  t).  (first get:
0340: 66 69 72 73 74 20 73 65 74 3a 66 69 72 73 74 29  first set:first)
0350: 29 0a 0a 28 64 65 66 69 6e 65 20 74 65 73 74 76  )..(define testv
0360: 61 6c 72 65 63 20 28 6d 61 6b 65 2d 74 65 73 74  alrec (make-test
0370: 69 6e 67 20 30 20 31 20 32 20 33 20 34 20 35 29  ing 0 1 2 3 4 5)
0380: 29 0a 0a 28 69 66 20 28 65 71 75 61 6c 3f 20 28  )..(if (equal? (
0390: 63 61 64 72 20 28 61 72 67 76 29 29 20 22 72 65  cadr (argv)) "re
03a0: 63 6f 72 64 73 22 29 0a 20 20 20 20 28 62 65 67  cords").    (beg
03b0: 69 6e 0a 20 20 20 20 20 20 28 70 72 69 6e 74 20  in.      (print 
03c0: 22 54 65 73 74 69 6e 67 20 22 20 6e 75 6d 74 6f  "Testing " numto
03d0: 64 6f 20 22 20 72 65 63 6f 72 64 73 22 29 0a 20  do " records"). 
03e0: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28       (let loop (
03f0: 28 69 20 30 29 29 0a 20 20 20 20 20 20 20 20 20  (i 0)).         
0400: 28 73 65 74 3a 63 6f 75 6e 74 20 74 65 73 74 76  (set:count testv
0410: 61 6c 72 65 63 20 69 29 0a 20 20 20 20 20 20 20  alrec i).       
0420: 20 20 28 73 65 74 3a 66 69 72 73 74 20 74 65 73    (set:first tes
0430: 74 76 61 6c 72 65 63 20 28 67 65 74 3a 63 6f 75  tvalrec (get:cou
0440: 6e 74 20 74 65 73 74 76 61 6c 72 65 63 29 29 0a  nt testvalrec)).
0450: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3c 20           (if (< 
0460: 69 20 6e 75 6d 74 6f 64 6f 29 0a 20 20 20 20 20  i numtodo).     
0470: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 2b          (loop (+
0480: 20 69 20 31 29 29 29 29 29 29 0a                  i 1)))))).