Artifact
ebf01cc3f7acb8f17cde7033f9897a0c60555a8a:
0000: 3b 3b 20 20 43 6f 70 79 72 69 67 68 74 20 32 30 ;; Copyright 20
0010: 30 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 06-2017, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 3b 3b 0a 28 75 73 65 20 nses/>..;;.(use
0300: 73 72 66 69 2d 39 29 0a 0a 28 64 65 66 69 6e 65 srfi-9)..(define
0310: 20 6e 75 6d 74 6f 64 6f 20 28 73 74 72 69 6e 67 numtodo (string
0320: 2d 3e 6e 75 6d 62 65 72 20 28 63 61 64 64 72 20 ->number (caddr
0330: 28 61 72 67 76 29 29 29 29 0a 0a 3b 3b 20 75 73 (argv))))..;; us
0340: 69 6e 67 20 76 65 63 74 6f 72 73 0a 28 64 65 66 ing vectors.(def
0350: 69 6e 65 20 74 65 73 74 76 61 6c 76 65 63 20 28 ine testvalvec (
0360: 76 65 63 74 6f 72 20 30 20 31 20 32 20 33 20 34 vector 0 1 2 3 4
0370: 20 35 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 5)).(define-inl
0380: 69 6e 65 20 28 74 65 73 74 69 6e 67 3a 67 65 74 ine (testing:get
0390: 2d 66 69 72 73 74 20 20 76 65 63 20 20 20 20 29 -first vec )
03a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
03b0: 20 30 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 0)).(define-inl
03c0: 69 6e 65 20 28 74 65 73 74 69 6e 67 3a 67 65 74 ine (testing:get
03d0: 2d 63 6f 75 6e 74 20 20 76 65 63 20 20 20 20 29 -count vec )
03e0: 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 (vector-ref vec
03f0: 20 35 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 5)).(define-inl
0400: 69 6e 65 20 28 74 65 73 74 69 6e 67 3a 73 65 74 ine (testing:set
0410: 2d 66 69 72 73 74 21 20 76 65 63 20 76 61 6c 29 -first! vec val)
0420: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 (vector-set! vec
0430: 20 30 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 0 val)).(define
0440: 2d 69 6e 6c 69 6e 65 20 28 74 65 73 74 69 6e 67 -inline (testing
0450: 3a 73 65 74 2d 63 6f 75 6e 74 21 20 76 65 63 20 :set-count! vec
0460: 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74 21 val)(vector-set!
0470: 20 76 65 63 20 35 20 76 61 6c 29 29 0a 0a 28 69 vec 5 val))..(i
0480: 66 20 28 65 71 75 61 6c 3f 20 28 63 61 64 72 20 f (equal? (cadr
0490: 28 61 72 67 76 29 29 20 22 76 65 63 74 6f 72 73 (argv)) "vectors
04a0: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
04b0: 20 20 20 20 28 70 72 69 6e 74 20 22 54 65 73 74 (print "Test
04c0: 69 6e 67 20 22 20 6e 75 6d 74 6f 64 6f 20 22 20 ing " numtodo "
04d0: 76 65 63 74 6f 72 73 22 29 0a 20 20 20 20 20 20 vectors").
04e0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 (let loop ((i 0)
04f0: 29 09 0a 20 20 20 20 20 20 20 20 28 74 65 73 74 ).. (test
0500: 69 6e 67 3a 73 65 74 2d 63 6f 75 6e 74 21 20 74 ing:set-count! t
0510: 65 73 74 76 61 6c 76 65 63 20 69 29 0a 20 20 20 estvalvec i).
0520: 20 20 20 20 20 28 74 65 73 74 69 6e 67 3a 73 65 (testing:se
0530: 74 2d 66 69 72 73 74 21 20 74 65 73 74 76 61 6c t-first! testval
0540: 76 65 63 20 28 74 65 73 74 69 6e 67 3a 67 65 74 vec (testing:get
0550: 2d 63 6f 75 6e 74 20 74 65 73 74 76 61 6c 76 65 -count testvalve
0560: 63 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 c)). (if
0570: 28 3c 20 69 20 6e 75 6d 74 6f 64 6f 29 0a 20 20 (< i numtodo).
0580: 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 (loop
0590: 28 2b 20 69 20 31 29 29 29 29 29 29 0a 0a 3b 3b (+ i 1))))))..;;
05a0: 20 75 73 69 6e 67 20 72 65 63 6f 72 64 73 0a 28 using records.(
05b0: 64 65 66 69 6e 65 2d 72 65 63 6f 72 64 2d 74 79 define-record-ty
05c0: 70 65 20 20 74 65 73 74 69 6e 67 0a 20 20 28 6d pe testing. (m
05d0: 61 6b 65 2d 74 65 73 74 69 6e 67 20 7a 65 72 6f ake-testing zero
05e0: 65 74 68 20 66 69 72 73 74 20 73 65 63 6f 6e 64 eth first second
05f0: 20 74 68 69 72 64 20 66 6f 75 72 74 68 20 63 6f third fourth co
0600: 75 6e 74 29 0a 20 20 74 65 73 74 69 6e 67 3f 0a unt). testing?.
0610: 20 20 28 63 6f 75 6e 74 20 67 65 74 3a 63 6f 75 (count get:cou
0620: 6e 74 20 73 65 74 3a 63 6f 75 6e 74 29 0a 20 20 nt set:count).
0630: 28 66 69 72 73 74 20 67 65 74 3a 66 69 72 73 74 (first get:first
0640: 20 73 65 74 3a 66 69 72 73 74 29 29 0a 0a 28 64 set:first))..(d
0650: 65 66 69 6e 65 20 74 65 73 74 76 61 6c 72 65 63 efine testvalrec
0660: 20 28 6d 61 6b 65 2d 74 65 73 74 69 6e 67 20 30 (make-testing 0
0670: 20 31 20 32 20 33 20 34 20 35 29 29 0a 0a 28 69 1 2 3 4 5))..(i
0680: 66 20 28 65 71 75 61 6c 3f 20 28 63 61 64 72 20 f (equal? (cadr
0690: 28 61 72 67 76 29 29 20 22 72 65 63 6f 72 64 73 (argv)) "records
06a0: 22 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 20 "). (begin.
06b0: 20 20 20 20 28 70 72 69 6e 74 20 22 54 65 73 74 (print "Test
06c0: 69 6e 67 20 22 20 6e 75 6d 74 6f 64 6f 20 22 20 ing " numtodo "
06d0: 72 65 63 6f 72 64 73 22 29 0a 20 20 20 20 20 20 records").
06e0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 (let loop ((i 0)
06f0: 29 0a 20 20 20 20 20 20 20 20 20 28 73 65 74 3a ). (set:
0700: 63 6f 75 6e 74 20 74 65 73 74 76 61 6c 72 65 63 count testvalrec
0710: 20 69 29 0a 20 20 20 20 20 20 20 20 20 28 73 65 i). (se
0720: 74 3a 66 69 72 73 74 20 74 65 73 74 76 61 6c 72 t:first testvalr
0730: 65 63 20 28 67 65 74 3a 63 6f 75 6e 74 20 74 65 ec (get:count te
0740: 73 74 76 61 6c 72 65 63 29 29 0a 20 20 20 20 20 stvalrec)).
0750: 20 20 20 20 28 69 66 20 28 3c 20 69 20 6e 75 6d (if (< i num
0760: 74 6f 64 6f 29 0a 20 20 20 20 20 20 20 20 20 20 todo).
0770: 20 20 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 (loop (+ i 1)
0780: 29 29 29 29 29 0a ))))).