Artifact 6170975af891cbbb5ad7ae791c01dfd76af5c25d:

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

0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 29  ;; Copyright (c)
0010: 20 32 30 30 35 2c 20 32 30 30 36 20 50 65 72 20   2005, 2006 Per 
0020: 42 6f 74 68 6e 65 72 0a 3b 3b 0a 3b 3b 20 50 65  Bothner.;;.;; Pe
0030: 72 6d 69 73 73 69 6f 6e 20 69 73 20 68 65 72 65  rmission is here
0040: 62 79 20 67 72 61 6e 74 65 64 2c 20 66 72 65 65  by granted, free
0050: 20 6f 66 20 63 68 61 72 67 65 2c 20 74 6f 20 61   of charge, to a
0060: 6e 79 20 70 65 72 73 6f 6e 0a 3b 3b 20 6f 62 74  ny person.;; obt
0070: 61 69 6e 69 6e 67 20 61 20 63 6f 70 79 20 6f 66  aining a copy of
0080: 20 74 68 69 73 20 73 6f 66 74 77 61 72 65 20 61   this software a
0090: 6e 64 20 61 73 73 6f 63 69 61 74 65 64 20 64 6f  nd associated do
00a0: 63 75 6d 65 6e 74 61 74 69 6f 6e 0a 3b 3b 20 66  cumentation.;; f
00b0: 69 6c 65 73 20 28 74 68 65 20 22 53 6f 66 74 77  iles (the "Softw
00c0: 61 72 65 22 29 2c 20 74 6f 20 64 65 61 6c 20 69  are"), to deal i
00d0: 6e 20 74 68 65 20 53 6f 66 74 77 61 72 65 20 77  n the Software w
00e0: 69 74 68 6f 75 74 0a 3b 3b 20 72 65 73 74 72 69  ithout.;; restri
00f0: 63 74 69 6f 6e 2c 20 69 6e 63 6c 75 64 69 6e 67  ction, including
0100: 20 77 69 74 68 6f 75 74 20 6c 69 6d 69 74 61 74   without limitat
0110: 69 6f 6e 20 74 68 65 20 72 69 67 68 74 73 20 74  ion the rights t
0120: 6f 20 75 73 65 2c 20 63 6f 70 79 2c 0a 3b 3b 20  o use, copy,.;; 
0130: 6d 6f 64 69 66 79 2c 20 6d 65 72 67 65 2c 20 70  modify, merge, p
0140: 75 62 6c 69 73 68 2c 20 64 69 73 74 72 69 62 75  ublish, distribu
0150: 74 65 2c 20 73 75 62 6c 69 63 65 6e 73 65 2c 20  te, sublicense, 
0160: 61 6e 64 2f 6f 72 20 73 65 6c 6c 20 63 6f 70 69  and/or sell copi
0170: 65 73 0a 3b 3b 20 6f 66 20 74 68 65 20 53 6f 66  es.;; of the Sof
0180: 74 77 61 72 65 2c 20 61 6e 64 20 74 6f 20 70 65  tware, and to pe
0190: 72 6d 69 74 20 70 65 72 73 6f 6e 73 20 74 6f 20  rmit persons to 
01a0: 77 68 6f 6d 20 74 68 65 20 53 6f 66 74 77 61 72  whom the Softwar
01b0: 65 20 69 73 0a 3b 3b 20 66 75 72 6e 69 73 68 65  e is.;; furnishe
01c0: 64 20 74 6f 20 64 6f 20 73 6f 2c 20 73 75 62 6a  d to do so, subj
01d0: 65 63 74 20 74 6f 20 74 68 65 20 66 6f 6c 6c 6f  ect to the follo
01e0: 77 69 6e 67 20 63 6f 6e 64 69 74 69 6f 6e 73 3a  wing conditions:
01f0: 0a 3b 3b 0a 3b 3b 20 54 68 65 20 61 62 6f 76 65  .;;.;; The above
0200: 20 63 6f 70 79 72 69 67 68 74 20 6e 6f 74 69 63   copyright notic
0210: 65 20 61 6e 64 20 74 68 69 73 20 70 65 72 6d 69  e and this permi
0220: 73 73 69 6f 6e 20 6e 6f 74 69 63 65 20 73 68 61  ssion notice sha
0230: 6c 6c 20 62 65 0a 3b 3b 20 69 6e 63 6c 75 64 65  ll be.;; include
0240: 64 20 69 6e 20 61 6c 6c 20 63 6f 70 69 65 73 20  d in all copies 
0250: 6f 72 20 73 75 62 73 74 61 6e 74 69 61 6c 20 70  or substantial p
0260: 6f 72 74 69 6f 6e 73 20 6f 66 20 74 68 65 20 53  ortions of the S
0270: 6f 66 74 77 61 72 65 2e 0a 3b 3b 0a 3b 3b 20 54  oftware..;;.;; T
0280: 48 45 20 53 4f 46 54 57 41 52 45 20 49 53 20 50  HE SOFTWARE IS P
0290: 52 4f 56 49 44 45 44 20 22 41 53 20 49 53 22 2c  ROVIDED "AS IS",
02a0: 20 57 49 54 48 4f 55 54 20 57 41 52 52 41 4e 54   WITHOUT WARRANT
02b0: 59 20 4f 46 20 41 4e 59 20 4b 49 4e 44 2c 0a 3b  Y OF ANY KIND,.;
02c0: 3b 20 45 58 50 52 45 53 53 20 4f 52 20 49 4d 50  ; EXPRESS OR IMP
02d0: 4c 49 45 44 2c 20 49 4e 43 4c 55 44 49 4e 47 20  LIED, INCLUDING 
02e0: 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 20  BUT NOT LIMITED 
02f0: 54 4f 20 54 48 45 20 57 41 52 52 41 4e 54 49 45  TO THE WARRANTIE
0300: 53 20 4f 46 0a 3b 3b 20 4d 45 52 43 48 41 4e 54  S OF.;; MERCHANT
0310: 41 42 49 4c 49 54 59 2c 20 46 49 54 4e 45 53 53  ABILITY, FITNESS
0320: 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41   FOR A PARTICULA
0330: 52 20 50 55 52 50 4f 53 45 20 41 4e 44 0a 3b 3b  R PURPOSE AND.;;
0340: 20 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d 45 4e 54   NONINFRINGEMENT
0350: 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48  . IN NO EVENT SH
0360: 41 4c 4c 20 54 48 45 20 41 55 54 48 4f 52 53 20  ALL THE AUTHORS 
0370: 4f 52 20 43 4f 50 59 52 49 47 48 54 20 48 4f 4c  OR COPYRIGHT HOL
0380: 44 45 52 53 0a 3b 3b 20 42 45 20 4c 49 41 42 4c  DERS.;; BE LIABL
0390: 45 20 46 4f 52 20 41 4e 59 20 43 4c 41 49 4d 2c  E FOR ANY CLAIM,
03a0: 20 44 41 4d 41 47 45 53 20 4f 52 20 4f 54 48 45   DAMAGES OR OTHE
03b0: 52 20 4c 49 41 42 49 4c 49 54 59 2c 20 57 48 45  R LIABILITY, WHE
03c0: 54 48 45 52 20 49 4e 20 41 4e 0a 3b 3b 20 41 43  THER IN AN.;; AC
03d0: 54 49 4f 4e 20 4f 46 20 43 4f 4e 54 52 41 43 54  TION OF CONTRACT
03e0: 2c 20 54 4f 52 54 20 4f 52 20 4f 54 48 45 52 57  , TORT OR OTHERW
03f0: 49 53 45 2c 20 41 52 49 53 49 4e 47 20 46 52 4f  ISE, ARISING FRO
0400: 4d 2c 20 4f 55 54 20 4f 46 20 4f 52 20 49 4e 0a  M, OUT OF OR IN.
0410: 3b 3b 20 43 4f 4e 4e 45 43 54 49 4f 4e 20 57 49  ;; CONNECTION WI
0420: 54 48 20 54 48 45 20 53 4f 46 54 57 41 52 45 20  TH THE SOFTWARE 
0430: 4f 52 20 54 48 45 20 55 53 45 20 4f 52 20 4f 54  OR THE USE OR OT
0440: 48 45 52 20 44 45 41 4c 49 4e 47 53 20 49 4e 20  HER DEALINGS IN 
0450: 54 48 45 0a 3b 3b 20 53 4f 46 54 57 41 52 45 2e  THE.;; SOFTWARE.
0460: 0a 0a 28 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20  ..(cond-expand. 
0470: 28 72 36 72 73 29 0a 20 28 63 68 69 63 6b 65 6e  (r6rs). (chicken
0480: 0a 20 20 28 72 65 71 75 69 72 65 2d 65 78 74 65  .  (require-exte
0490: 6e 73 69 6f 6e 20 73 79 6e 74 61 78 2d 63 61 73  nsion syntax-cas
04a0: 65 29 29 0a 20 28 67 75 69 6c 65 0a 20 20 28 75  e)). (guile.  (u
04b0: 73 65 2d 6d 6f 64 75 6c 65 73 20 28 69 63 65 2d  se-modules (ice-
04c0: 39 20 73 79 6e 63 61 73 65 29 20 28 73 72 66 69  9 syncase) (srfi
04d0: 20 73 72 66 69 2d 39 29 0a 09 20 20 20 20 20 20   srfi-9)..      
04e0: 20 3b 3b 28 73 72 66 69 20 73 72 66 69 2d 33 34   ;;(srfi srfi-34
04f0: 29 20 28 73 72 66 69 20 73 72 66 69 2d 33 35 29  ) (srfi srfi-35)
0500: 20 2d 20 6e 6f 74 20 69 6e 20 47 75 69 6c 65 20   - not in Guile 
0510: 31 2e 36 2e 37 0a 09 20 20 20 20 20 20 20 28 73  1.6.7..       (s
0520: 72 66 69 20 73 72 66 69 2d 33 39 29 29 29 0a 20  rfi srfi-39))). 
0530: 28 73 69 73 63 0a 20 20 28 72 65 71 75 69 72 65  (sisc.  (require
0540: 2d 65 78 74 65 6e 73 69 6f 6e 20 28 73 72 66 69  -extension (srfi
0550: 20 39 20 33 34 20 33 35 20 33 39 29 29 29 0a 20   9 34 35 39))). 
0560: 28 6b 61 77 61 0a 20 20 28 6d 6f 64 75 6c 65 2d  (kawa.  (module-
0570: 63 6f 6d 70 69 6c 65 2d 6f 70 74 69 6f 6e 73 20  compile-options 
0580: 77 61 72 6e 2d 75 6e 64 65 66 69 6e 65 64 2d 76  warn-undefined-v
0590: 61 72 69 61 62 6c 65 3a 20 23 74 0a 09 09 09 20  ariable: #t.... 
05a0: 20 77 61 72 6e 2d 69 6e 76 6f 6b 65 2d 75 6e 6b   warn-invoke-unk
05b0: 6e 6f 77 6e 2d 6d 65 74 68 6f 64 3a 20 23 74 29  nown-method: #t)
05c0: 0a 20 20 28 70 72 6f 76 69 64 65 20 27 73 72 66  .  (provide 'srf
05d0: 69 2d 36 34 29 0a 20 20 28 70 72 6f 76 69 64 65  i-64).  (provide
05e0: 20 27 74 65 73 74 69 6e 67 29 0a 20 20 28 72 65   'testing).  (re
05f0: 71 75 69 72 65 20 27 73 72 66 69 2d 33 34 29 0a  quire 'srfi-34).
0600: 20 20 28 72 65 71 75 69 72 65 20 27 73 72 66 69    (require 'srfi
0610: 2d 33 35 29 29 0a 20 28 65 6c 73 65 20 28 29 0a  -35)). (else ().
0620: 20 20 29 29 0a 0a 28 63 6f 6e 64 2d 65 78 70 61    ))..(cond-expa
0630: 6e 64 0a 20 28 72 36 72 73 0a 20 20 28 64 65 66  nd. (r6rs.  (def
0640: 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65 73 74  ine-syntax %test
0650: 2d 65 78 70 6f 72 74 0a 20 20 20 20 28 73 79 6e  -export.    (syn
0660: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
0670: 20 20 20 28 28 25 74 65 73 74 2d 65 78 70 6f 72     ((%test-expor
0680: 74 20 2e 20 6e 61 6d 65 73 29 20 28 62 65 67 69  t . names) (begi
0690: 6e 29 29 29 29 29 0a 20 28 6b 61 77 61 0a 20 20  n))))). (kawa.  
06a0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25  (define-syntax %
06b0: 74 65 73 74 2d 65 78 70 6f 72 74 0a 20 20 20 20  test-export.    
06c0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
06d0: 0a 20 20 20 20 20 20 28 28 25 74 65 73 74 2d 65  .      ((%test-e
06e0: 78 70 6f 72 74 20 74 65 73 74 2d 62 65 67 69 6e  xport test-begin
06f0: 20 2e 20 6f 74 68 65 72 2d 6e 61 6d 65 73 29 0a   . other-names).
0700: 20 20 20 20 20 20 20 28 6d 6f 64 75 6c 65 2d 65         (module-e
0710: 78 70 6f 72 74 20 25 74 65 73 74 2d 62 65 67 69  xport %test-begi
0720: 6e 20 2e 20 6f 74 68 65 72 2d 6e 61 6d 65 73 29  n . other-names)
0730: 29 29 29 29 0a 20 28 65 6c 73 65 0a 20 20 28 64  )))). (else.  (d
0740: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65  efine-syntax %te
0750: 73 74 2d 65 78 70 6f 72 74 0a 20 20 20 20 28 73  st-export.    (s
0760: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20  yntax-rules (). 
0770: 20 20 20 20 20 28 28 25 74 65 73 74 2d 65 78 70       ((%test-exp
0780: 6f 72 74 20 2e 20 6e 61 6d 65 73 29 20 28 69 66  ort . names) (if
0790: 20 23 66 20 23 66 29 29 29 29 29 29 0a 0a 3b 3b   #f #f))))))..;;
07a0: 20 4c 69 73 74 20 6f 66 20 65 78 70 6f 72 74 65   List of exporte
07b0: 64 20 6e 61 6d 65 73 0a 28 25 74 65 73 74 2d 65  d names.(%test-e
07c0: 78 70 6f 72 74 0a 20 74 65 73 74 2d 62 65 67 69  xport. test-begi
07d0: 6e 20 3b 3b 20 6d 75 73 74 20 62 65 20 6c 69 73  n ;; must be lis
07e0: 74 65 64 20 66 69 72 73 74 2c 20 73 69 6e 63 65  ted first, since
07f0: 20 69 6e 20 4b 61 77 61 20 28 61 74 20 6c 65 61   in Kawa (at lea
0800: 73 74 29 20 69 74 20 69 73 20 22 6d 61 67 69 63  st) it is "magic
0810: 22 2e 0a 20 74 65 73 74 2d 65 6e 64 20 74 65 73  ".. test-end tes
0820: 74 2d 61 73 73 65 72 74 20 74 65 73 74 2d 65 71  t-assert test-eq
0830: 76 20 74 65 73 74 2d 65 71 20 74 65 73 74 2d 65  v test-eq test-e
0840: 71 75 61 6c 0a 20 74 65 73 74 2d 61 70 70 72 6f  qual. test-appro
0850: 78 69 6d 61 74 65 20 74 65 73 74 2d 61 73 73 65  ximate test-asse
0860: 72 74 20 74 65 73 74 2d 65 72 72 6f 72 20 74 65  rt test-error te
0870: 73 74 2d 61 70 70 6c 79 20 74 65 73 74 2d 77 69  st-apply test-wi
0880: 74 68 2d 72 75 6e 6e 65 72 0a 20 74 65 73 74 2d  th-runner. test-
0890: 6d 61 74 63 68 2d 6e 74 68 20 74 65 73 74 2d 6d  match-nth test-m
08a0: 61 74 63 68 2d 61 6c 6c 20 74 65 73 74 2d 6d 61  atch-all test-ma
08b0: 74 63 68 2d 61 6e 79 20 74 65 73 74 2d 6d 61 74  tch-any test-mat
08c0: 63 68 2d 6e 61 6d 65 0a 20 74 65 73 74 2d 73 6b  ch-name. test-sk
08d0: 69 70 20 74 65 73 74 2d 65 78 70 65 63 74 2d 66  ip test-expect-f
08e0: 61 69 6c 20 74 65 73 74 2d 72 65 61 64 2d 65 76  ail test-read-ev
08f0: 61 6c 2d 73 74 72 69 6e 67 0a 20 74 65 73 74 2d  al-string. test-
0900: 72 75 6e 6e 65 72 2d 67 72 6f 75 70 2d 70 61 74  runner-group-pat
0910: 68 20 74 65 73 74 2d 67 72 6f 75 70 2d 77 69 74  h test-group-wit
0920: 68 2d 63 6c 65 61 6e 75 70 0a 20 74 65 73 74 2d  h-cleanup. test-
0930: 72 65 73 75 6c 74 2d 72 65 66 20 74 65 73 74 2d  result-ref test-
0940: 72 65 73 75 6c 74 2d 73 65 74 21 20 74 65 73 74  result-set! test
0950: 2d 72 65 73 75 6c 74 2d 63 6c 65 61 72 20 74 65  -result-clear te
0960: 73 74 2d 72 65 73 75 6c 74 2d 72 65 6d 6f 76 65  st-result-remove
0970: 0a 20 74 65 73 74 2d 72 65 73 75 6c 74 2d 6b 69  . test-result-ki
0980: 6e 64 20 74 65 73 74 2d 70 61 73 73 65 64 3f 0a  nd test-passed?.
0990: 20 74 65 73 74 2d 6c 6f 67 2d 74 6f 2d 66 69 6c   test-log-to-fil
09a0: 65 0a 20 3b 20 4d 69 73 63 20 74 65 73 74 2d 72  e. ; Misc test-r
09b0: 75 6e 6e 65 72 20 66 75 6e 63 74 69 6f 6e 73 0a  unner functions.
09c0: 20 74 65 73 74 2d 72 75 6e 6e 65 72 3f 20 74 65   test-runner? te
09d0: 73 74 2d 72 75 6e 6e 65 72 2d 72 65 73 65 74 20  st-runner-reset 
09e0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6e 75 6c 6c  test-runner-null
09f0: 0a 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 69  . test-runner-si
0a00: 6d 70 6c 65 20 74 65 73 74 2d 72 75 6e 6e 65 72  mple test-runner
0a10: 2d 63 75 72 72 65 6e 74 20 74 65 73 74 2d 72 75  -current test-ru
0a20: 6e 6e 65 72 2d 66 61 63 74 6f 72 79 20 74 65 73  nner-factory tes
0a30: 74 2d 72 75 6e 6e 65 72 2d 67 65 74 0a 20 74 65  t-runner-get. te
0a40: 73 74 2d 72 75 6e 6e 65 72 2d 63 72 65 61 74 65  st-runner-create
0a50: 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 74 65 73   test-runner-tes
0a60: 74 2d 6e 61 6d 65 0a 20 3b 3b 20 74 65 73 74 2d  t-name. ;; test-
0a70: 72 75 6e 6e 65 72 20 66 69 65 6c 64 20 73 65 74  runner field set
0a80: 74 65 72 20 61 6e 64 20 67 65 74 74 65 72 20 66  ter and getter f
0a90: 75 6e 63 74 69 6f 6e 73 20 2d 20 73 65 65 20 25  unctions - see %
0aa0: 74 65 73 74 2d 72 65 63 6f 72 64 2d 64 65 66 69  test-record-defi
0ab0: 6e 65 3a 0a 20 74 65 73 74 2d 72 75 6e 6e 65 72  ne:. test-runner
0ac0: 2d 70 61 73 73 2d 63 6f 75 6e 74 20 74 65 73 74  -pass-count test
0ad0: 2d 72 75 6e 6e 65 72 2d 70 61 73 73 2d 63 6f 75  -runner-pass-cou
0ae0: 6e 74 21 0a 20 74 65 73 74 2d 72 75 6e 6e 65 72  nt!. test-runner
0af0: 2d 66 61 69 6c 2d 63 6f 75 6e 74 20 74 65 73 74  -fail-count test
0b00: 2d 72 75 6e 6e 65 72 2d 66 61 69 6c 2d 63 6f 75  -runner-fail-cou
0b10: 6e 74 21 0a 20 74 65 73 74 2d 72 75 6e 6e 65 72  nt!. test-runner
0b20: 2d 78 70 61 73 73 2d 63 6f 75 6e 74 20 74 65 73  -xpass-count tes
0b30: 74 2d 72 75 6e 6e 65 72 2d 78 70 61 73 73 2d 63  t-runner-xpass-c
0b40: 6f 75 6e 74 21 0a 20 74 65 73 74 2d 72 75 6e 6e  ount!. test-runn
0b50: 65 72 2d 78 66 61 69 6c 2d 63 6f 75 6e 74 20 74  er-xfail-count t
0b60: 65 73 74 2d 72 75 6e 6e 65 72 2d 78 66 61 69 6c  est-runner-xfail
0b70: 2d 63 6f 75 6e 74 21 0a 20 74 65 73 74 2d 72 75  -count!. test-ru
0b80: 6e 6e 65 72 2d 73 6b 69 70 2d 63 6f 75 6e 74 20  nner-skip-count 
0b90: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70  test-runner-skip
0ba0: 2d 63 6f 75 6e 74 21 0a 20 74 65 73 74 2d 72 75  -count!. test-ru
0bb0: 6e 6e 65 72 2d 67 72 6f 75 70 2d 73 74 61 63 6b  nner-group-stack
0bc0: 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67 72 6f   test-runner-gro
0bd0: 75 70 2d 73 74 61 63 6b 21 0a 20 74 65 73 74 2d  up-stack!. test-
0be0: 72 75 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 62  runner-on-test-b
0bf0: 65 67 69 6e 20 74 65 73 74 2d 72 75 6e 6e 65 72  egin test-runner
0c00: 2d 6f 6e 2d 74 65 73 74 2d 62 65 67 69 6e 21 0a  -on-test-begin!.
0c10: 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d   test-runner-on-
0c20: 74 65 73 74 2d 65 6e 64 20 74 65 73 74 2d 72 75  test-end test-ru
0c30: 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64  nner-on-test-end
0c40: 21 0a 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f  !. test-runner-o
0c50: 6e 2d 67 72 6f 75 70 2d 62 65 67 69 6e 20 74 65  n-group-begin te
0c60: 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f  st-runner-on-gro
0c70: 75 70 2d 62 65 67 69 6e 21 0a 20 74 65 73 74 2d  up-begin!. test-
0c80: 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75 70 2d  runner-on-group-
0c90: 65 6e 64 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d  end test-runner-
0ca0: 6f 6e 2d 67 72 6f 75 70 2d 65 6e 64 21 0a 20 74  on-group-end!. t
0cb0: 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 66 69  est-runner-on-fi
0cc0: 6e 61 6c 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d  nal test-runner-
0cd0: 6f 6e 2d 66 69 6e 61 6c 21 0a 20 74 65 73 74 2d  on-final!. test-
0ce0: 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61 64 2d 63 6f  runner-on-bad-co
0cf0: 75 6e 74 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d  unt test-runner-
0d00: 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74 21 0a 20 74  on-bad-count!. t
0d10: 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61  est-runner-on-ba
0d20: 64 2d 65 6e 64 2d 6e 61 6d 65 20 74 65 73 74 2d  d-end-name test-
0d30: 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61 64 2d 65 6e  runner-on-bad-en
0d40: 64 2d 6e 61 6d 65 21 0a 20 74 65 73 74 2d 72 65  d-name!. test-re
0d50: 73 75 6c 74 2d 61 6c 69 73 74 20 74 65 73 74 2d  sult-alist test-
0d60: 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 0a 20 74  result-alist!. t
0d70: 65 73 74 2d 72 75 6e 6e 65 72 2d 61 75 78 2d 76  est-runner-aux-v
0d80: 61 6c 75 65 20 74 65 73 74 2d 72 75 6e 6e 65 72  alue test-runner
0d90: 2d 61 75 78 2d 76 61 6c 75 65 21 0a 20 3b 3b 20  -aux-value!. ;; 
0da0: 64 65 66 61 75 6c 74 2f 73 69 6d 70 6c 65 20 63  default/simple c
0db0: 61 6c 6c 2d 62 61 63 6b 20 66 75 6e 63 74 69 6f  all-back functio
0dc0: 6e 73 2c 20 75 73 65 64 20 69 6e 20 64 65 66 61  ns, used in defa
0dd0: 75 6c 74 20 74 65 73 74 2d 72 75 6e 6e 65 72 2c  ult test-runner,
0de0: 0a 20 3b 3b 20 62 75 74 20 63 61 6e 20 62 65 20  . ;; but can be 
0df0: 63 61 6c 6c 65 64 20 74 6f 20 63 6f 6e 73 74 72  called to constr
0e00: 75 63 74 20 6d 6f 72 65 20 63 6f 6d 70 6c 65 78  uct more complex
0e10: 20 6f 6e 65 73 2e 0a 20 74 65 73 74 2d 6f 6e 2d   ones.. test-on-
0e20: 67 72 6f 75 70 2d 62 65 67 69 6e 2d 73 69 6d 70  group-begin-simp
0e30: 6c 65 20 74 65 73 74 2d 6f 6e 2d 67 72 6f 75 70  le test-on-group
0e40: 2d 65 6e 64 2d 73 69 6d 70 6c 65 0a 20 74 65 73  -end-simple. tes
0e50: 74 2d 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74 2d 73  t-on-bad-count-s
0e60: 69 6d 70 6c 65 20 74 65 73 74 2d 6f 6e 2d 62 61  imple test-on-ba
0e70: 64 2d 65 6e 64 2d 6e 61 6d 65 2d 73 69 6d 70 6c  d-end-name-simpl
0e80: 65 0a 20 74 65 73 74 2d 6f 6e 2d 66 69 6e 61 6c  e. test-on-final
0e90: 2d 73 69 6d 70 6c 65 20 74 65 73 74 2d 6f 6e 2d  -simple test-on-
0ea0: 74 65 73 74 2d 65 6e 64 2d 73 69 6d 70 6c 65 0a  test-end-simple.
0eb0: 20 74 65 73 74 2d 6f 6e 2d 66 69 6e 61 6c 2d 73   test-on-final-s
0ec0: 69 6d 70 6c 65 29 0a 0a 28 63 6f 6e 64 2d 65 78  imple)..(cond-ex
0ed0: 70 61 6e 64 0a 20 28 73 72 66 69 2d 39 0a 20 20  pand. (srfi-9.  
0ee0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25  (define-syntax %
0ef0: 74 65 73 74 2d 72 65 63 6f 72 64 2d 64 65 66 69  test-record-defi
0f00: 6e 65 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72  ne.    (syntax-r
0f10: 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28  ules ().      ((
0f20: 25 74 65 73 74 2d 72 65 63 6f 72 64 2d 64 65 66  %test-record-def
0f30: 69 6e 65 20 61 6c 6c 6f 63 20 72 75 6e 6e 65 72  ine alloc runner
0f40: 3f 20 28 6e 61 6d 65 20 69 6e 64 65 78 20 67 65  ? (name index ge
0f50: 74 74 65 72 20 73 65 74 74 65 72 29 20 2e 2e 2e  tter setter) ...
0f60: 29 0a 20 20 20 20 20 20 20 28 64 65 66 69 6e 65  ).       (define
0f70: 2d 72 65 63 6f 72 64 2d 74 79 70 65 20 74 65 73  -record-type tes
0f80: 74 2d 72 75 6e 6e 65 72 0a 09 20 28 61 6c 6c 6f  t-runner.. (allo
0f90: 63 29 0a 09 20 72 75 6e 6e 65 72 3f 0a 09 20 28  c).. runner?.. (
0fa0: 6e 61 6d 65 20 67 65 74 74 65 72 20 73 65 74 74  name getter sett
0fb0: 65 72 29 20 2e 2e 2e 29 29 29 29 29 0a 20 28 65  er) ...))))). (e
0fc0: 6c 73 65 0a 20 20 28 64 65 66 69 6e 65 20 25 74  lse.  (define %t
0fd0: 65 73 74 2d 72 75 6e 6e 65 72 2d 63 6f 6f 6b 69  est-runner-cooki
0fe0: 65 20 28 6c 69 73 74 20 22 74 65 73 74 2d 72 75  e (list "test-ru
0ff0: 6e 6e 65 72 22 29 29 0a 20 20 28 64 65 66 69 6e  nner")).  (defin
1000: 65 2d 73 79 6e 74 61 78 20 25 74 65 73 74 2d 72  e-syntax %test-r
1010: 65 63 6f 72 64 2d 64 65 66 69 6e 65 0a 20 20 20  ecord-define.   
1020: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28   (syntax-rules (
1030: 29 0a 20 20 20 20 20 20 28 28 25 74 65 73 74 2d  ).      ((%test-
1040: 72 65 63 6f 72 64 2d 64 65 66 69 6e 65 20 61 6c  record-define al
1050: 6c 6f 63 20 72 75 6e 6e 65 72 3f 20 28 6e 61 6d  loc runner? (nam
1060: 65 20 69 6e 64 65 78 20 67 65 74 74 65 72 20 73  e index getter s
1070: 65 74 74 65 72 29 20 2e 2e 2e 29 0a 20 20 20 20  etter) ...).    
1080: 20 20 20 28 62 65 67 69 6e 0a 09 20 28 64 65 66     (begin.. (def
1090: 69 6e 65 20 28 72 75 6e 6e 65 72 3f 20 6f 62 6a  ine (runner? obj
10a0: 29 0a 09 20 20 20 28 61 6e 64 20 28 76 65 63 74  )..   (and (vect
10b0: 6f 72 3f 20 6f 62 6a 29 0a 09 09 28 3e 20 28 76  or? obj)...(> (v
10c0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6f 62 6a  ector-length obj
10d0: 29 20 31 29 0a 09 09 28 65 71 20 28 76 65 63 74  ) 1)...(eq (vect
10e0: 6f 72 2d 72 65 66 20 6f 62 6a 20 30 29 20 25 74  or-ref obj 0) %t
10f0: 65 73 74 2d 72 75 6e 6e 65 72 2d 63 6f 6f 6b 69  est-runner-cooki
1100: 65 29 29 29 0a 09 20 28 64 65 66 69 6e 65 20 28  e))).. (define (
1110: 61 6c 6c 6f 63 29 0a 09 20 20 20 28 6c 65 74 20  alloc)..   (let 
1120: 28 28 72 75 6e 6e 65 72 20 28 6d 61 6b 65 2d 76  ((runner (make-v
1130: 65 63 74 6f 72 20 32 32 29 29 29 0a 09 20 20 20  ector 22)))..   
1140: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72    (vector-set! r
1150: 75 6e 6e 65 72 20 30 20 25 74 65 73 74 2d 72 75  unner 0 %test-ru
1160: 6e 6e 65 72 2d 63 6f 6f 6b 69 65 29 0a 09 20 20  nner-cookie)..  
1170: 20 20 20 72 75 6e 6e 65 72 29 29 0a 09 20 28 62     runner)).. (b
1180: 65 67 69 6e 0a 09 20 20 20 28 64 65 66 69 6e 65  egin..   (define
1190: 20 28 67 65 74 74 65 72 20 72 75 6e 6e 65 72 29   (getter runner)
11a0: 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72  ..     (vector-r
11b0: 65 66 20 72 75 6e 6e 65 72 20 69 6e 64 65 78 29  ef runner index)
11c0: 29 20 2e 2e 2e 29 0a 09 20 28 62 65 67 69 6e 0a  ) ...).. (begin.
11d0: 09 20 20 20 28 64 65 66 69 6e 65 20 28 73 65 74  .   (define (set
11e0: 74 65 72 20 72 75 6e 6e 65 72 20 76 61 6c 75 65  ter runner value
11f0: 29 0a 09 20 20 20 20 20 28 76 65 63 74 6f 72 2d  )..     (vector-
1200: 73 65 74 21 20 72 75 6e 6e 65 72 20 69 6e 64 65  set! runner inde
1210: 78 20 76 61 6c 75 65 29 29 20 2e 2e 2e 29 29 29  x value)) ...)))
1220: 29 29 29 29 0a 0a 28 25 74 65 73 74 2d 72 65 63  ))))..(%test-rec
1230: 6f 72 64 2d 64 65 66 69 6e 65 0a 20 25 74 65 73  ord-define. %tes
1240: 74 2d 72 75 6e 6e 65 72 2d 61 6c 6c 6f 63 20 74  t-runner-alloc t
1250: 65 73 74 2d 72 75 6e 6e 65 72 3f 0a 20 3b 3b 20  est-runner?. ;; 
1260: 43 75 6d 75 6c 61 74 65 20 63 6f 75 6e 74 20 6f  Cumulate count o
1270: 66 20 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74  f all tests that
1280: 20 68 61 76 65 20 70 61 73 73 65 64 20 61 6e 64   have passed and
1290: 20 77 65 72 65 20 65 78 70 65 63 74 65 64 20 74   were expected t
12a0: 6f 2e 0a 20 28 70 61 73 73 2d 63 6f 75 6e 74 20  o.. (pass-count 
12b0: 31 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 70 61  1 test-runner-pa
12c0: 73 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d 72 75  ss-count test-ru
12d0: 6e 6e 65 72 2d 70 61 73 73 2d 63 6f 75 6e 74 21  nner-pass-count!
12e0: 29 0a 20 28 66 61 69 6c 2d 63 6f 75 6e 74 20 32  ). (fail-count 2
12f0: 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61 69   test-runner-fai
1300: 6c 2d 63 6f 75 6e 74 20 74 65 73 74 2d 72 75 6e  l-count test-run
1310: 6e 65 72 2d 66 61 69 6c 2d 63 6f 75 6e 74 21 29  ner-fail-count!)
1320: 0a 20 28 78 70 61 73 73 2d 63 6f 75 6e 74 20 33  . (xpass-count 3
1330: 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 78 70 61   test-runner-xpa
1340: 73 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d 72 75  ss-count test-ru
1350: 6e 6e 65 72 2d 78 70 61 73 73 2d 63 6f 75 6e 74  nner-xpass-count
1360: 21 29 0a 20 28 78 66 61 69 6c 2d 63 6f 75 6e 74  !). (xfail-count
1370: 20 34 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 78   4 test-runner-x
1380: 66 61 69 6c 2d 63 6f 75 6e 74 20 74 65 73 74 2d  fail-count test-
1390: 72 75 6e 6e 65 72 2d 78 66 61 69 6c 2d 63 6f 75  runner-xfail-cou
13a0: 6e 74 21 29 0a 20 28 73 6b 69 70 2d 63 6f 75 6e  nt!). (skip-coun
13b0: 74 20 35 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d  t 5 test-runner-
13c0: 73 6b 69 70 2d 63 6f 75 6e 74 20 74 65 73 74 2d  skip-count test-
13d0: 72 75 6e 6e 65 72 2d 73 6b 69 70 2d 63 6f 75 6e  runner-skip-coun
13e0: 74 21 29 0a 20 28 73 6b 69 70 2d 6c 69 73 74 20  t!). (skip-list 
13f0: 36 20 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73  6 %test-runner-s
1400: 6b 69 70 2d 6c 69 73 74 20 25 74 65 73 74 2d 72  kip-list %test-r
1410: 75 6e 6e 65 72 2d 73 6b 69 70 2d 6c 69 73 74 21  unner-skip-list!
1420: 29 0a 20 28 66 61 69 6c 2d 6c 69 73 74 20 37 20  ). (fail-list 7 
1430: 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61 69  %test-runner-fai
1440: 6c 2d 6c 69 73 74 20 25 74 65 73 74 2d 72 75 6e  l-list %test-run
1450: 6e 65 72 2d 66 61 69 6c 2d 6c 69 73 74 21 29 0a  ner-fail-list!).
1460: 20 3b 3b 20 4e 6f 72 6d 61 6c 6c 79 20 23 74 2c   ;; Normally #t,
1470: 20 65 78 63 65 70 74 20 77 68 65 6e 20 69 6e 20   except when in 
1480: 61 20 74 65 73 74 2d 61 70 70 6c 79 2e 0a 20 28  a test-apply.. (
1490: 72 75 6e 2d 6c 69 73 74 20 38 20 25 74 65 73 74  run-list 8 %test
14a0: 2d 72 75 6e 6e 65 72 2d 72 75 6e 2d 6c 69 73 74  -runner-run-list
14b0: 20 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 72 75   %test-runner-ru
14c0: 6e 2d 6c 69 73 74 21 29 0a 20 28 73 6b 69 70 2d  n-list!). (skip-
14d0: 73 61 76 65 20 39 20 25 74 65 73 74 2d 72 75 6e  save 9 %test-run
14e0: 6e 65 72 2d 73 6b 69 70 2d 73 61 76 65 20 25 74  ner-skip-save %t
14f0: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
1500: 73 61 76 65 21 29 0a 20 28 66 61 69 6c 2d 73 61  save!). (fail-sa
1510: 76 65 20 31 30 20 25 74 65 73 74 2d 72 75 6e 6e  ve 10 %test-runn
1520: 65 72 2d 66 61 69 6c 2d 73 61 76 65 20 25 74 65  er-fail-save %te
1530: 73 74 2d 72 75 6e 6e 65 72 2d 66 61 69 6c 2d 73  st-runner-fail-s
1540: 61 76 65 21 29 0a 20 28 67 72 6f 75 70 2d 73 74  ave!). (group-st
1550: 61 63 6b 20 31 31 20 74 65 73 74 2d 72 75 6e 6e  ack 11 test-runn
1560: 65 72 2d 67 72 6f 75 70 2d 73 74 61 63 6b 20 74  er-group-stack t
1570: 65 73 74 2d 72 75 6e 6e 65 72 2d 67 72 6f 75 70  est-runner-group
1580: 2d 73 74 61 63 6b 21 29 0a 20 28 6f 6e 2d 74 65  -stack!). (on-te
1590: 73 74 2d 62 65 67 69 6e 20 31 32 20 74 65 73 74  st-begin 12 test
15a0: 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d  -runner-on-test-
15b0: 62 65 67 69 6e 20 74 65 73 74 2d 72 75 6e 6e 65  begin test-runne
15c0: 72 2d 6f 6e 2d 74 65 73 74 2d 62 65 67 69 6e 21  r-on-test-begin!
15d0: 29 0a 20 28 6f 6e 2d 74 65 73 74 2d 65 6e 64 20  ). (on-test-end 
15e0: 31 33 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f  13 test-runner-o
15f0: 6e 2d 74 65 73 74 2d 65 6e 64 20 74 65 73 74 2d  n-test-end test-
1600: 72 75 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 65  runner-on-test-e
1610: 6e 64 21 29 0a 20 3b 3b 20 43 61 6c 6c 2d 62 61  nd!). ;; Call-ba
1620: 63 6b 20 77 68 65 6e 20 65 6e 74 65 72 69 6e 67  ck when entering
1630: 20 61 20 67 72 6f 75 70 2e 20 54 61 6b 65 73 20   a group. Takes 
1640: 28 72 75 6e 6e 65 72 20 73 75 69 74 65 2d 6e 61  (runner suite-na
1650: 6d 65 20 63 6f 75 6e 74 29 2e 0a 20 28 6f 6e 2d  me count).. (on-
1660: 67 72 6f 75 70 2d 62 65 67 69 6e 20 31 34 20 74  group-begin 14 t
1670: 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72  est-runner-on-gr
1680: 6f 75 70 2d 62 65 67 69 6e 20 74 65 73 74 2d 72  oup-begin test-r
1690: 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75 70 2d 62  unner-on-group-b
16a0: 65 67 69 6e 21 29 0a 20 3b 3b 20 43 61 6c 6c 2d  egin!). ;; Call-
16b0: 62 61 63 6b 20 77 68 65 6e 20 6c 65 61 76 69 6e  back when leavin
16c0: 67 20 61 20 67 72 6f 75 70 2e 0a 20 28 6f 6e 2d  g a group.. (on-
16d0: 67 72 6f 75 70 2d 65 6e 64 20 31 35 20 74 65 73  group-end 15 tes
16e0: 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75  t-runner-on-grou
16f0: 70 2d 65 6e 64 20 74 65 73 74 2d 72 75 6e 6e 65  p-end test-runne
1700: 72 2d 6f 6e 2d 67 72 6f 75 70 2d 65 6e 64 21 29  r-on-group-end!)
1710: 0a 20 3b 3b 20 43 61 6c 6c 2d 62 61 63 6b 20 77  . ;; Call-back w
1720: 68 65 6e 20 6c 65 61 76 69 6e 67 20 74 68 65 20  hen leaving the 
1730: 6f 75 74 65 72 6d 6f 73 74 20 67 72 6f 75 70 2e  outermost group.
1740: 0a 20 28 6f 6e 2d 66 69 6e 61 6c 20 31 36 20 74  . (on-final 16 t
1750: 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 66 69  est-runner-on-fi
1760: 6e 61 6c 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d  nal test-runner-
1770: 6f 6e 2d 66 69 6e 61 6c 21 29 0a 20 3b 3b 20 43  on-final!). ;; C
1780: 61 6c 6c 2d 62 61 63 6b 20 77 68 65 6e 20 65 78  all-back when ex
1790: 70 65 63 74 65 64 20 6e 75 6d 62 65 72 20 6f 66  pected number of
17a0: 20 74 65 73 74 73 20 77 61 73 20 77 72 6f 6e 67   tests was wrong
17b0: 2e 0a 20 28 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74  .. (on-bad-count
17c0: 20 31 37 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d   17 test-runner-
17d0: 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74 20 74 65 73  on-bad-count tes
17e0: 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61 64 2d  t-runner-on-bad-
17f0: 63 6f 75 6e 74 21 29 0a 20 3b 3b 20 43 61 6c 6c  count!). ;; Call
1800: 2d 62 61 63 6b 20 77 68 65 6e 20 6e 61 6d 65 20  -back when name 
1810: 69 6e 20 74 65 73 74 3d 65 6e 64 20 64 6f 65 73  in test=end does
1820: 6e 27 74 20 6d 61 74 63 68 20 74 65 73 74 2d 62  n't match test-b
1830: 65 67 69 6e 2e 0a 20 28 6f 6e 2d 62 61 64 2d 65  egin.. (on-bad-e
1840: 6e 64 2d 6e 61 6d 65 20 31 38 20 74 65 73 74 2d  nd-name 18 test-
1850: 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61 64 2d 65 6e  runner-on-bad-en
1860: 64 2d 6e 61 6d 65 20 74 65 73 74 2d 72 75 6e 6e  d-name test-runn
1870: 65 72 2d 6f 6e 2d 62 61 64 2d 65 6e 64 2d 6e 61  er-on-bad-end-na
1880: 6d 65 21 29 0a 20 3b 3b 20 43 75 6d 75 6c 61 74  me!). ;; Cumulat
1890: 65 20 63 6f 75 6e 74 20 6f 66 20 61 6c 6c 20 74  e count of all t
18a0: 65 73 74 73 20 74 68 61 74 20 68 61 76 65 20 62  ests that have b
18b0: 65 65 6e 20 64 6f 6e 65 2e 0a 20 28 74 6f 74 61  een done.. (tota
18c0: 6c 2d 63 6f 75 6e 74 20 31 39 20 25 74 65 73 74  l-count 19 %test
18d0: 2d 72 75 6e 6e 65 72 2d 74 6f 74 61 6c 2d 63 6f  -runner-total-co
18e0: 75 6e 74 20 25 74 65 73 74 2d 72 75 6e 6e 65 72  unt %test-runner
18f0: 2d 74 6f 74 61 6c 2d 63 6f 75 6e 74 21 29 0a 20  -total-count!). 
1900: 3b 3b 20 53 74 61 63 6b 20 28 6c 69 73 74 29 20  ;; Stack (list) 
1910: 6f 66 20 28 63 6f 75 6e 74 2d 61 74 2d 73 74 61  of (count-at-sta
1920: 72 74 20 2e 20 65 78 70 65 63 74 65 64 2d 63 6f  rt . expected-co
1930: 75 6e 74 29 3a 0a 20 28 63 6f 75 6e 74 2d 6c 69  unt):. (count-li
1940: 73 74 20 32 30 20 25 74 65 73 74 2d 72 75 6e 6e  st 20 %test-runn
1950: 65 72 2d 63 6f 75 6e 74 2d 6c 69 73 74 20 25 74  er-count-list %t
1960: 65 73 74 2d 72 75 6e 6e 65 72 2d 63 6f 75 6e 74  est-runner-count
1970: 2d 6c 69 73 74 21 29 0a 20 28 72 65 73 75 6c 74  -list!). (result
1980: 2d 61 6c 69 73 74 20 32 31 20 74 65 73 74 2d 72  -alist 21 test-r
1990: 65 73 75 6c 74 2d 61 6c 69 73 74 20 74 65 73 74  esult-alist test
19a0: 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 29 0a  -result-alist!).
19b0: 20 3b 3b 20 46 69 65 6c 64 20 63 61 6e 20 62 65   ;; Field can be
19c0: 20 75 73 65 64 20 62 79 20 74 65 73 74 2d 72 75   used by test-ru
19d0: 6e 6e 65 72 20 66 6f 72 20 61 6e 79 20 70 75 72  nner for any pur
19e0: 70 6f 73 65 2e 0a 20 3b 3b 20 74 65 73 74 2d 72  pose.. ;; test-r
19f0: 75 6e 6e 65 72 2d 73 69 6d 70 6c 65 20 75 73 65  unner-simple use
1a00: 73 20 69 74 20 66 6f 72 20 61 20 6c 6f 67 20 66  s it for a log f
1a10: 69 6c 65 2e 0a 20 28 61 75 78 2d 76 61 6c 75 65  ile.. (aux-value
1a20: 20 32 32 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d   22 test-runner-
1a30: 61 75 78 2d 76 61 6c 75 65 20 74 65 73 74 2d 72  aux-value test-r
1a40: 75 6e 6e 65 72 2d 61 75 78 2d 76 61 6c 75 65 21  unner-aux-value!
1a50: 29 0a 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65  ).)..(define (te
1a60: 73 74 2d 72 75 6e 6e 65 72 2d 72 65 73 65 74 20  st-runner-reset 
1a70: 72 75 6e 6e 65 72 29 0a 20 20 20 20 28 74 65 73  runner).    (tes
1a80: 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20  t-result-alist! 
1a90: 72 75 6e 6e 65 72 20 27 28 29 29 0a 20 20 20 20  runner '()).    
1aa0: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 70 61 73  (test-runner-pas
1ab0: 73 2d 63 6f 75 6e 74 21 20 72 75 6e 6e 65 72 20  s-count! runner 
1ac0: 30 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e  0).    (test-run
1ad0: 6e 65 72 2d 66 61 69 6c 2d 63 6f 75 6e 74 21 20  ner-fail-count! 
1ae0: 72 75 6e 6e 65 72 20 30 29 0a 20 20 20 20 28 74  runner 0).    (t
1af0: 65 73 74 2d 72 75 6e 6e 65 72 2d 78 70 61 73 73  est-runner-xpass
1b00: 2d 63 6f 75 6e 74 21 20 72 75 6e 6e 65 72 20 30  -count! runner 0
1b10: 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e 6e  ).    (test-runn
1b20: 65 72 2d 78 66 61 69 6c 2d 63 6f 75 6e 74 21 20  er-xfail-count! 
1b30: 72 75 6e 6e 65 72 20 30 29 0a 20 20 20 20 28 74  runner 0).    (t
1b40: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
1b50: 63 6f 75 6e 74 21 20 72 75 6e 6e 65 72 20 30 29  count! runner 0)
1b60: 0a 20 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e  .    (%test-runn
1b70: 65 72 2d 74 6f 74 61 6c 2d 63 6f 75 6e 74 21 20  er-total-count! 
1b80: 72 75 6e 6e 65 72 20 30 29 0a 20 20 20 20 28 25  runner 0).    (%
1b90: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 6f 75 6e  test-runner-coun
1ba0: 74 2d 6c 69 73 74 21 20 72 75 6e 6e 65 72 20 27  t-list! runner '
1bb0: 28 29 29 0a 20 20 20 20 28 25 74 65 73 74 2d 72  ()).    (%test-r
1bc0: 75 6e 6e 65 72 2d 72 75 6e 2d 6c 69 73 74 21 20  unner-run-list! 
1bd0: 72 75 6e 6e 65 72 20 23 74 29 0a 20 20 20 20 28  runner #t).    (
1be0: 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69  %test-runner-ski
1bf0: 70 2d 6c 69 73 74 21 20 72 75 6e 6e 65 72 20 27  p-list! runner '
1c00: 28 29 29 0a 20 20 20 20 28 25 74 65 73 74 2d 72  ()).    (%test-r
1c10: 75 6e 6e 65 72 2d 66 61 69 6c 2d 6c 69 73 74 21  unner-fail-list!
1c20: 20 72 75 6e 6e 65 72 20 27 28 29 29 0a 20 20 20   runner '()).   
1c30: 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73   (%test-runner-s
1c40: 6b 69 70 2d 73 61 76 65 21 20 72 75 6e 6e 65 72  kip-save! runner
1c50: 20 27 28 29 29 0a 20 20 20 20 28 25 74 65 73 74   '()).    (%test
1c60: 2d 72 75 6e 6e 65 72 2d 66 61 69 6c 2d 73 61 76  -runner-fail-sav
1c70: 65 21 20 72 75 6e 6e 65 72 20 27 28 29 29 0a 20  e! runner '()). 
1c80: 20 20 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d     (test-runner-
1c90: 67 72 6f 75 70 2d 73 74 61 63 6b 21 20 72 75 6e  group-stack! run
1ca0: 6e 65 72 20 27 28 29 29 29 0a 0a 28 64 65 66 69  ner '()))..(defi
1cb0: 6e 65 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d  ne (test-runner-
1cc0: 67 72 6f 75 70 2d 70 61 74 68 20 72 75 6e 6e 65  group-path runne
1cd0: 72 29 0a 20 20 28 72 65 76 65 72 73 65 20 28 74  r).  (reverse (t
1ce0: 65 73 74 2d 72 75 6e 6e 65 72 2d 67 72 6f 75 70  est-runner-group
1cf0: 2d 73 74 61 63 6b 20 72 75 6e 6e 65 72 29 29 29  -stack runner)))
1d00: 0a 0a 28 64 65 66 69 6e 65 20 28 25 74 65 73 74  ..(define (%test
1d10: 2d 6e 75 6c 6c 2d 63 61 6c 6c 62 61 63 6b 20 72  -null-callback r
1d20: 75 6e 6e 65 72 29 20 23 66 29 0a 0a 28 64 65 66  unner) #f)..(def
1d30: 69 6e 65 20 28 74 65 73 74 2d 72 75 6e 6e 65 72  ine (test-runner
1d40: 2d 6e 75 6c 6c 29 0a 20 20 28 6c 65 74 20 28 28  -null).  (let ((
1d50: 72 75 6e 6e 65 72 20 28 25 74 65 73 74 2d 72 75  runner (%test-ru
1d60: 6e 6e 65 72 2d 61 6c 6c 6f 63 29 29 29 0a 20 20  nner-alloc))).  
1d70: 20 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 72    (test-runner-r
1d80: 65 73 65 74 20 72 75 6e 6e 65 72 29 0a 20 20 20  eset runner).   
1d90: 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e   (test-runner-on
1da0: 2d 67 72 6f 75 70 2d 62 65 67 69 6e 21 20 72 75  -group-begin! ru
1db0: 6e 6e 65 72 20 28 6c 61 6d 62 64 61 20 28 72 75  nner (lambda (ru
1dc0: 6e 6e 65 72 20 6e 61 6d 65 20 63 6f 75 6e 74 29  nner name count)
1dd0: 20 23 66 29 29 0a 20 20 20 20 28 74 65 73 74 2d   #f)).    (test-
1de0: 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75 70 2d  runner-on-group-
1df0: 65 6e 64 21 20 72 75 6e 6e 65 72 20 25 74 65 73  end! runner %tes
1e00: 74 2d 6e 75 6c 6c 2d 63 61 6c 6c 62 61 63 6b 29  t-null-callback)
1e10: 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e 6e 65  .    (test-runne
1e20: 72 2d 6f 6e 2d 66 69 6e 61 6c 21 20 72 75 6e 6e  r-on-final! runn
1e30: 65 72 20 25 74 65 73 74 2d 6e 75 6c 6c 2d 63 61  er %test-null-ca
1e40: 6c 6c 62 61 63 6b 29 0a 20 20 20 20 28 74 65 73  llback).    (tes
1e50: 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74  t-runner-on-test
1e60: 2d 62 65 67 69 6e 21 20 72 75 6e 6e 65 72 20 25  -begin! runner %
1e70: 74 65 73 74 2d 6e 75 6c 6c 2d 63 61 6c 6c 62 61  test-null-callba
1e80: 63 6b 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75  ck).    (test-ru
1e90: 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64  nner-on-test-end
1ea0: 21 20 72 75 6e 6e 65 72 20 25 74 65 73 74 2d 6e  ! runner %test-n
1eb0: 75 6c 6c 2d 63 61 6c 6c 62 61 63 6b 29 0a 20 20  ull-callback).  
1ec0: 20 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f    (test-runner-o
1ed0: 6e 2d 62 61 64 2d 63 6f 75 6e 74 21 20 72 75 6e  n-bad-count! run
1ee0: 6e 65 72 20 28 6c 61 6d 62 64 61 20 28 72 75 6e  ner (lambda (run
1ef0: 6e 65 72 20 63 6f 75 6e 74 20 65 78 70 65 63 74  ner count expect
1f00: 65 64 29 20 23 66 29 29 0a 20 20 20 20 28 74 65  ed) #f)).    (te
1f10: 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 62 61 64  st-runner-on-bad
1f20: 2d 65 6e 64 2d 6e 61 6d 65 21 20 72 75 6e 6e 65  -end-name! runne
1f30: 72 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 6e 65  r (lambda (runne
1f40: 72 20 62 65 67 69 6e 20 65 6e 64 29 20 23 66 29  r begin end) #f)
1f50: 29 0a 20 20 20 20 72 75 6e 6e 65 72 29 29 0a 0a  ).    runner))..
1f60: 3b 3b 20 4e 6f 74 20 70 61 72 74 20 6f 66 20 74  ;; Not part of t
1f70: 68 65 20 73 70 65 63 69 66 69 63 61 74 69 6f 6e  he specification
1f80: 2e 20 20 46 49 58 4d 45 0a 3b 3b 20 43 6f 6e 74  .  FIXME.;; Cont
1f90: 72 6f 6c 73 20 77 68 65 74 68 65 72 20 61 20 6c  rols whether a l
1fa0: 6f 67 20 66 69 6c 65 20 69 73 20 67 65 6e 65 72  og file is gener
1fb0: 61 74 65 64 2e 0a 28 64 65 66 69 6e 65 20 74 65  ated..(define te
1fc0: 73 74 2d 6c 6f 67 2d 74 6f 2d 66 69 6c 65 20 23  st-log-to-file #
1fd0: 46 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73  F)..(define (tes
1fe0: 74 2d 72 75 6e 6e 65 72 2d 73 69 6d 70 6c 65 29  t-runner-simple)
1ff0: 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 6e 65 72  .  (let ((runner
2000: 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 61   (%test-runner-a
2010: 6c 6c 6f 63 29 29 29 0a 20 20 20 20 28 74 65 73  lloc))).    (tes
2020: 74 2d 72 75 6e 6e 65 72 2d 72 65 73 65 74 20 72  t-runner-reset r
2030: 75 6e 6e 65 72 29 0a 20 20 20 20 28 74 65 73 74  unner).    (test
2040: 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75 70  -runner-on-group
2050: 2d 62 65 67 69 6e 21 20 72 75 6e 6e 65 72 20 74  -begin! runner t
2060: 65 73 74 2d 6f 6e 2d 67 72 6f 75 70 2d 62 65 67  est-on-group-beg
2070: 69 6e 2d 73 69 6d 70 6c 65 29 0a 20 20 20 20 28  in-simple).    (
2080: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 67  test-runner-on-g
2090: 72 6f 75 70 2d 65 6e 64 21 20 72 75 6e 6e 65 72  roup-end! runner
20a0: 20 74 65 73 74 2d 6f 6e 2d 67 72 6f 75 70 2d 65   test-on-group-e
20b0: 6e 64 2d 73 69 6d 70 6c 65 29 0a 20 20 20 20 28  nd-simple).    (
20c0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 66  test-runner-on-f
20d0: 69 6e 61 6c 21 20 72 75 6e 6e 65 72 20 74 65 73  inal! runner tes
20e0: 74 2d 6f 6e 2d 66 69 6e 61 6c 2d 73 69 6d 70 6c  t-on-final-simpl
20f0: 65 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e  e).    (test-run
2100: 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 62 65 67 69  ner-on-test-begi
2110: 6e 21 20 72 75 6e 6e 65 72 20 74 65 73 74 2d 6f  n! runner test-o
2120: 6e 2d 74 65 73 74 2d 62 65 67 69 6e 2d 73 69 6d  n-test-begin-sim
2130: 70 6c 65 29 0a 20 20 20 20 28 74 65 73 74 2d 72  ple).    (test-r
2140: 75 6e 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 65 6e  unner-on-test-en
2150: 64 21 20 72 75 6e 6e 65 72 20 74 65 73 74 2d 6f  d! runner test-o
2160: 6e 2d 74 65 73 74 2d 65 6e 64 2d 73 69 6d 70 6c  n-test-end-simpl
2170: 65 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e  e).    (test-run
2180: 6e 65 72 2d 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74  ner-on-bad-count
2190: 21 20 72 75 6e 6e 65 72 20 74 65 73 74 2d 6f 6e  ! runner test-on
21a0: 2d 62 61 64 2d 63 6f 75 6e 74 2d 73 69 6d 70 6c  -bad-count-simpl
21b0: 65 29 0a 20 20 20 20 28 74 65 73 74 2d 72 75 6e  e).    (test-run
21c0: 6e 65 72 2d 6f 6e 2d 62 61 64 2d 65 6e 64 2d 6e  ner-on-bad-end-n
21d0: 61 6d 65 21 20 72 75 6e 6e 65 72 20 74 65 73 74  ame! runner test
21e0: 2d 6f 6e 2d 62 61 64 2d 65 6e 64 2d 6e 61 6d 65  -on-bad-end-name
21f0: 2d 73 69 6d 70 6c 65 29 0a 20 20 20 20 72 75 6e  -simple).    run
2200: 6e 65 72 29 29 0a 0a 28 63 6f 6e 64 2d 65 78 70  ner))..(cond-exp
2210: 61 6e 64 0a 20 28 73 72 66 69 2d 33 39 0a 20 20  and. (srfi-39.  
2220: 28 64 65 66 69 6e 65 20 74 65 73 74 2d 72 75 6e  (define test-run
2230: 6e 65 72 2d 63 75 72 72 65 6e 74 20 28 6d 61 6b  ner-current (mak
2240: 65 2d 70 61 72 61 6d 65 74 65 72 20 23 66 29 29  e-parameter #f))
2250: 0a 20 20 28 64 65 66 69 6e 65 20 74 65 73 74 2d  .  (define test-
2260: 72 75 6e 6e 65 72 2d 66 61 63 74 6f 72 79 20 28  runner-factory (
2270: 6d 61 6b 65 2d 70 61 72 61 6d 65 74 65 72 20 74  make-parameter t
2280: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 69 6d 70 6c  est-runner-simpl
2290: 65 29 29 29 0a 20 28 65 6c 73 65 0a 20 20 28 64  e))). (else.  (d
22a0: 65 66 69 6e 65 20 25 74 65 73 74 2d 72 75 6e 6e  efine %test-runn
22b0: 65 72 2d 63 75 72 72 65 6e 74 20 23 66 29 0a 20  er-current #f). 
22c0: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20   (define-syntax 
22d0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72  test-runner-curr
22e0: 65 6e 74 0a 20 20 20 20 28 73 79 6e 74 61 78 2d  ent.    (syntax-
22f0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28  rules ().      (
2300: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72  (test-runner-cur
2310: 72 65 6e 74 29 0a 20 20 20 20 20 20 20 25 74 65  rent).       %te
2320: 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72 65 6e  st-runner-curren
2330: 74 29 0a 20 20 20 20 20 20 28 28 74 65 73 74 2d  t).      ((test-
2340: 72 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74 20 72  runner-current r
2350: 75 6e 6e 65 72 29 0a 20 20 20 20 20 20 20 28 73  unner).       (s
2360: 65 74 21 20 25 74 65 73 74 2d 72 75 6e 6e 65 72  et! %test-runner
2370: 2d 63 75 72 72 65 6e 74 20 72 75 6e 6e 65 72 29  -current runner)
2380: 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 25 74  ))).  (define %t
2390: 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61 63 74 6f  est-runner-facto
23a0: 72 79 20 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73  ry test-runner-s
23b0: 69 6d 70 6c 65 29 0a 20 20 28 64 65 66 69 6e 65  imple).  (define
23c0: 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 72 75 6e  -syntax test-run
23d0: 6e 65 72 2d 66 61 63 74 6f 72 79 0a 20 20 20 20  ner-factory.    
23e0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
23f0: 0a 20 20 20 20 20 20 28 28 74 65 73 74 2d 72 75  .      ((test-ru
2400: 6e 6e 65 72 2d 66 61 63 74 6f 72 79 29 0a 20 20  nner-factory).  
2410: 20 20 20 20 20 25 74 65 73 74 2d 72 75 6e 6e 65       %test-runne
2420: 72 2d 66 61 63 74 6f 72 79 29 0a 20 20 20 20 20  r-factory).     
2430: 20 28 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 66   ((test-runner-f
2440: 61 63 74 6f 72 79 20 72 75 6e 6e 65 72 29 0a 20  actory runner). 
2450: 20 20 20 20 20 20 28 73 65 74 21 20 25 74 65 73        (set! %tes
2460: 74 2d 72 75 6e 6e 65 72 2d 66 61 63 74 6f 72 79  t-runner-factory
2470: 20 72 75 6e 6e 65 72 29 29 29 29 29 29 0a 0a 3b   runner))))))..;
2480: 3b 20 41 20 73 61 66 65 72 20 77 72 61 70 70 65  ; A safer wrappe
2490: 72 20 74 6f 20 74 65 73 74 2d 72 75 6e 6e 65 72  r to test-runner
24a0: 2d 63 75 72 72 65 6e 74 2e 0a 28 64 65 66 69 6e  -current..(defin
24b0: 65 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67  e (test-runner-g
24c0: 65 74 29 0a 20 20 28 6c 65 74 20 28 28 72 20 28  et).  (let ((r (
24d0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72  test-runner-curr
24e0: 65 6e 74 29 29 29 0a 20 20 20 20 28 69 66 20 28  ent))).    (if (
24f0: 6e 6f 74 20 72 29 0a 09 28 63 6f 6e 64 2d 65 78  not r)..(cond-ex
2500: 70 61 6e 64 0a 09 20 28 73 72 66 69 2d 32 33 20  pand.. (srfi-23 
2510: 28 65 72 72 6f 72 20 22 74 65 73 74 2d 72 75 6e  (error "test-run
2520: 6e 65 72 20 6e 6f 74 20 69 6e 69 74 69 61 6c 69  ner not initiali
2530: 7a 65 64 20 2d 20 74 65 73 74 2d 62 65 67 69 6e  zed - test-begin
2540: 20 6d 69 73 73 69 6e 67 3f 22 29 29 0a 09 20 28   missing?")).. (
2550: 65 6c 73 65 20 23 74 29 29 29 0a 20 20 20 20 72  else #t))).    r
2560: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 74 65  ))..(define (%te
2570: 73 74 2d 73 70 65 63 69 66 69 63 69 65 72 2d 6d  st-specificier-m
2580: 61 74 63 68 65 73 20 73 70 65 63 20 72 75 6e 6e  atches spec runn
2590: 65 72 29 0a 20 20 28 73 70 65 63 20 72 75 6e 6e  er).  (spec runn
25a0: 65 72 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74  er))..(define (t
25b0: 65 73 74 2d 72 75 6e 6e 65 72 2d 63 72 65 61 74  est-runner-creat
25c0: 65 29 0a 20 20 28 28 74 65 73 74 2d 72 75 6e 6e  e).  ((test-runn
25d0: 65 72 2d 66 61 63 74 6f 72 79 29 29 29 0a 0a 28  er-factory)))..(
25e0: 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d 61 6e  define (%test-an
25f0: 79 2d 73 70 65 63 69 66 69 65 72 2d 6d 61 74 63  y-specifier-matc
2600: 68 65 73 20 6c 69 73 74 20 72 75 6e 6e 65 72 29  hes list runner)
2610: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74  .  (let ((result
2620: 20 23 66 29 29 0a 20 20 20 20 28 6c 65 74 20 6c   #f)).    (let l
2630: 6f 6f 70 20 28 28 6c 20 6c 69 73 74 29 29 0a 20  oop ((l list)). 
2640: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c       (cond ((nul
2650: 6c 3f 20 6c 29 20 72 65 73 75 6c 74 29 0a 09 20  l? l) result).. 
2660: 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 20 28     (else..     (
2670: 69 66 20 28 25 74 65 73 74 2d 73 70 65 63 69 66  if (%test-specif
2680: 69 63 69 65 72 2d 6d 61 74 63 68 65 73 20 28 63  icier-matches (c
2690: 61 72 20 6c 29 20 72 75 6e 6e 65 72 29 0a 09 09  ar l) runner)...
26a0: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 23 74   (set! result #t
26b0: 29 29 0a 09 20 20 20 20 20 28 6c 6f 6f 70 20 28  ))..     (loop (
26c0: 63 64 72 20 6c 29 29 29 29 29 29 29 0a 0a 3b 3b  cdr l)))))))..;;
26d0: 20 52 65 74 75 72 6e 73 20 23 66 2c 20 23 74 2c   Returns #f, #t,
26e0: 20 6f 72 20 27 78 66 61 69 6c 2e 0a 28 64 65 66   or 'xfail..(def
26f0: 69 6e 65 20 28 25 74 65 73 74 2d 73 68 6f 75 6c  ine (%test-shoul
2700: 64 2d 65 78 65 63 75 74 65 20 72 75 6e 6e 65 72  d-execute runner
2710: 29 0a 20 20 28 6c 65 74 20 28 28 72 75 6e 20 28  ).  (let ((run (
2720: 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 72 75 6e  %test-runner-run
2730: 2d 6c 69 73 74 20 72 75 6e 6e 65 72 29 29 29 0a  -list runner))).
2740: 20 20 20 20 28 63 6f 6e 64 20 28 28 6f 72 0a 09      (cond ((or..
2750: 20 20 20 20 28 6e 6f 74 20 28 6f 72 20 28 65 71      (not (or (eq
2760: 76 3f 20 72 75 6e 20 23 74 29 0a 09 09 20 20 20  v? run #t)...   
2770: 20 20 28 25 74 65 73 74 2d 61 6e 79 2d 73 70 65    (%test-any-spe
2780: 63 69 66 69 65 72 2d 6d 61 74 63 68 65 73 20 72  cifier-matches r
2790: 75 6e 20 72 75 6e 6e 65 72 29 29 29 0a 09 20 20  un runner)))..  
27a0: 20 20 28 25 74 65 73 74 2d 61 6e 79 2d 73 70 65    (%test-any-spe
27b0: 63 69 66 69 65 72 2d 6d 61 74 63 68 65 73 0a 09  cifier-matches..
27c0: 20 20 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e       (%test-runn
27d0: 65 72 2d 73 6b 69 70 2d 6c 69 73 74 20 72 75 6e  er-skip-list run
27e0: 6e 65 72 29 0a 09 20 20 20 20 20 72 75 6e 6e 65  ner)..     runne
27f0: 72 29 29 0a 09 20 20 20 20 28 74 65 73 74 2d 72  r))..    (test-r
2800: 65 73 75 6c 74 2d 73 65 74 21 20 72 75 6e 6e 65  esult-set! runne
2810: 72 20 27 72 65 73 75 6c 74 2d 6b 69 6e 64 20 27  r 'result-kind '
2820: 73 6b 69 70 29 0a 09 20 20 20 20 23 66 29 0a 09  skip)..    #f)..
2830: 20 20 28 28 25 74 65 73 74 2d 61 6e 79 2d 73 70    ((%test-any-sp
2840: 65 63 69 66 69 65 72 2d 6d 61 74 63 68 65 73 0a  ecifier-matches.
2850: 09 20 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e  .    (%test-runn
2860: 65 72 2d 66 61 69 6c 2d 6c 69 73 74 20 72 75 6e  er-fail-list run
2870: 6e 65 72 29 0a 09 20 20 20 20 72 75 6e 6e 65 72  ner)..    runner
2880: 29 0a 09 20 20 20 28 74 65 73 74 2d 72 65 73 75  )..   (test-resu
2890: 6c 74 2d 73 65 74 21 20 72 75 6e 6e 65 72 20 27  lt-set! runner '
28a0: 72 65 73 75 6c 74 2d 6b 69 6e 64 20 27 78 66 61  result-kind 'xfa
28b0: 69 6c 29 0a 09 20 20 20 27 78 66 61 69 6c 29 0a  il)..   'xfail).
28c0: 09 20 20 28 65 6c 73 65 20 23 74 29 29 29 29 0a  .  (else #t)))).
28d0: 0a 28 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d  .(define (%test-
28e0: 62 65 67 69 6e 20 73 75 69 74 65 2d 6e 61 6d 65  begin suite-name
28f0: 20 63 6f 75 6e 74 29 0a 20 20 28 69 66 20 28 6e   count).  (if (n
2900: 6f 74 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d  ot (test-runner-
2910: 63 75 72 72 65 6e 74 29 29 0a 20 20 20 20 20 20  current)).      
2920: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72  (test-runner-cur
2930: 72 65 6e 74 20 28 74 65 73 74 2d 72 75 6e 6e 65  rent (test-runne
2940: 72 2d 63 72 65 61 74 65 29 29 29 0a 20 20 28 6c  r-create))).  (l
2950: 65 74 20 28 28 72 75 6e 6e 65 72 20 28 74 65 73  et ((runner (tes
2960: 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74  t-runner-current
2970: 29 29 29 0a 20 20 20 20 28 28 74 65 73 74 2d 72  ))).    ((test-r
2980: 75 6e 6e 65 72 2d 6f 6e 2d 67 72 6f 75 70 2d 62  unner-on-group-b
2990: 65 67 69 6e 20 72 75 6e 6e 65 72 29 20 72 75 6e  egin runner) run
29a0: 6e 65 72 20 73 75 69 74 65 2d 6e 61 6d 65 20 63  ner suite-name c
29b0: 6f 75 6e 74 29 0a 20 20 20 20 28 25 74 65 73 74  ount).    (%test
29c0: 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d 73 61 76  -runner-skip-sav
29d0: 65 21 20 72 75 6e 6e 65 72 0a 09 09 09 20 20 20  e! runner....   
29e0: 20 20 20 20 28 63 6f 6e 73 20 28 25 74 65 73 74      (cons (%test
29f0: 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d 6c 69 73  -runner-skip-lis
2a00: 74 20 72 75 6e 6e 65 72 29 0a 09 09 09 09 20 20  t runner).....  
2a10: 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72     (%test-runner
2a20: 2d 73 6b 69 70 2d 73 61 76 65 20 72 75 6e 6e 65  -skip-save runne
2a30: 72 29 29 29 0a 20 20 20 20 28 25 74 65 73 74 2d  r))).    (%test-
2a40: 72 75 6e 6e 65 72 2d 66 61 69 6c 2d 73 61 76 65  runner-fail-save
2a50: 21 20 72 75 6e 6e 65 72 0a 09 09 09 20 20 20 20  ! runner....    
2a60: 20 20 20 28 63 6f 6e 73 20 28 25 74 65 73 74 2d     (cons (%test-
2a70: 72 75 6e 6e 65 72 2d 66 61 69 6c 2d 6c 69 73 74  runner-fail-list
2a80: 20 72 75 6e 6e 65 72 29 0a 09 09 09 09 20 20 20   runner).....   
2a90: 20 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d    (%test-runner-
2aa0: 66 61 69 6c 2d 73 61 76 65 20 72 75 6e 6e 65 72  fail-save runner
2ab0: 29 29 29 0a 20 20 20 20 28 25 74 65 73 74 2d 72  ))).    (%test-r
2ac0: 75 6e 6e 65 72 2d 63 6f 75 6e 74 2d 6c 69 73 74  unner-count-list
2ad0: 21 20 72 75 6e 6e 65 72 0a 09 09 09 20 20 20 20  ! runner....    
2ae0: 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 28 25 74   (cons (cons (%t
2af0: 65 73 74 2d 72 75 6e 6e 65 72 2d 74 6f 74 61 6c  est-runner-total
2b00: 2d 63 6f 75 6e 74 20 72 75 6e 6e 65 72 29 0a 09  -count runner)..
2b10: 09 09 09 09 20 63 6f 75 6e 74 29 0a 09 09 09 09  .... count).....
2b20: 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72     (%test-runner
2b30: 2d 63 6f 75 6e 74 2d 6c 69 73 74 20 72 75 6e 6e  -count-list runn
2b40: 65 72 29 29 29 0a 20 20 20 20 28 74 65 73 74 2d  er))).    (test-
2b50: 72 75 6e 6e 65 72 2d 67 72 6f 75 70 2d 73 74 61  runner-group-sta
2b60: 63 6b 21 20 72 75 6e 6e 65 72 20 28 63 6f 6e 73  ck! runner (cons
2b70: 20 73 75 69 74 65 2d 6e 61 6d 65 0a 09 09 09 09   suite-name.....
2b80: 09 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67 72  .(test-runner-gr
2b90: 6f 75 70 2d 73 74 61 63 6b 20 72 75 6e 6e 65 72  oup-stack runner
2ba0: 29 29 29 29 29 0a 28 63 6f 6e 64 2d 65 78 70 61  ))))).(cond-expa
2bb0: 6e 64 0a 20 28 28 61 6e 64 20 28 6e 6f 74 20 72  nd. ((and (not r
2bc0: 36 72 73 29 20 6b 61 77 61 29 0a 20 20 3b 3b 20  6rs) kawa).  ;; 
2bd0: 4b 61 77 61 20 68 61 73 20 74 65 73 74 2d 62 65  Kawa has test-be
2be0: 67 69 6e 20 62 75 69 6c 74 20 69 6e 2c 20 69 6d  gin built in, im
2bf0: 70 6c 65 6d 65 6e 74 65 64 20 61 73 3a 0a 20 20  plemented as:.  
2c00: 3b 3b 20 28 62 65 67 69 6e 0a 20 20 3b 3b 20 20  ;; (begin.  ;;  
2c10: 20 28 63 6f 6e 64 2d 65 78 70 61 6e 64 20 28 73   (cond-expand (s
2c20: 72 66 69 2d 36 34 20 23 21 76 6f 69 64 29 20 28  rfi-64 #!void) (
2c30: 65 6c 73 65 20 28 72 65 71 75 69 72 65 20 27 73  else (require 's
2c40: 72 66 69 2d 36 34 29 29 29 0a 20 20 3b 3b 20 20  rfi-64))).  ;;  
2c50: 20 28 25 74 65 73 74 2d 62 65 67 69 6e 20 73 75   (%test-begin su
2c60: 69 74 65 2d 6e 61 6d 65 20 5b 63 6f 75 6e 74 5d  ite-name [count]
2c70: 29 29 0a 20 20 3b 3b 20 54 68 69 73 20 70 75 74  )).  ;; This put
2c80: 73 20 74 65 73 74 2d 62 65 67 69 6e 20 62 75 74  s test-begin but
2c90: 20 6f 6e 6c 79 20 74 65 73 74 2d 62 65 67 69 6e   only test-begin
2ca0: 20 69 6e 20 74 68 65 20 64 65 66 61 75 6c 74 20   in the default 
2cb0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e 2c 0a 20 20  environment.,.  
2cc0: 3b 3b 20 77 68 69 63 68 20 6d 61 6b 65 73 20 6e  ;; which makes n
2cd0: 6f 72 6d 61 6c 20 74 65 73 74 20 73 75 69 74 65  ormal test suite
2ce0: 73 20 6c 6f 61 64 61 62 6c 65 20 77 69 74 68 6f  s loadable witho
2cf0: 75 74 20 6e 6f 6e 2d 70 6f 72 74 61 62 6c 65 20  ut non-portable 
2d00: 63 6f 6d 6d 61 6e 64 73 2e 0a 20 20 29 0a 20 28  commands..  ). (
2d10: 65 6c 73 65 0a 20 20 28 64 65 66 69 6e 65 2d 73  else.  (define-s
2d20: 79 6e 74 61 78 20 74 65 73 74 2d 62 65 67 69 6e  yntax test-begin
2d30: 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c  .    (syntax-rul
2d40: 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 74 65  es ().      ((te
2d50: 73 74 2d 62 65 67 69 6e 20 73 75 69 74 65 2d 6e  st-begin suite-n
2d60: 61 6d 65 29 0a 20 20 20 20 20 20 20 28 25 74 65  ame).       (%te
2d70: 73 74 2d 62 65 67 69 6e 20 73 75 69 74 65 2d 6e  st-begin suite-n
2d80: 61 6d 65 20 23 66 29 29 0a 20 20 20 20 20 20 28  ame #f)).      (
2d90: 28 74 65 73 74 2d 62 65 67 69 6e 20 73 75 69 74  (test-begin suit
2da0: 65 2d 6e 61 6d 65 20 63 6f 75 6e 74 29 0a 20 20  e-name count).  
2db0: 20 20 20 20 20 28 25 74 65 73 74 2d 62 65 67 69       (%test-begi
2dc0: 6e 20 73 75 69 74 65 2d 6e 61 6d 65 20 63 6f 75  n suite-name cou
2dd0: 6e 74 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e  nt))))))..(defin
2de0: 65 20 28 74 65 73 74 2d 6f 6e 2d 67 72 6f 75 70  e (test-on-group
2df0: 2d 62 65 67 69 6e 2d 73 69 6d 70 6c 65 20 72 75  -begin-simple ru
2e00: 6e 6e 65 72 20 73 75 69 74 65 2d 6e 61 6d 65 20  nner suite-name 
2e10: 63 6f 75 6e 74 29 0a 20 20 28 69 66 20 28 6e 75  count).  (if (nu
2e20: 6c 6c 3f 20 28 74 65 73 74 2d 72 75 6e 6e 65 72  ll? (test-runner
2e30: 2d 67 72 6f 75 70 2d 73 74 61 63 6b 20 72 75 6e  -group-stack run
2e40: 6e 65 72 29 29 0a 20 20 20 20 20 20 28 62 65 67  ner)).      (beg
2e50: 69 6e 0a 09 28 64 69 73 70 6c 61 79 20 22 25 25  in..(display "%%
2e60: 25 25 20 53 74 61 72 74 69 6e 67 20 74 65 73 74  %% Starting test
2e70: 20 22 29 0a 09 28 64 69 73 70 6c 61 79 20 73 75   ")..(display su
2e80: 69 74 65 2d 6e 61 6d 65 29 0a 09 28 69 66 20 74  ite-name)..(if t
2e90: 65 73 74 2d 6c 6f 67 2d 74 6f 2d 66 69 6c 65 0a  est-log-to-file.
2ea0: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 6f 67  .    (let* ((log
2eb0: 2d 66 69 6c 65 2d 6e 61 6d 65 0a 09 09 20 20 20  -file-name...   
2ec0: 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 74 65   (if (string? te
2ed0: 73 74 2d 6c 6f 67 2d 74 6f 2d 66 69 6c 65 29 20  st-log-to-file) 
2ee0: 74 65 73 74 2d 6c 6f 67 2d 74 6f 2d 66 69 6c 65  test-log-to-file
2ef0: 0a 09 09 09 28 73 74 72 69 6e 67 2d 61 70 70 65  ....(string-appe
2f00: 6e 64 20 73 75 69 74 65 2d 6e 61 6d 65 20 22 2e  nd suite-name ".
2f10: 6c 6f 67 22 29 29 29 0a 09 09 20 20 20 28 6c 6f  log")))...   (lo
2f20: 67 2d 66 69 6c 65 0a 09 09 20 20 20 20 28 63 6f  g-file...    (co
2f30: 6e 64 2d 65 78 70 61 6e 64 20 28 28 61 6e 64 20  nd-expand ((and 
2f40: 28 6e 6f 74 20 72 36 72 73 29 20 6d 7a 73 63 68  (not r6rs) mzsch
2f50: 65 6d 65 29 0a 09 09 09 09 20 20 28 6f 70 65 6e  eme).....  (open
2f60: 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67  -output-file log
2f70: 2d 66 69 6c 65 2d 6e 61 6d 65 20 27 74 72 75 6e  -file-name 'trun
2f80: 63 61 74 65 2f 72 65 70 6c 61 63 65 29 29 0a 09  cate/replace))..
2f90: 09 09 09 20 28 65 6c 73 65 20 28 6f 70 65 6e 2d  ... (else (open-
2fa0: 6f 75 74 70 75 74 2d 66 69 6c 65 20 6c 6f 67 2d  output-file log-
2fb0: 66 69 6c 65 2d 6e 61 6d 65 29 29 29 29 29 0a 09  file-name)))))..
2fc0: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22        (display "
2fd0: 25 25 25 25 20 53 74 61 72 74 69 6e 67 20 74 65  %%%% Starting te
2fe0: 73 74 20 22 20 6c 6f 67 2d 66 69 6c 65 29 0a 09  st " log-file)..
2ff0: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 73        (display s
3000: 75 69 74 65 2d 6e 61 6d 65 20 6c 6f 67 2d 66 69  uite-name log-fi
3010: 6c 65 29 0a 09 20 20 20 20 20 20 28 6e 65 77 6c  le)..      (newl
3020: 69 6e 65 20 6c 6f 67 2d 66 69 6c 65 29 0a 09 20  ine log-file).. 
3030: 20 20 20 20 20 28 74 65 73 74 2d 72 75 6e 6e 65       (test-runne
3040: 72 2d 61 75 78 2d 76 61 6c 75 65 21 20 72 75 6e  r-aux-value! run
3050: 6e 65 72 20 6c 6f 67 2d 66 69 6c 65 29 0a 09 20  ner log-file).. 
3060: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 20       (display " 
3070: 20 28 57 72 69 74 69 6e 67 20 66 75 6c 6c 20 6c   (Writing full l
3080: 6f 67 20 74 6f 20 5c 22 22 29 0a 09 20 20 20 20  og to \"")..    
3090: 20 20 28 64 69 73 70 6c 61 79 20 6c 6f 67 2d 66    (display log-f
30a0: 69 6c 65 2d 6e 61 6d 65 29 0a 09 20 20 20 20 20  ile-name)..     
30b0: 20 28 64 69 73 70 6c 61 79 20 22 5c 22 29 22 29   (display "\")")
30c0: 29 29 0a 09 28 6e 65 77 6c 69 6e 65 29 29 29 0a  ))..(newline))).
30d0: 20 20 28 6c 65 74 20 28 28 6c 6f 67 20 28 74 65    (let ((log (te
30e0: 73 74 2d 72 75 6e 6e 65 72 2d 61 75 78 2d 76 61  st-runner-aux-va
30f0: 6c 75 65 20 72 75 6e 6e 65 72 29 29 29 0a 20 20  lue runner))).  
3100: 20 20 28 69 66 20 28 6f 75 74 70 75 74 2d 70 6f    (if (output-po
3110: 72 74 3f 20 6c 6f 67 29 0a 09 28 62 65 67 69 6e  rt? log)..(begin
3120: 0a 09 20 20 28 64 69 73 70 6c 61 79 20 22 47 72  ..  (display "Gr
3130: 6f 75 70 20 62 65 67 69 6e 3a 20 22 20 6c 6f 67  oup begin: " log
3140: 29 0a 09 20 20 28 64 69 73 70 6c 61 79 20 73 75  )..  (display su
3150: 69 74 65 2d 6e 61 6d 65 20 6c 6f 67 29 0a 09 20  ite-name log).. 
3160: 20 28 6e 65 77 6c 69 6e 65 20 6c 6f 67 29 29 29   (newline log)))
3170: 29 0a 20 20 23 66 29 0a 0a 28 64 65 66 69 6e 65  ).  #f)..(define
3180: 20 28 74 65 73 74 2d 6f 6e 2d 67 72 6f 75 70 2d   (test-on-group-
3190: 65 6e 64 2d 73 69 6d 70 6c 65 20 72 75 6e 6e 65  end-simple runne
31a0: 72 29 0a 20 20 28 6c 65 74 20 28 28 6c 6f 67 20  r).  (let ((log 
31b0: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 61 75 78  (test-runner-aux
31c0: 2d 76 61 6c 75 65 20 72 75 6e 6e 65 72 29 29 29  -value runner)))
31d0: 0a 20 20 20 20 28 69 66 20 28 6f 75 74 70 75 74  .    (if (output
31e0: 2d 70 6f 72 74 3f 20 6c 6f 67 29 0a 09 28 62 65  -port? log)..(be
31f0: 67 69 6e 0a 09 20 20 28 64 69 73 70 6c 61 79 20  gin..  (display 
3200: 22 47 72 6f 75 70 20 65 6e 64 3a 20 22 20 6c 6f  "Group end: " lo
3210: 67 29 0a 09 20 20 28 64 69 73 70 6c 61 79 20 28  g)..  (display (
3220: 63 61 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72  car (test-runner
3230: 2d 67 72 6f 75 70 2d 73 74 61 63 6b 20 72 75 6e  -group-stack run
3240: 6e 65 72 29 29 20 6c 6f 67 29 0a 09 20 20 28 6e  ner)) log)..  (n
3250: 65 77 6c 69 6e 65 20 6c 6f 67 29 29 29 29 0a 20  ewline log)))). 
3260: 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 25   #f)..(define (%
3270: 74 65 73 74 2d 6f 6e 2d 62 61 64 2d 63 6f 75 6e  test-on-bad-coun
3280: 74 2d 77 72 69 74 65 20 72 75 6e 6e 65 72 20 63  t-write runner c
3290: 6f 75 6e 74 20 65 78 70 65 63 74 65 64 2d 63 6f  ount expected-co
32a0: 75 6e 74 20 70 6f 72 74 29 0a 20 20 28 64 69 73  unt port).  (dis
32b0: 70 6c 61 79 20 22 2a 2a 2a 20 54 6f 74 61 6c 20  play "*** Total 
32c0: 6e 75 6d 62 65 72 20 6f 66 20 74 65 73 74 73 20  number of tests 
32d0: 77 61 73 20 22 20 70 6f 72 74 29 0a 20 20 28 64  was " port).  (d
32e0: 69 73 70 6c 61 79 20 63 6f 75 6e 74 20 70 6f 72  isplay count por
32f0: 74 29 0a 20 20 28 64 69 73 70 6c 61 79 20 22 20  t).  (display " 
3300: 62 75 74 20 73 68 6f 75 6c 64 20 62 65 20 22 20  but should be " 
3310: 70 6f 72 74 29 0a 20 20 28 64 69 73 70 6c 61 79  port).  (display
3320: 20 65 78 70 65 63 74 65 64 2d 63 6f 75 6e 74 20   expected-count 
3330: 70 6f 72 74 29 0a 20 20 28 64 69 73 70 6c 61 79  port).  (display
3340: 20 22 2e 20 2a 2a 2a 22 20 70 6f 72 74 29 0a 20   ". ***" port). 
3350: 20 28 6e 65 77 6c 69 6e 65 20 70 6f 72 74 29 0a   (newline port).
3360: 20 20 28 64 69 73 70 6c 61 79 20 22 2a 2a 2a 20    (display "*** 
3370: 44 69 73 63 72 65 70 61 6e 63 79 20 69 6e 64 69  Discrepancy indi
3380: 63 61 74 65 73 20 74 65 73 74 73 75 69 74 65 20  cates testsuite 
3390: 65 72 72 6f 72 20 6f 72 20 65 78 63 65 70 74 69  error or excepti
33a0: 6f 6e 73 2e 20 2a 2a 2a 22 20 70 6f 72 74 29 0a  ons. ***" port).
33b0: 20 20 28 6e 65 77 6c 69 6e 65 20 70 6f 72 74 29    (newline port)
33c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74  )..(define (test
33d0: 2d 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74 2d 73 69  -on-bad-count-si
33e0: 6d 70 6c 65 20 72 75 6e 6e 65 72 20 63 6f 75 6e  mple runner coun
33f0: 74 20 65 78 70 65 63 74 65 64 2d 63 6f 75 6e 74  t expected-count
3400: 29 0a 20 20 28 25 74 65 73 74 2d 6f 6e 2d 62 61  ).  (%test-on-ba
3410: 64 2d 63 6f 75 6e 74 2d 77 72 69 74 65 20 72 75  d-count-write ru
3420: 6e 6e 65 72 20 63 6f 75 6e 74 20 65 78 70 65 63  nner count expec
3430: 74 65 64 2d 63 6f 75 6e 74 20 28 63 75 72 72 65  ted-count (curre
3440: 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 29  nt-output-port))
3450: 0a 20 20 28 6c 65 74 20 28 28 6c 6f 67 20 28 74  .  (let ((log (t
3460: 65 73 74 2d 72 75 6e 6e 65 72 2d 61 75 78 2d 76  est-runner-aux-v
3470: 61 6c 75 65 20 72 75 6e 6e 65 72 29 29 29 0a 20  alue runner))). 
3480: 20 20 20 28 69 66 20 28 6f 75 74 70 75 74 2d 70     (if (output-p
3490: 6f 72 74 3f 20 6c 6f 67 29 0a 09 28 25 74 65 73  ort? log)..(%tes
34a0: 74 2d 6f 6e 2d 62 61 64 2d 63 6f 75 6e 74 2d 77  t-on-bad-count-w
34b0: 72 69 74 65 20 72 75 6e 6e 65 72 20 63 6f 75 6e  rite runner coun
34c0: 74 20 65 78 70 65 63 74 65 64 2d 63 6f 75 6e 74  t expected-count
34d0: 20 6c 6f 67 29 29 29 29 0a 0a 28 64 65 66 69 6e   log))))..(defin
34e0: 65 20 28 74 65 73 74 2d 6f 6e 2d 62 61 64 2d 65  e (test-on-bad-e
34f0: 6e 64 2d 6e 61 6d 65 2d 73 69 6d 70 6c 65 20 72  nd-name-simple r
3500: 75 6e 6e 65 72 20 62 65 67 69 6e 2d 6e 61 6d 65  unner begin-name
3510: 20 65 6e 64 2d 6e 61 6d 65 29 0a 20 20 28 6c 65   end-name).  (le
3520: 74 20 28 28 6d 73 67 20 28 73 74 72 69 6e 67 2d  t ((msg (string-
3530: 61 70 70 65 6e 64 20 28 25 74 65 73 74 2d 66 6f  append (%test-fo
3540: 72 6d 61 74 2d 6c 69 6e 65 20 72 75 6e 6e 65 72  rmat-line runner
3550: 29 20 22 74 65 73 74 2d 65 6e 64 20 22 20 62 65  ) "test-end " be
3560: 67 69 6e 2d 6e 61 6d 65 0a 09 09 09 20 20 20 20  gin-name....    
3570: 22 20 64 6f 65 73 20 6e 6f 74 20 6d 61 74 63 68  " does not match
3580: 20 74 65 73 74 2d 62 65 67 69 6e 20 22 20 65 6e   test-begin " en
3590: 64 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 63  d-name))).    (c
35a0: 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 20 20 20 20  ond-expand.     
35b0: 28 73 72 66 69 2d 32 33 20 28 65 72 72 6f 72 20  (srfi-23 (error 
35c0: 6d 73 67 29 29 0a 20 20 20 20 20 28 65 6c 73 65  msg)).     (else
35d0: 20 28 64 69 73 70 6c 61 79 20 6d 73 67 29 20 28   (display msg) (
35e0: 6e 65 77 6c 69 6e 65 29 29 29 29 29 0a 20 20 0a  newline))))).  .
35f0: 0a 28 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d  .(define (%test-
3600: 66 69 6e 61 6c 2d 72 65 70 6f 72 74 31 20 76 61  final-report1 va
3610: 6c 75 65 20 6c 61 62 65 6c 20 70 6f 72 74 29 0a  lue label port).
3620: 20 20 28 69 66 20 28 3e 20 76 61 6c 75 65 20 30    (if (> value 0
3630: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09  ).      (begin..
3640: 28 64 69 73 70 6c 61 79 20 6c 61 62 65 6c 20 70  (display label p
3650: 6f 72 74 29 0a 09 28 64 69 73 70 6c 61 79 20 76  ort)..(display v
3660: 61 6c 75 65 20 70 6f 72 74 29 0a 09 28 6e 65 77  alue port)..(new
3670: 6c 69 6e 65 20 70 6f 72 74 29 29 29 29 0a 0a 28  line port))))..(
3680: 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d 66 69  define (%test-fi
3690: 6e 61 6c 2d 72 65 70 6f 72 74 2d 73 69 6d 70 6c  nal-report-simpl
36a0: 65 20 72 75 6e 6e 65 72 20 70 6f 72 74 29 0a 20  e runner port). 
36b0: 20 28 25 74 65 73 74 2d 66 69 6e 61 6c 2d 72 65   (%test-final-re
36c0: 70 6f 72 74 31 20 28 74 65 73 74 2d 72 75 6e 6e  port1 (test-runn
36d0: 65 72 2d 70 61 73 73 2d 63 6f 75 6e 74 20 72 75  er-pass-count ru
36e0: 6e 6e 65 72 29 0a 09 09 20 20 20 20 20 20 22 23  nner)...      "#
36f0: 20 6f 66 20 65 78 70 65 63 74 65 64 20 70 61 73   of expected pas
3700: 73 65 73 20 20 20 20 20 20 22 20 70 6f 72 74 29  ses      " port)
3710: 0a 20 20 28 25 74 65 73 74 2d 66 69 6e 61 6c 2d  .  (%test-final-
3720: 72 65 70 6f 72 74 31 20 28 74 65 73 74 2d 72 75  report1 (test-ru
3730: 6e 6e 65 72 2d 78 66 61 69 6c 2d 63 6f 75 6e 74  nner-xfail-count
3740: 20 72 75 6e 6e 65 72 29 0a 09 09 20 20 20 20 20   runner)...     
3750: 20 22 23 20 6f 66 20 65 78 70 65 63 74 65 64 20   "# of expected 
3760: 66 61 69 6c 75 72 65 73 20 20 20 20 22 20 70 6f  failures    " po
3770: 72 74 29 0a 20 20 28 25 74 65 73 74 2d 66 69 6e  rt).  (%test-fin
3780: 61 6c 2d 72 65 70 6f 72 74 31 20 28 74 65 73 74  al-report1 (test
3790: 2d 72 75 6e 6e 65 72 2d 78 70 61 73 73 2d 63 6f  -runner-xpass-co
37a0: 75 6e 74 20 72 75 6e 6e 65 72 29 0a 09 09 20 20  unt runner)...  
37b0: 20 20 20 20 22 23 20 6f 66 20 75 6e 65 78 70 65      "# of unexpe
37c0: 63 74 65 64 20 73 75 63 63 65 73 73 65 73 20 22  cted successes "
37d0: 20 70 6f 72 74 29 0a 20 20 28 25 74 65 73 74 2d   port).  (%test-
37e0: 66 69 6e 61 6c 2d 72 65 70 6f 72 74 31 20 28 74  final-report1 (t
37f0: 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61 69 6c 2d  est-runner-fail-
3800: 63 6f 75 6e 74 20 72 75 6e 6e 65 72 29 0a 09 09  count runner)...
3810: 20 20 20 20 20 20 22 23 20 6f 66 20 75 6e 65 78        "# of unex
3820: 70 65 63 74 65 64 20 66 61 69 6c 75 72 65 73 20  pected failures 
3830: 20 22 20 70 6f 72 74 29 0a 20 20 28 25 74 65 73   " port).  (%tes
3840: 74 2d 66 69 6e 61 6c 2d 72 65 70 6f 72 74 31 20  t-final-report1 
3850: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69  (test-runner-ski
3860: 70 2d 63 6f 75 6e 74 20 72 75 6e 6e 65 72 29 0a  p-count runner).
3870: 09 09 20 20 20 20 20 20 22 23 20 6f 66 20 73 6b  ..      "# of sk
3880: 69 70 70 65 64 20 74 65 73 74 73 20 20 20 20 20  ipped tests     
3890: 20 20 20 22 20 70 6f 72 74 29 29 0a 0a 28 64 65     " port))..(de
38a0: 66 69 6e 65 20 28 74 65 73 74 2d 6f 6e 2d 66 69  fine (test-on-fi
38b0: 6e 61 6c 2d 73 69 6d 70 6c 65 20 72 75 6e 6e 65  nal-simple runne
38c0: 72 29 0a 20 20 28 25 74 65 73 74 2d 66 69 6e 61  r).  (%test-fina
38d0: 6c 2d 72 65 70 6f 72 74 2d 73 69 6d 70 6c 65 20  l-report-simple 
38e0: 72 75 6e 6e 65 72 20 28 63 75 72 72 65 6e 74 2d  runner (current-
38f0: 6f 75 74 70 75 74 2d 70 6f 72 74 29 29 0a 20 20  output-port)).  
3900: 28 6c 65 74 20 28 28 6c 6f 67 20 28 74 65 73 74  (let ((log (test
3910: 2d 72 75 6e 6e 65 72 2d 61 75 78 2d 76 61 6c 75  -runner-aux-valu
3920: 65 20 72 75 6e 6e 65 72 29 29 29 0a 20 20 20 20  e runner))).    
3930: 28 69 66 20 28 6f 75 74 70 75 74 2d 70 6f 72 74  (if (output-port
3940: 3f 20 6c 6f 67 29 0a 09 28 25 74 65 73 74 2d 66  ? log)..(%test-f
3950: 69 6e 61 6c 2d 72 65 70 6f 72 74 2d 73 69 6d 70  inal-report-simp
3960: 6c 65 20 72 75 6e 6e 65 72 20 6c 6f 67 29 29 29  le runner log)))
3970: 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 74 65 73  )..(define (%tes
3980: 74 2d 66 6f 72 6d 61 74 2d 6c 69 6e 65 20 72 75  t-format-line ru
3990: 6e 6e 65 72 29 0a 20 20 20 28 6c 65 74 2a 20 28  nner).   (let* (
39a0: 28 6c 69 6e 65 2d 69 6e 66 6f 20 28 74 65 73 74  (line-info (test
39b0: 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 20 72 75  -result-alist ru
39c0: 6e 6e 65 72 29 29 0a 09 20 20 28 73 6f 75 72 63  nner))..  (sourc
39d0: 65 2d 66 69 6c 65 20 28 61 73 73 71 20 27 73 6f  e-file (assq 'so
39e0: 75 72 63 65 2d 66 69 6c 65 20 6c 69 6e 65 2d 69  urce-file line-i
39f0: 6e 66 6f 29 29 0a 09 20 20 28 73 6f 75 72 63 65  nfo))..  (source
3a00: 2d 6c 69 6e 65 20 28 61 73 73 71 20 27 73 6f 75  -line (assq 'sou
3a10: 72 63 65 2d 6c 69 6e 65 20 6c 69 6e 65 2d 69 6e  rce-line line-in
3a20: 66 6f 29 29 0a 09 20 20 28 66 69 6c 65 20 28 69  fo))..  (file (i
3a30: 66 20 73 6f 75 72 63 65 2d 66 69 6c 65 20 28 63  f source-file (c
3a40: 64 72 20 73 6f 75 72 63 65 2d 66 69 6c 65 29 20  dr source-file) 
3a50: 22 22 29 29 29 0a 20 20 20 20 20 28 69 66 20 73  ""))).     (if s
3a60: 6f 75 72 63 65 2d 6c 69 6e 65 0a 09 20 28 73 74  ource-line.. (st
3a70: 72 69 6e 67 2d 61 70 70 65 6e 64 20 66 69 6c 65  ring-append file
3a80: 20 22 3a 22 0a 09 09 09 28 6e 75 6d 62 65 72 2d   ":"....(number-
3a90: 3e 73 74 72 69 6e 67 20 28 63 64 72 20 73 6f 75  >string (cdr sou
3aa0: 72 63 65 2d 6c 69 6e 65 29 29 20 22 3a 20 22 29  rce-line)) ": ")
3ab0: 0a 09 20 22 22 29 29 29 0a 0a 28 64 65 66 69 6e  .. "")))..(defin
3ac0: 65 20 28 25 74 65 73 74 2d 65 6e 64 20 73 75 69  e (%test-end sui
3ad0: 74 65 2d 6e 61 6d 65 20 6c 69 6e 65 2d 69 6e 66  te-name line-inf
3ae0: 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 20 28  o).  (let* ((r (
3af0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67 65 74 29  test-runner-get)
3b00: 29 0a 09 20 28 67 72 6f 75 70 73 20 28 74 65 73  ).. (groups (tes
3b10: 74 2d 72 75 6e 6e 65 72 2d 67 72 6f 75 70 2d 73  t-runner-group-s
3b20: 74 61 63 6b 20 72 29 29 0a 09 20 28 6c 69 6e 65  tack r)).. (line
3b30: 20 28 25 74 65 73 74 2d 66 6f 72 6d 61 74 2d 6c   (%test-format-l
3b40: 69 6e 65 20 72 29 29 29 0a 20 20 20 20 28 74 65  ine r))).    (te
3b50: 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21  st-result-alist!
3b60: 20 72 20 6c 69 6e 65 2d 69 6e 66 6f 29 0a 20 20   r line-info).  
3b70: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 67 72 6f    (if (null? gro
3b80: 75 70 73 29 0a 09 28 6c 65 74 20 28 28 6d 73 67  ups)..(let ((msg
3b90: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20   (string-append 
3ba0: 6c 69 6e 65 20 22 74 65 73 74 2d 65 6e 64 20 6e  line "test-end n
3bb0: 6f 74 20 69 6e 20 61 20 67 72 6f 75 70 22 29 29  ot in a group"))
3bc0: 29 0a 09 20 20 28 63 6f 6e 64 2d 65 78 70 61 6e  )..  (cond-expan
3bd0: 64 0a 09 20 20 20 28 73 72 66 69 2d 32 33 20 28  d..   (srfi-23 (
3be0: 65 72 72 6f 72 20 6d 73 67 29 29 0a 09 20 20 20  error msg))..   
3bf0: 28 65 6c 73 65 20 28 64 69 73 70 6c 61 79 20 6d  (else (display m
3c00: 73 67 29 20 28 6e 65 77 6c 69 6e 65 29 29 29 29  sg) (newline))))
3c10: 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 73  ).    (if (and s
3c20: 75 69 74 65 2d 6e 61 6d 65 20 28 6e 6f 74 20 28  uite-name (not (
3c30: 65 71 75 61 6c 3f 20 73 75 69 74 65 2d 6e 61 6d  equal? suite-nam
3c40: 65 20 28 63 61 72 20 67 72 6f 75 70 73 29 29 29  e (car groups)))
3c50: 29 0a 09 28 28 74 65 73 74 2d 72 75 6e 6e 65 72  )..((test-runner
3c60: 2d 6f 6e 2d 62 61 64 2d 65 6e 64 2d 6e 61 6d 65  -on-bad-end-name
3c70: 20 72 29 20 72 20 73 75 69 74 65 2d 6e 61 6d 65   r) r suite-name
3c80: 20 28 63 61 72 20 67 72 6f 75 70 73 29 29 29 0a   (car groups))).
3c90: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 75 6e      (let* ((coun
3ca0: 74 2d 6c 69 73 74 20 28 25 74 65 73 74 2d 72 75  t-list (%test-ru
3cb0: 6e 6e 65 72 2d 63 6f 75 6e 74 2d 6c 69 73 74 20  nner-count-list 
3cc0: 72 29 29 0a 09 20 20 20 28 65 78 70 65 63 74 65  r))..   (expecte
3cd0: 64 2d 63 6f 75 6e 74 20 28 63 64 61 72 20 63 6f  d-count (cdar co
3ce0: 75 6e 74 2d 6c 69 73 74 29 29 0a 09 20 20 20 28  unt-list))..   (
3cf0: 73 61 76 65 64 2d 63 6f 75 6e 74 20 28 63 61 61  saved-count (caa
3d00: 72 20 63 6f 75 6e 74 2d 6c 69 73 74 29 29 0a 09  r count-list))..
3d10: 20 20 20 28 67 72 6f 75 70 2d 63 6f 75 6e 74 20     (group-count 
3d20: 28 2d 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72  (- (%test-runner
3d30: 2d 74 6f 74 61 6c 2d 63 6f 75 6e 74 20 72 29 20  -total-count r) 
3d40: 73 61 76 65 64 2d 63 6f 75 6e 74 29 29 29 0a 20  saved-count))). 
3d50: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 65 78       (if (and ex
3d60: 70 65 63 74 65 64 2d 63 6f 75 6e 74 0a 09 20 20  pected-count..  
3d70: 20 20 20 20 20 28 6e 6f 74 20 28 3d 20 65 78 70       (not (= exp
3d80: 65 63 74 65 64 2d 63 6f 75 6e 74 20 67 72 6f 75  ected-count grou
3d90: 70 2d 63 6f 75 6e 74 29 29 29 0a 09 20 20 28 28  p-count)))..  ((
3da0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f 6e 2d 62  test-runner-on-b
3db0: 61 64 2d 63 6f 75 6e 74 20 72 29 20 72 20 67 72  ad-count r) r gr
3dc0: 6f 75 70 2d 63 6f 75 6e 74 20 65 78 70 65 63 74  oup-count expect
3dd0: 65 64 2d 63 6f 75 6e 74 29 29 0a 20 20 20 20 20  ed-count)).     
3de0: 20 28 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 6f   ((test-runner-o
3df0: 6e 2d 67 72 6f 75 70 2d 65 6e 64 20 72 29 20 72  n-group-end r) r
3e00: 29 0a 20 20 20 20 20 20 28 74 65 73 74 2d 72 75  ).      (test-ru
3e10: 6e 6e 65 72 2d 67 72 6f 75 70 2d 73 74 61 63 6b  nner-group-stack
3e20: 21 20 72 20 28 63 64 72 20 28 74 65 73 74 2d 72  ! r (cdr (test-r
3e30: 75 6e 6e 65 72 2d 67 72 6f 75 70 2d 73 74 61 63  unner-group-stac
3e40: 6b 20 72 29 29 29 0a 20 20 20 20 20 20 28 25 74  k r))).      (%t
3e50: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
3e60: 6c 69 73 74 21 20 72 20 28 63 61 72 20 28 25 74  list! r (car (%t
3e70: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
3e80: 73 61 76 65 20 72 29 29 29 0a 20 20 20 20 20 20  save r))).      
3e90: 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b  (%test-runner-sk
3ea0: 69 70 2d 73 61 76 65 21 20 72 20 28 63 64 72 20  ip-save! r (cdr 
3eb0: 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b  (%test-runner-sk
3ec0: 69 70 2d 73 61 76 65 20 72 29 29 29 0a 20 20 20  ip-save r))).   
3ed0: 20 20 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72     (%test-runner
3ee0: 2d 66 61 69 6c 2d 6c 69 73 74 21 20 72 20 28 63  -fail-list! r (c
3ef0: 61 72 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72  ar (%test-runner
3f00: 2d 66 61 69 6c 2d 73 61 76 65 20 72 29 29 29 0a  -fail-save r))).
3f10: 20 20 20 20 20 20 28 25 74 65 73 74 2d 72 75 6e        (%test-run
3f20: 6e 65 72 2d 66 61 69 6c 2d 73 61 76 65 21 20 72  ner-fail-save! r
3f30: 20 28 63 64 72 20 28 25 74 65 73 74 2d 72 75 6e   (cdr (%test-run
3f40: 6e 65 72 2d 66 61 69 6c 2d 73 61 76 65 20 72 29  ner-fail-save r)
3f50: 29 29 0a 20 20 20 20 20 20 28 25 74 65 73 74 2d  )).      (%test-
3f60: 72 75 6e 6e 65 72 2d 63 6f 75 6e 74 2d 6c 69 73  runner-count-lis
3f70: 74 21 20 72 20 28 63 64 72 20 63 6f 75 6e 74 2d  t! r (cdr count-
3f80: 6c 69 73 74 29 29 0a 20 20 20 20 20 20 28 69 66  list)).      (if
3f90: 20 28 6e 75 6c 6c 3f 20 28 74 65 73 74 2d 72 75   (null? (test-ru
3fa0: 6e 6e 65 72 2d 67 72 6f 75 70 2d 73 74 61 63 6b  nner-group-stack
3fb0: 20 72 29 29 0a 09 20 20 28 28 74 65 73 74 2d 72   r))..  ((test-r
3fc0: 75 6e 6e 65 72 2d 6f 6e 2d 66 69 6e 61 6c 20 72  unner-on-final r
3fd0: 29 20 72 29 29 29 29 29 0a 0a 28 64 65 66 69 6e  ) r)))))..(defin
3fe0: 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 67 72  e-syntax test-gr
3ff0: 6f 75 70 0a 20 20 28 73 79 6e 74 61 78 2d 72 75  oup.  (syntax-ru
4000: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 74 65 73  les ().    ((tes
4010: 74 2d 67 72 6f 75 70 20 73 75 69 74 65 2d 6e 61  t-group suite-na
4020: 6d 65 20 2e 20 62 6f 64 79 29 0a 20 20 20 20 20  me . body).     
4030: 28 6c 65 74 20 28 28 72 20 28 74 65 73 74 2d 72  (let ((r (test-r
4040: 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74 29 29 29  unner-current)))
4050: 0a 20 20 20 20 20 20 20 3b 3b 20 49 64 65 61 6c  .       ;; Ideal
4060: 6c 79 20 73 68 6f 75 6c 64 20 61 6c 73 6f 20 73  ly should also s
4070: 65 74 20 6c 69 6e 65 2d 6e 75 6d 62 65 72 2c 20  et line-number, 
4080: 69 66 20 61 76 61 69 6c 61 62 6c 65 2e 0a 20 20  if available..  
4090: 20 20 20 20 20 28 74 65 73 74 2d 72 65 73 75 6c       (test-resul
40a0: 74 2d 61 6c 69 73 74 21 20 72 20 28 6c 69 73 74  t-alist! r (list
40b0: 20 28 63 6f 6e 73 20 27 74 65 73 74 2d 6e 61 6d   (cons 'test-nam
40c0: 65 20 73 75 69 74 65 2d 6e 61 6d 65 29 29 29 0a  e suite-name))).
40d0: 20 20 20 20 20 20 20 28 69 66 20 28 25 74 65 73         (if (%tes
40e0: 74 2d 73 68 6f 75 6c 64 2d 65 78 65 63 75 74 65  t-should-execute
40f0: 20 72 29 0a 09 20 20 20 28 64 79 6e 61 6d 69 63   r)..   (dynamic
4100: 2d 77 69 6e 64 0a 09 20 20 20 20 20 20 20 28 6c  -wind..       (l
4110: 61 6d 62 64 61 20 28 29 20 28 74 65 73 74 2d 62  ambda () (test-b
4120: 65 67 69 6e 20 73 75 69 74 65 2d 6e 61 6d 65 29  egin suite-name)
4130: 29 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64  )..       (lambd
4140: 61 20 28 29 20 2e 20 62 6f 64 79 29 0a 09 20 20  a () . body)..  
4150: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20       (lambda () 
4160: 28 74 65 73 74 2d 65 6e 64 20 20 73 75 69 74 65  (test-end  suite
4170: 2d 6e 61 6d 65 29 29 29 29 29 29 29 29 0a 0a 28  -name))))))))..(
4180: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 74 65  define-syntax te
4190: 73 74 2d 67 72 6f 75 70 2d 77 69 74 68 2d 63 6c  st-group-with-cl
41a0: 65 61 6e 75 70 0a 20 20 28 73 79 6e 74 61 78 2d  eanup.  (syntax-
41b0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 74  rules ().    ((t
41c0: 65 73 74 2d 67 72 6f 75 70 2d 77 69 74 68 2d 63  est-group-with-c
41d0: 6c 65 61 6e 75 70 20 73 75 69 74 65 2d 6e 61 6d  leanup suite-nam
41e0: 65 20 66 6f 72 6d 20 63 6c 65 61 6e 75 70 2d 66  e form cleanup-f
41f0: 6f 72 6d 29 0a 20 20 20 20 20 28 74 65 73 74 2d  orm).     (test-
4200: 67 72 6f 75 70 20 73 75 69 74 65 2d 6e 61 6d 65  group suite-name
4210: 0a 09 09 20 20 20 20 28 64 79 6e 61 6d 69 63 2d  ...    (dynamic-
4220: 77 69 6e 64 0a 09 09 09 28 6c 61 6d 62 64 61 20  wind....(lambda 
4230: 28 29 20 23 66 29 0a 09 09 09 28 6c 61 6d 62 64  () #f)....(lambd
4240: 61 20 28 29 20 66 6f 72 6d 29 0a 09 09 09 28 6c  a () form)....(l
4250: 61 6d 62 64 61 20 28 29 20 63 6c 65 61 6e 75 70  ambda () cleanup
4260: 2d 66 6f 72 6d 29 29 29 29 0a 20 20 20 20 28 28  -form)))).    ((
4270: 74 65 73 74 2d 67 72 6f 75 70 2d 77 69 74 68 2d  test-group-with-
4280: 63 6c 65 61 6e 75 70 20 73 75 69 74 65 2d 6e 61  cleanup suite-na
4290: 6d 65 20 63 6c 65 61 6e 75 70 2d 66 6f 72 6d 29  me cleanup-form)
42a0: 0a 20 20 20 20 20 28 74 65 73 74 2d 67 72 6f 75  .     (test-grou
42b0: 70 2d 77 69 74 68 2d 63 6c 65 61 6e 75 70 20 73  p-with-cleanup s
42c0: 75 69 74 65 2d 6e 61 6d 65 20 23 66 20 63 6c 65  uite-name #f cle
42d0: 61 6e 75 70 2d 66 6f 72 6d 29 29 0a 20 20 20 20  anup-form)).    
42e0: 28 28 74 65 73 74 2d 67 72 6f 75 70 2d 77 69 74  ((test-group-wit
42f0: 68 2d 63 6c 65 61 6e 75 70 20 73 75 69 74 65 2d  h-cleanup suite-
4300: 6e 61 6d 65 20 66 6f 72 6d 31 20 66 6f 72 6d 32  name form1 form2
4310: 20 66 6f 72 6d 33 20 2e 20 72 65 73 74 29 0a 20   form3 . rest). 
4320: 20 20 20 20 28 74 65 73 74 2d 67 72 6f 75 70 2d      (test-group-
4330: 77 69 74 68 2d 63 6c 65 61 6e 75 70 20 73 75 69  with-cleanup sui
4340: 74 65 2d 6e 61 6d 65 20 28 62 65 67 69 6e 20 66  te-name (begin f
4350: 6f 72 6d 31 20 66 6f 72 6d 32 29 20 66 6f 72 6d  orm1 form2) form
4360: 33 20 2e 20 72 65 73 74 29 29 29 29 0a 0a 28 64  3 . rest))))..(d
4370: 65 66 69 6e 65 20 28 74 65 73 74 2d 6f 6e 2d 74  efine (test-on-t
4380: 65 73 74 2d 62 65 67 69 6e 2d 73 69 6d 70 6c 65  est-begin-simple
4390: 20 72 75 6e 6e 65 72 29 0a 20 28 6c 65 74 20 28   runner). (let (
43a0: 28 6c 6f 67 20 28 74 65 73 74 2d 72 75 6e 6e 65  (log (test-runne
43b0: 72 2d 61 75 78 2d 76 61 6c 75 65 20 72 75 6e 6e  r-aux-value runn
43c0: 65 72 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f  er))).    (if (o
43d0: 75 74 70 75 74 2d 70 6f 72 74 3f 20 6c 6f 67 29  utput-port? log)
43e0: 0a 09 28 6c 65 74 2a 20 28 28 72 65 73 75 6c 74  ..(let* ((result
43f0: 73 20 28 74 65 73 74 2d 72 65 73 75 6c 74 2d 61  s (test-result-a
4400: 6c 69 73 74 20 72 75 6e 6e 65 72 29 29 0a 09 20  list runner)).. 
4410: 20 20 20 20 20 20 28 73 6f 75 72 63 65 2d 66 69        (source-fi
4420: 6c 65 20 28 61 73 73 71 20 27 73 6f 75 72 63 65  le (assq 'source
4430: 2d 66 69 6c 65 20 72 65 73 75 6c 74 73 29 29 0a  -file results)).
4440: 09 20 20 20 20 20 20 20 28 73 6f 75 72 63 65 2d  .       (source-
4450: 6c 69 6e 65 20 28 61 73 73 71 20 27 73 6f 75 72  line (assq 'sour
4460: 63 65 2d 6c 69 6e 65 20 72 65 73 75 6c 74 73 29  ce-line results)
4470: 29 0a 09 20 20 20 20 20 20 20 28 73 6f 75 72 63  )..       (sourc
4480: 65 2d 66 6f 72 6d 20 28 61 73 73 71 20 27 73 6f  e-form (assq 'so
4490: 75 72 63 65 2d 66 6f 72 6d 20 72 65 73 75 6c 74  urce-form result
44a0: 73 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73  s))..       (tes
44b0: 74 2d 6e 61 6d 65 20 28 61 73 73 71 20 27 74 65  t-name (assq 'te
44c0: 73 74 2d 6e 61 6d 65 20 72 65 73 75 6c 74 73 29  st-name results)
44d0: 29 29 0a 09 20 20 28 64 69 73 70 6c 61 79 20 22  ))..  (display "
44e0: 54 65 73 74 20 62 65 67 69 6e 3a 22 20 6c 6f 67  Test begin:" log
44f0: 29 0a 09 20 20 28 6e 65 77 6c 69 6e 65 20 6c 6f  )..  (newline lo
4500: 67 29 0a 09 20 20 28 69 66 20 74 65 73 74 2d 6e  g)..  (if test-n
4510: 61 6d 65 20 28 25 74 65 73 74 2d 77 72 69 74 65  ame (%test-write
4520: 2d 72 65 73 75 6c 74 31 20 74 65 73 74 2d 6e 61  -result1 test-na
4530: 6d 65 20 6c 6f 67 29 29 0a 09 20 20 28 69 66 20  me log))..  (if 
4540: 73 6f 75 72 63 65 2d 66 69 6c 65 20 28 25 74 65  source-file (%te
4550: 73 74 2d 77 72 69 74 65 2d 72 65 73 75 6c 74 31  st-write-result1
4560: 20 73 6f 75 72 63 65 2d 66 69 6c 65 20 6c 6f 67   source-file log
4570: 29 29 0a 09 20 20 28 69 66 20 73 6f 75 72 63 65  ))..  (if source
4580: 2d 6c 69 6e 65 20 28 25 74 65 73 74 2d 77 72 69  -line (%test-wri
4590: 74 65 2d 72 65 73 75 6c 74 31 20 73 6f 75 72 63  te-result1 sourc
45a0: 65 2d 6c 69 6e 65 20 6c 6f 67 29 29 0a 09 20 20  e-line log))..  
45b0: 28 69 66 20 73 6f 75 72 63 65 2d 66 6f 72 6d 20  (if source-form 
45c0: 28 25 74 65 73 74 2d 77 72 69 74 65 2d 72 65 73  (%test-write-res
45d0: 75 6c 74 31 20 73 6f 75 72 63 65 2d 66 6f 72 6d  ult1 source-form
45e0: 20 6c 6f 67 29 29 29 29 29 29 0a 0a 28 64 65 66   log))))))..(def
45f0: 69 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d  ine-syntax test-
4600: 72 65 73 75 6c 74 2d 72 65 66 0a 20 20 28 73 79  result-ref.  (sy
4610: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
4620: 20 20 28 28 74 65 73 74 2d 72 65 73 75 6c 74 2d    ((test-result-
4630: 72 65 66 20 72 75 6e 6e 65 72 20 70 6e 61 6d 65  ref runner pname
4640: 29 0a 20 20 20 20 20 28 74 65 73 74 2d 72 65 73  ).     (test-res
4650: 75 6c 74 2d 72 65 66 20 72 75 6e 6e 65 72 20 70  ult-ref runner p
4660: 6e 61 6d 65 20 23 66 29 29 0a 20 20 20 20 28 28  name #f)).    ((
4670: 74 65 73 74 2d 72 65 73 75 6c 74 2d 72 65 66 20  test-result-ref 
4680: 72 75 6e 6e 65 72 20 70 6e 61 6d 65 20 64 65 66  runner pname def
4690: 61 75 6c 74 29 0a 20 20 20 20 20 28 6c 65 74 20  ault).     (let 
46a0: 28 28 70 20 28 61 73 73 71 20 70 6e 61 6d 65 20  ((p (assq pname 
46b0: 28 74 65 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69  (test-result-ali
46c0: 73 74 20 72 75 6e 6e 65 72 29 29 29 29 0a 20 20  st runner)))).  
46d0: 20 20 20 20 20 28 69 66 20 70 20 28 63 64 72 20       (if p (cdr 
46e0: 70 29 20 64 65 66 61 75 6c 74 29 29 29 29 29 0a  p) default))))).
46f0: 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 6f  .(define (test-o
4700: 6e 2d 74 65 73 74 2d 65 6e 64 2d 73 69 6d 70 6c  n-test-end-simpl
4710: 65 20 72 75 6e 6e 65 72 29 0a 20 20 28 6c 65 74  e runner).  (let
4720: 20 28 28 6c 6f 67 20 28 74 65 73 74 2d 72 75 6e   ((log (test-run
4730: 6e 65 72 2d 61 75 78 2d 76 61 6c 75 65 20 72 75  ner-aux-value ru
4740: 6e 6e 65 72 29 29 0a 09 28 6b 69 6e 64 20 28 74  nner))..(kind (t
4750: 65 73 74 2d 72 65 73 75 6c 74 2d 72 65 66 20 72  est-result-ref r
4760: 75 6e 6e 65 72 20 27 72 65 73 75 6c 74 2d 6b 69  unner 'result-ki
4770: 6e 64 29 29 29 0a 20 20 20 20 28 69 66 20 28 6d  nd))).    (if (m
4780: 65 6d 71 20 6b 69 6e 64 20 27 28 66 61 69 6c 20  emq kind '(fail 
4790: 78 70 61 73 73 29 29 0a 09 28 6c 65 74 2a 20 28  xpass))..(let* (
47a0: 28 72 65 73 75 6c 74 73 20 28 74 65 73 74 2d 72  (results (test-r
47b0: 65 73 75 6c 74 2d 61 6c 69 73 74 20 72 75 6e 6e  esult-alist runn
47c0: 65 72 29 29 0a 09 20 20 20 20 20 20 20 28 73 6f  er))..       (so
47d0: 75 72 63 65 2d 66 69 6c 65 20 28 61 73 73 71 20  urce-file (assq 
47e0: 27 73 6f 75 72 63 65 2d 66 69 6c 65 20 72 65 73  'source-file res
47f0: 75 6c 74 73 29 29 0a 09 20 20 20 20 20 20 20 28  ults))..       (
4800: 73 6f 75 72 63 65 2d 6c 69 6e 65 20 28 61 73 73  source-line (ass
4810: 71 20 27 73 6f 75 72 63 65 2d 6c 69 6e 65 20 72  q 'source-line r
4820: 65 73 75 6c 74 73 29 29 0a 09 20 20 20 20 20 20  esults))..      
4830: 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73   (test-name (ass
4840: 71 20 27 74 65 73 74 2d 6e 61 6d 65 20 72 65 73  q 'test-name res
4850: 75 6c 74 73 29 29 29 0a 09 20 20 28 69 66 20 28  ults)))..  (if (
4860: 6f 72 20 73 6f 75 72 63 65 2d 66 69 6c 65 20 73  or source-file s
4870: 6f 75 72 63 65 2d 6c 69 6e 65 29 0a 09 20 20 20  ource-line)..   
4880: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 69 66 20     (begin...(if 
4890: 73 6f 75 72 63 65 2d 66 69 6c 65 20 28 64 69 73  source-file (dis
48a0: 70 6c 61 79 20 28 63 64 72 20 73 6f 75 72 63 65  play (cdr source
48b0: 2d 66 69 6c 65 29 29 29 0a 09 09 28 64 69 73 70  -file)))...(disp
48c0: 6c 61 79 20 22 3a 22 29 0a 09 09 28 69 66 20 73  lay ":")...(if s
48d0: 6f 75 72 63 65 2d 6c 69 6e 65 20 28 64 69 73 70  ource-line (disp
48e0: 6c 61 79 20 28 63 64 72 20 73 6f 75 72 63 65 2d  lay (cdr source-
48f0: 6c 69 6e 65 29 29 29 0a 09 09 28 64 69 73 70 6c  line)))...(displ
4900: 61 79 20 22 3a 20 22 29 29 29 0a 09 20 20 28 64  ay ": ")))..  (d
4910: 69 73 70 6c 61 79 20 28 69 66 20 28 65 71 3f 20  isplay (if (eq? 
4920: 6b 69 6e 64 20 27 78 70 61 73 73 29 20 22 58 50  kind 'xpass) "XP
4930: 41 53 53 22 20 22 46 41 49 4c 22 29 29 0a 09 20  ASS" "FAIL")).. 
4940: 20 28 69 66 20 74 65 73 74 2d 6e 61 6d 65 0a 09   (if test-name..
4950: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28        (begin...(
4960: 64 69 73 70 6c 61 79 20 22 20 22 29 0a 09 09 28  display " ")...(
4970: 64 69 73 70 6c 61 79 20 28 63 64 72 20 74 65 73  display (cdr tes
4980: 74 2d 6e 61 6d 65 29 29 29 29 0a 09 20 20 28 6e  t-name))))..  (n
4990: 65 77 6c 69 6e 65 29 29 29 0a 20 20 20 20 28 69  ewline))).    (i
49a0: 66 20 28 6f 75 74 70 75 74 2d 70 6f 72 74 3f 20  f (output-port? 
49b0: 6c 6f 67 29 0a 09 28 62 65 67 69 6e 0a 09 20 20  log)..(begin..  
49c0: 28 64 69 73 70 6c 61 79 20 22 54 65 73 74 20 65  (display "Test e
49d0: 6e 64 3a 22 20 6c 6f 67 29 0a 09 20 20 28 6e 65  nd:" log)..  (ne
49e0: 77 6c 69 6e 65 20 6c 6f 67 29 0a 09 20 20 28 6c  wline log)..  (l
49f0: 65 74 20 6c 6f 6f 70 20 28 28 6c 69 73 74 20 28  et loop ((list (
4a00: 74 65 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73  test-result-alis
4a10: 74 20 72 75 6e 6e 65 72 29 29 29 0a 09 20 20 20  t runner)))..   
4a20: 20 28 69 66 20 28 70 61 69 72 3f 20 6c 69 73 74   (if (pair? list
4a30: 29 0a 09 09 28 6c 65 74 20 28 28 70 61 69 72 20  )...(let ((pair 
4a40: 28 63 61 72 20 6c 69 73 74 29 29 29 0a 09 09 20  (car list)))... 
4a50: 20 3b 3b 20 57 72 69 74 65 20 6f 75 74 20 70 72   ;; Write out pr
4a60: 6f 70 65 72 74 69 65 73 20 6e 6f 74 20 77 72 69  operties not wri
4a70: 74 74 65 6e 20 6f 75 74 20 62 79 20 6f 6e 2d 74  tten out by on-t
4a80: 65 73 74 2d 62 65 67 69 6e 2e 0a 09 09 20 20 28  est-begin....  (
4a90: 69 66 20 28 6e 6f 74 20 28 6d 65 6d 71 20 28 63  if (not (memq (c
4aa0: 61 72 20 70 61 69 72 29 0a 09 09 09 09 20 27 28  ar pair)..... '(
4ab0: 74 65 73 74 2d 6e 61 6d 65 20 73 6f 75 72 63 65  test-name source
4ac0: 2d 66 69 6c 65 20 73 6f 75 72 63 65 2d 6c 69 6e  -file source-lin
4ad0: 65 20 73 6f 75 72 63 65 2d 66 6f 72 6d 29 29 29  e source-form)))
4ae0: 0a 09 09 20 20 20 20 20 20 28 25 74 65 73 74 2d  ...      (%test-
4af0: 77 72 69 74 65 2d 72 65 73 75 6c 74 31 20 70 61  write-result1 pa
4b00: 69 72 20 6c 6f 67 29 29 0a 09 09 20 20 28 6c 6f  ir log))...  (lo
4b10: 6f 70 20 28 63 64 72 20 6c 69 73 74 29 29 29 29  op (cdr list))))
4b20: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  )))))..(define (
4b30: 25 74 65 73 74 2d 77 72 69 74 65 2d 72 65 73 75  %test-write-resu
4b40: 6c 74 31 20 70 61 69 72 20 70 6f 72 74 29 0a 20  lt1 pair port). 
4b50: 20 28 64 69 73 70 6c 61 79 20 22 20 20 22 20 70   (display "  " p
4b60: 6f 72 74 29 0a 20 20 28 64 69 73 70 6c 61 79 20  ort).  (display 
4b70: 28 63 61 72 20 70 61 69 72 29 20 70 6f 72 74 29  (car pair) port)
4b80: 0a 20 20 28 64 69 73 70 6c 61 79 20 22 3a 20 22  .  (display ": "
4b90: 20 70 6f 72 74 29 0a 20 20 28 77 72 69 74 65 20   port).  (write 
4ba0: 28 63 64 72 20 70 61 69 72 29 20 70 6f 72 74 29  (cdr pair) port)
4bb0: 0a 20 20 28 6e 65 77 6c 69 6e 65 20 70 6f 72 74  .  (newline port
4bc0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73  ))..(define (tes
4bd0: 74 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 72 75  t-result-set! ru
4be0: 6e 6e 65 72 20 70 6e 61 6d 65 20 76 61 6c 75 65  nner pname value
4bf0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 73  ).  (let* ((alis
4c00: 74 20 28 74 65 73 74 2d 72 65 73 75 6c 74 2d 61  t (test-result-a
4c10: 6c 69 73 74 20 72 75 6e 6e 65 72 29 29 0a 09 20  list runner)).. 
4c20: 28 70 20 28 61 73 73 71 20 70 6e 61 6d 65 20 61  (p (assq pname a
4c30: 6c 69 73 74 29 29 29 0a 20 20 20 20 28 69 66 20  list))).    (if 
4c40: 70 0a 09 28 73 65 74 2d 63 64 72 21 20 70 20 76  p..(set-cdr! p v
4c50: 61 6c 75 65 29 0a 09 28 74 65 73 74 2d 72 65 73  alue)..(test-res
4c60: 75 6c 74 2d 61 6c 69 73 74 21 20 72 75 6e 6e 65  ult-alist! runne
4c70: 72 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 70 6e  r (cons (cons pn
4c80: 61 6d 65 20 76 61 6c 75 65 29 20 61 6c 69 73 74  ame value) alist
4c90: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  )))))..(define (
4ca0: 74 65 73 74 2d 72 65 73 75 6c 74 2d 63 6c 65 61  test-result-clea
4cb0: 72 20 72 75 6e 6e 65 72 29 0a 20 20 28 74 65 73  r runner).  (tes
4cc0: 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20  t-result-alist! 
4cd0: 72 75 6e 6e 65 72 20 27 28 29 29 29 0a 0a 28 64  runner '()))..(d
4ce0: 65 66 69 6e 65 20 28 74 65 73 74 2d 72 65 73 75  efine (test-resu
4cf0: 6c 74 2d 72 65 6d 6f 76 65 20 72 75 6e 6e 65 72  lt-remove runner
4d00: 20 70 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20   pname).  (let* 
4d10: 28 28 61 6c 69 73 74 20 28 74 65 73 74 2d 72 65  ((alist (test-re
4d20: 73 75 6c 74 2d 61 6c 69 73 74 20 72 75 6e 6e 65  sult-alist runne
4d30: 72 29 29 0a 09 20 28 70 20 28 61 73 73 71 20 70  r)).. (p (assq p
4d40: 6e 61 6d 65 20 61 6c 69 73 74 29 29 29 0a 20 20  name alist))).  
4d50: 20 20 28 69 66 20 70 0a 09 28 74 65 73 74 2d 72    (if p..(test-r
4d60: 65 73 75 6c 74 2d 61 6c 69 73 74 21 20 72 75 6e  esult-alist! run
4d70: 6e 65 72 0a 09 09 09 09 20 20 20 28 6c 65 74 20  ner.....   (let 
4d80: 6c 6f 6f 70 20 28 28 72 20 61 6c 69 73 74 29 29  loop ((r alist))
4d90: 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 28 65  .....     (if (e
4da0: 71 3f 20 72 20 70 29 20 28 63 64 72 20 72 29 0a  q? r p) (cdr r).
4db0: 09 09 09 09 09 20 28 63 6f 6e 73 20 28 63 61 72  ..... (cons (car
4dc0: 20 72 29 20 28 6c 6f 6f 70 20 28 63 64 72 20 72   r) (loop (cdr r
4dd0: 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69  )))))))))..(defi
4de0: 6e 65 20 28 74 65 73 74 2d 72 65 73 75 6c 74 2d  ne (test-result-
4df0: 6b 69 6e 64 20 2e 20 72 65 73 74 29 0a 20 20 28  kind . rest).  (
4e00: 6c 65 74 20 28 28 72 75 6e 6e 65 72 20 28 69 66  let ((runner (if
4e10: 20 28 70 61 69 72 3f 20 72 65 73 74 29 20 28 63   (pair? rest) (c
4e20: 61 72 20 72 65 73 74 29 20 28 74 65 73 74 2d 72  ar rest) (test-r
4e30: 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74 29 29 29  unner-current)))
4e40: 29 0a 20 20 20 20 28 74 65 73 74 2d 72 65 73 75  ).    (test-resu
4e50: 6c 74 2d 72 65 66 20 72 75 6e 6e 65 72 20 27 72  lt-ref runner 'r
4e60: 65 73 75 6c 74 2d 6b 69 6e 64 29 29 29 0a 0a 28  esult-kind)))..(
4e70: 64 65 66 69 6e 65 20 28 74 65 73 74 2d 70 61 73  define (test-pas
4e80: 73 65 64 3f 20 2e 20 72 65 73 74 29 0a 20 20 28  sed? . rest).  (
4e90: 6c 65 74 20 28 28 72 75 6e 6e 65 72 20 28 69 66  let ((runner (if
4ea0: 20 28 70 61 69 72 3f 20 72 65 73 74 29 20 28 63   (pair? rest) (c
4eb0: 61 72 20 72 65 73 74 29 20 28 74 65 73 74 2d 72  ar rest) (test-r
4ec0: 75 6e 6e 65 72 2d 67 65 74 29 29 29 29 0a 20 20  unner-get)))).  
4ed0: 20 20 28 6d 65 6d 71 20 28 74 65 73 74 2d 72 65    (memq (test-re
4ee0: 73 75 6c 74 2d 72 65 66 20 72 75 6e 6e 65 72 20  sult-ref runner 
4ef0: 27 72 65 73 75 6c 74 2d 6b 69 6e 64 29 20 27 28  'result-kind) '(
4f00: 70 61 73 73 20 78 70 61 73 73 29 29 29 29 0a 0a  pass xpass))))..
4f10: 28 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d 72  (define (%test-r
4f20: 65 70 6f 72 74 2d 72 65 73 75 6c 74 29 0a 20 20  eport-result).  
4f30: 28 6c 65 74 2a 20 28 28 72 20 28 74 65 73 74 2d  (let* ((r (test-
4f40: 72 75 6e 6e 65 72 2d 67 65 74 29 29 0a 09 20 28  runner-get)).. (
4f50: 72 65 73 75 6c 74 2d 6b 69 6e 64 20 28 74 65 73  result-kind (tes
4f60: 74 2d 72 65 73 75 6c 74 2d 6b 69 6e 64 20 72 29  t-result-kind r)
4f70: 29 29 0a 20 20 20 20 28 63 61 73 65 20 72 65 73  )).    (case res
4f80: 75 6c 74 2d 6b 69 6e 64 0a 20 20 20 20 20 20 28  ult-kind.      (
4f90: 28 70 61 73 73 29 0a 20 20 20 20 20 20 20 28 74  (pass).       (t
4fa0: 65 73 74 2d 72 75 6e 6e 65 72 2d 70 61 73 73 2d  est-runner-pass-
4fb0: 63 6f 75 6e 74 21 20 72 20 28 2b 20 31 20 28 74  count! r (+ 1 (t
4fc0: 65 73 74 2d 72 75 6e 6e 65 72 2d 70 61 73 73 2d  est-runner-pass-
4fd0: 63 6f 75 6e 74 20 72 29 29 29 29 0a 20 20 20 20  count r)))).    
4fe0: 20 20 28 28 66 61 69 6c 29 0a 20 20 20 20 20 20    ((fail).      
4ff0: 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61   (test-runner-fa
5000: 69 6c 2d 63 6f 75 6e 74 21 09 72 20 28 2b 20 31  il-count!.r (+ 1
5010: 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 66 61   (test-runner-fa
5020: 69 6c 2d 63 6f 75 6e 74 20 72 29 29 29 29 0a 20  il-count r)))). 
5030: 20 20 20 20 20 28 28 78 70 61 73 73 29 0a 20 20       ((xpass).  
5040: 20 20 20 20 20 28 74 65 73 74 2d 72 75 6e 6e 65       (test-runne
5050: 72 2d 78 70 61 73 73 2d 63 6f 75 6e 74 21 20 72  r-xpass-count! r
5060: 20 28 2b 20 31 20 28 74 65 73 74 2d 72 75 6e 6e   (+ 1 (test-runn
5070: 65 72 2d 78 70 61 73 73 2d 63 6f 75 6e 74 20 72  er-xpass-count r
5080: 29 29 29 29 0a 20 20 20 20 20 20 28 28 78 66 61  )))).      ((xfa
5090: 69 6c 29 0a 20 20 20 20 20 20 20 28 74 65 73 74  il).       (test
50a0: 2d 72 75 6e 6e 65 72 2d 78 66 61 69 6c 2d 63 6f  -runner-xfail-co
50b0: 75 6e 74 21 20 72 20 28 2b 20 31 20 28 74 65 73  unt! r (+ 1 (tes
50c0: 74 2d 72 75 6e 6e 65 72 2d 78 66 61 69 6c 2d 63  t-runner-xfail-c
50d0: 6f 75 6e 74 20 72 29 29 29 29 0a 20 20 20 20 20  ount r)))).     
50e0: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 28 74   (else.       (t
50f0: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
5100: 63 6f 75 6e 74 21 20 72 20 28 2b 20 31 20 28 74  count! r (+ 1 (t
5110: 65 73 74 2d 72 75 6e 6e 65 72 2d 73 6b 69 70 2d  est-runner-skip-
5120: 63 6f 75 6e 74 20 72 29 29 29 29 29 0a 20 20 20  count r))))).   
5130: 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 74   (%test-runner-t
5140: 6f 74 61 6c 2d 63 6f 75 6e 74 21 20 72 20 28 2b  otal-count! r (+
5150: 20 31 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72   1 (%test-runner
5160: 2d 74 6f 74 61 6c 2d 63 6f 75 6e 74 20 72 29 29  -total-count r))
5170: 29 0a 20 20 20 20 28 28 74 65 73 74 2d 72 75 6e  ).    ((test-run
5180: 6e 65 72 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64 20  ner-on-test-end 
5190: 72 29 20 72 29 29 29 0a 0a 28 63 6f 6e 64 2d 65  r) r)))..(cond-e
51a0: 78 70 61 6e 64 0a 20 28 72 36 72 73 0a 20 20 28  xpand. (r6rs.  (
51b0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25 74  define-syntax %t
51c0: 65 73 74 2d 65 76 61 6c 75 61 74 65 2d 77 69 74  est-evaluate-wit
51d0: 68 2d 63 61 74 63 68 0a 20 20 20 20 28 73 79 6e  h-catch.    (syn
51e0: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
51f0: 20 20 20 28 28 25 74 65 73 74 2d 65 76 61 6c 75     ((%test-evalu
5200: 61 74 65 2d 77 69 74 68 2d 63 61 74 63 68 20 74  ate-with-catch t
5210: 65 73 74 2d 65 78 70 72 65 73 73 69 6f 6e 29 0a  est-expression).
5220: 20 20 20 20 20 20 20 28 67 75 61 72 64 20 28 65         (guard (e
5230: 78 20 28 65 6c 73 65 20 23 46 29 29 20 74 65 73  x (else #F)) tes
5240: 74 2d 65 78 70 72 65 73 73 69 6f 6e 29 29 29 29  t-expression))))
5250: 29 0a 20 28 67 75 69 6c 65 0a 20 20 28 64 65 66  ). (guile.  (def
5260: 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65 73 74  ine-syntax %test
5270: 2d 65 76 61 6c 75 61 74 65 2d 77 69 74 68 2d 63  -evaluate-with-c
5280: 61 74 63 68 0a 20 20 20 20 28 73 79 6e 74 61 78  atch.    (syntax
5290: 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20  -rules ().      
52a0: 28 28 25 74 65 73 74 2d 65 76 61 6c 75 61 74 65  ((%test-evaluate
52b0: 2d 77 69 74 68 2d 63 61 74 63 68 20 74 65 73 74  -with-catch test
52c0: 2d 65 78 70 72 65 73 73 69 6f 6e 29 0a 20 20 20  -expression).   
52d0: 20 20 20 20 28 63 61 74 63 68 20 23 74 20 28 6c      (catch #t (l
52e0: 61 6d 62 64 61 20 28 29 20 74 65 73 74 2d 65 78  ambda () test-ex
52f0: 70 72 65 73 73 69 6f 6e 29 20 28 6c 61 6d 62 64  pression) (lambd
5300: 61 20 28 6b 65 79 20 2e 20 61 72 67 73 29 20 23  a (key . args) #
5310: 66 29 29 29 29 29 29 0a 20 28 6b 61 77 61 0a 20  f)))))). (kawa. 
5320: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20   (define-syntax 
5330: 25 74 65 73 74 2d 65 76 61 6c 75 61 74 65 2d 77  %test-evaluate-w
5340: 69 74 68 2d 63 61 74 63 68 0a 20 20 20 20 28 73  ith-catch.    (s
5350: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20  yntax-rules (). 
5360: 20 20 20 20 20 28 28 25 74 65 73 74 2d 65 76 61       ((%test-eva
5370: 6c 75 61 74 65 2d 77 69 74 68 2d 63 61 74 63 68  luate-with-catch
5380: 20 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f 6e   test-expression
5390: 29 0a 20 20 20 20 20 20 20 28 74 72 79 2d 63 61  ).       (try-ca
53a0: 74 63 68 20 74 65 73 74 2d 65 78 70 72 65 73 73  tch test-express
53b0: 69 6f 6e 0a 09 09 20 20 28 65 78 20 3c 6a 61 76  ion...  (ex <jav
53c0: 61 2e 6c 61 6e 67 2e 54 68 72 6f 77 61 62 6c 65  a.lang.Throwable
53d0: 3e 0a 09 09 20 20 20 20 20 20 28 74 65 73 74 2d  >...      (test-
53e0: 72 65 73 75 6c 74 2d 73 65 74 21 20 28 74 65 73  result-set! (tes
53f0: 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74  t-runner-current
5400: 29 20 27 61 63 74 75 61 6c 2d 65 72 72 6f 72 20  ) 'actual-error 
5410: 65 78 29 0a 09 09 20 20 20 20 20 20 23 66 29 29  ex)...      #f))
5420: 29 29 29 29 0a 20 28 73 72 66 69 2d 33 34 0a 20  )))). (srfi-34. 
5430: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20   (define-syntax 
5440: 25 74 65 73 74 2d 65 76 61 6c 75 61 74 65 2d 77  %test-evaluate-w
5450: 69 74 68 2d 63 61 74 63 68 0a 20 20 20 20 28 73  ith-catch.    (s
5460: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20  yntax-rules (). 
5470: 20 20 20 20 20 28 28 25 74 65 73 74 2d 65 76 61       ((%test-eva
5480: 6c 75 61 74 65 2d 77 69 74 68 2d 63 61 74 63 68  luate-with-catch
5490: 20 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f 6e   test-expression
54a0: 29 0a 20 20 20 20 20 20 20 28 67 75 61 72 64 20  ).       (guard 
54b0: 28 65 72 72 20 28 65 6c 73 65 20 23 66 29 29 20  (err (else #f)) 
54c0: 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f 6e 29  test-expression)
54d0: 29 29 29 29 0a 20 28 63 68 69 63 6b 65 6e 0a 20  )))). (chicken. 
54e0: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20   (define-syntax 
54f0: 25 74 65 73 74 2d 65 76 61 6c 75 61 74 65 2d 77  %test-evaluate-w
5500: 69 74 68 2d 63 61 74 63 68 0a 20 20 20 20 28 73  ith-catch.    (s
5510: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20  yntax-rules (). 
5520: 20 20 20 20 20 28 28 25 74 65 73 74 2d 65 76 61       ((%test-eva
5530: 6c 75 61 74 65 2d 77 69 74 68 2d 63 61 74 63 68  luate-with-catch
5540: 20 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f 6e   test-expression
5550: 29 0a 20 20 20 20 20 20 20 28 63 6f 6e 64 69 74  ).       (condit
5560: 69 6f 6e 2d 63 61 73 65 20 74 65 73 74 2d 65 78  ion-case test-ex
5570: 70 72 65 73 73 69 6f 6e 20 28 65 78 20 28 29 20  pression (ex () 
5580: 23 66 29 29 29 29 29 29 0a 20 28 65 6c 73 65 0a  #f)))))). (else.
5590: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78    (define-syntax
55a0: 20 25 74 65 73 74 2d 65 76 61 6c 75 61 74 65 2d   %test-evaluate-
55b0: 77 69 74 68 2d 63 61 74 63 68 0a 20 20 20 20 28  with-catch.    (
55c0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a  syntax-rules ().
55d0: 20 20 20 20 20 20 28 28 25 74 65 73 74 2d 65 76        ((%test-ev
55e0: 61 6c 75 61 74 65 2d 77 69 74 68 2d 63 61 74 63  aluate-with-catc
55f0: 68 20 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f  h test-expressio
5600: 6e 29 0a 20 20 20 20 20 20 20 74 65 73 74 2d 65  n).       test-e
5610: 78 70 72 65 73 73 69 6f 6e 29 29 29 29 29 0a 09  xpression)))))..
5620: 20 20 20 20 0a 28 63 6f 6e 64 2d 65 78 70 61 6e      .(cond-expan
5630: 64 0a 20 28 28 61 6e 64 20 28 6e 6f 74 20 72 36  d. ((and (not r6
5640: 72 73 29 20 28 6f 72 20 6b 61 77 61 20 6d 7a 73  rs) (or kawa mzs
5650: 63 68 65 6d 65 29 29 0a 20 20 28 63 6f 6e 64 2d  cheme)).  (cond-
5660: 65 78 70 61 6e 64 0a 20 20 20 28 6d 7a 73 63 68  expand.   (mzsch
5670: 65 6d 65 0a 20 20 20 20 28 64 65 66 69 6e 65 2d  eme.    (define-
5680: 66 6f 72 2d 73 79 6e 74 61 78 20 28 25 74 65 73  for-syntax (%tes
5690: 74 2d 73 79 6e 74 61 78 2d 66 69 6c 65 20 66 6f  t-syntax-file fo
56a0: 72 6d 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28  rm).      (let (
56b0: 28 73 6f 75 72 63 65 20 28 73 79 6e 74 61 78 2d  (source (syntax-
56c0: 73 6f 75 72 63 65 20 66 6f 72 6d 29 29 29 0a 09  source form)))..
56d0: 28 63 6f 6e 64 20 28 28 73 74 72 69 6e 67 3f 20  (cond ((string? 
56e0: 73 6f 75 72 63 65 29 20 66 69 6c 65 29 0a 09 09  source) file)...
56f0: 09 09 28 28 70 61 74 68 3f 20 73 6f 75 72 63 65  ..((path? source
5700: 29 20 28 70 61 74 68 2d 3e 73 74 72 69 6e 67 20  ) (path->string 
5710: 73 6f 75 72 63 65 29 29 0a 09 09 09 09 28 65 6c  source)).....(el
5720: 73 65 20 23 66 29 29 29 29 29 0a 20 20 20 28 6b  se #f))))).   (k
5730: 61 77 61 0a 20 20 20 20 28 64 65 66 69 6e 65 20  awa.    (define 
5740: 28 25 74 65 73 74 2d 73 79 6e 74 61 78 2d 66 69  (%test-syntax-fi
5750: 6c 65 20 66 6f 72 6d 29 0a 20 20 20 20 20 20 28  le form).      (
5760: 73 79 6e 74 61 78 2d 73 6f 75 72 63 65 20 66 6f  syntax-source fo
5770: 72 6d 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65  rm)))).  (define
5780: 2d 66 6f 72 2d 73 79 6e 74 61 78 20 28 25 74 65  -for-syntax (%te
5790: 73 74 2d 73 6f 75 72 63 65 2d 6c 69 6e 65 32 20  st-source-line2 
57a0: 66 6f 72 6d 29 0a 20 20 20 20 28 6c 65 74 2a 20  form).    (let* 
57b0: 28 28 6c 69 6e 65 20 28 73 79 6e 74 61 78 2d 6c  ((line (syntax-l
57c0: 69 6e 65 20 66 6f 72 6d 29 29 0a 09 20 20 20 28  ine form))..   (
57d0: 66 69 6c 65 20 28 25 74 65 73 74 2d 73 79 6e 74  file (%test-synt
57e0: 61 78 2d 66 69 6c 65 20 66 6f 72 6d 29 29 0a 09  ax-file form))..
57f0: 20 20 20 28 6c 69 6e 65 2d 70 61 69 72 20 28 69     (line-pair (i
5800: 66 20 6c 69 6e 65 20 28 6c 69 73 74 20 28 63 6f  f line (list (co
5810: 6e 73 20 27 73 6f 75 72 63 65 2d 6c 69 6e 65 20  ns 'source-line 
5820: 6c 69 6e 65 29 29 20 27 28 29 29 29 29 0a 20 20  line)) '()))).  
5830: 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20      (cons (cons 
5840: 27 73 6f 75 72 63 65 2d 66 6f 72 6d 20 28 73 79  'source-form (sy
5850: 6e 74 61 78 2d 6f 62 6a 65 63 74 2d 3e 64 61 74  ntax-object->dat
5860: 75 6d 20 66 6f 72 6d 29 29 0a 09 20 20 20 20 28  um form))..    (
5870: 69 66 20 66 69 6c 65 20 28 63 6f 6e 73 20 28 63  if file (cons (c
5880: 6f 6e 73 20 27 73 6f 75 72 63 65 2d 66 69 6c 65  ons 'source-file
5890: 20 66 69 6c 65 29 20 6c 69 6e 65 2d 70 61 69 72   file) line-pair
58a0: 29 20 6c 69 6e 65 2d 70 61 69 72 29 29 29 29 29  ) line-pair)))))
58b0: 0a 20 28 65 6c 73 65 0a 20 20 28 64 65 66 69 6e  . (else.  (defin
58c0: 65 20 28 25 74 65 73 74 2d 73 6f 75 72 63 65 2d  e (%test-source-
58d0: 6c 69 6e 65 32 20 66 6f 72 6d 29 0a 20 20 20 20  line2 form).    
58e0: 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  '())))..(define 
58f0: 28 25 74 65 73 74 2d 6f 6e 2d 74 65 73 74 2d 62  (%test-on-test-b
5900: 65 67 69 6e 20 72 29 0a 20 20 28 25 74 65 73 74  egin r).  (%test
5910: 2d 73 68 6f 75 6c 64 2d 65 78 65 63 75 74 65 20  -should-execute 
5920: 72 29 0a 20 20 28 28 74 65 73 74 2d 72 75 6e 6e  r).  ((test-runn
5930: 65 72 2d 6f 6e 2d 74 65 73 74 2d 62 65 67 69 6e  er-on-test-begin
5940: 20 72 29 20 72 29 0a 20 20 28 6e 6f 74 20 28 65   r) r).  (not (e
5950: 71 3f 20 27 73 6b 69 70 20 28 74 65 73 74 2d 72  q? 'skip (test-r
5960: 65 73 75 6c 74 2d 72 65 66 20 72 20 27 72 65 73  esult-ref r 'res
5970: 75 6c 74 2d 6b 69 6e 64 29 29 29 29 0a 0a 28 64  ult-kind))))..(d
5980: 65 66 69 6e 65 20 28 25 74 65 73 74 2d 6f 6e 2d  efine (%test-on-
5990: 74 65 73 74 2d 65 6e 64 20 72 20 72 65 73 75 6c  test-end r resul
59a0: 74 29 0a 20 20 20 20 28 74 65 73 74 2d 72 65 73  t).    (test-res
59b0: 75 6c 74 2d 73 65 74 21 20 72 20 27 72 65 73 75  ult-set! r 'resu
59c0: 6c 74 2d 6b 69 6e 64 0a 09 09 20 20 20 20 20 20  lt-kind...      
59d0: 28 69 66 20 28 65 71 3f 20 28 74 65 73 74 2d 72  (if (eq? (test-r
59e0: 65 73 75 6c 74 2d 72 65 66 20 72 20 27 72 65 73  esult-ref r 'res
59f0: 75 6c 74 2d 6b 69 6e 64 29 20 27 78 66 61 69 6c  ult-kind) 'xfail
5a00: 29 0a 09 09 09 20 20 28 69 66 20 72 65 73 75 6c  )....  (if resul
5a10: 74 20 27 78 70 61 73 73 20 27 78 66 61 69 6c 29  t 'xpass 'xfail)
5a20: 0a 09 09 09 20 20 28 69 66 20 72 65 73 75 6c 74  ....  (if result
5a30: 20 27 70 61 73 73 20 27 66 61 69 6c 29 29 29 29   'pass 'fail))))
5a40: 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d  ..(define (test-
5a50: 72 75 6e 6e 65 72 2d 74 65 73 74 2d 6e 61 6d 65  runner-test-name
5a60: 20 72 75 6e 6e 65 72 29 0a 20 20 28 74 65 73 74   runner).  (test
5a70: 2d 72 65 73 75 6c 74 2d 72 65 66 20 72 75 6e 6e  -result-ref runn
5a80: 65 72 20 27 74 65 73 74 2d 6e 61 6d 65 20 22 22  er 'test-name ""
5a90: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74  ))..(define-synt
5aa0: 61 78 20 25 74 65 73 74 2d 63 6f 6d 70 32 62 6f  ax %test-comp2bo
5ab0: 64 79 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c  dy.  (syntax-rul
5ac0: 65 73 20 28 29 0a 09 09 28 28 25 74 65 73 74 2d  es ()...((%test-
5ad0: 63 6f 6d 70 32 62 6f 64 79 20 72 20 63 6f 6d 70  comp2body r comp
5ae0: 20 65 78 70 65 63 74 65 64 20 65 78 70 72 29 0a   expected expr).
5af0: 09 09 20 28 6c 65 74 20 28 29 0a 09 09 20 20 20  .. (let ()...   
5b00: 28 69 66 20 28 25 74 65 73 74 2d 6f 6e 2d 74 65  (if (%test-on-te
5b10: 73 74 2d 62 65 67 69 6e 20 72 29 0a 09 09 20 20  st-begin r)...  
5b20: 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 70 20       (let ((exp 
5b30: 65 78 70 65 63 74 65 64 29 29 0a 09 09 09 20 28  expected)).... (
5b40: 74 65 73 74 2d 72 65 73 75 6c 74 2d 73 65 74 21  test-result-set!
5b50: 20 72 20 27 65 78 70 65 63 74 65 64 2d 76 61 6c   r 'expected-val
5b60: 75 65 20 65 78 70 29 0a 09 09 09 20 28 6c 65 74  ue exp).... (let
5b70: 20 28 28 72 65 73 20 28 25 74 65 73 74 2d 65 76   ((res (%test-ev
5b80: 61 6c 75 61 74 65 2d 77 69 74 68 2d 63 61 74 63  aluate-with-catc
5b90: 68 20 65 78 70 72 29 29 29 0a 09 09 09 20 20 20  h expr)))....   
5ba0: 28 74 65 73 74 2d 72 65 73 75 6c 74 2d 73 65 74  (test-result-set
5bb0: 21 20 72 20 27 61 63 74 75 61 6c 2d 76 61 6c 75  ! r 'actual-valu
5bc0: 65 20 72 65 73 29 0a 09 09 09 20 20 20 28 25 74  e res)....   (%t
5bd0: 65 73 74 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64 20  est-on-test-end 
5be0: 72 20 28 63 6f 6d 70 20 65 78 70 20 72 65 73 29  r (comp exp res)
5bf0: 29 29 29 29 0a 09 09 20 20 20 28 25 74 65 73 74  ))))...   (%test
5c00: 2d 72 65 70 6f 72 74 2d 72 65 73 75 6c 74 29 29  -report-result))
5c10: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 74  )))..(define (%t
5c20: 65 73 74 2d 61 70 70 72 6f 78 69 6d 69 6d 61 74  est-approximimat
5c30: 65 3d 20 65 72 72 6f 72 29 0a 20 20 28 6c 61 6d  e= error).  (lam
5c40: 62 64 61 20 28 76 61 6c 75 65 20 65 78 70 65 63  bda (value expec
5c50: 74 65 64 29 0a 20 20 20 20 28 61 6e 64 20 28 3e  ted).    (and (>
5c60: 3d 20 76 61 6c 75 65 20 28 2d 20 65 78 70 65 63  = value (- expec
5c70: 74 65 64 20 65 72 72 6f 72 29 29 0a 20 20 20 20  ted error)).    
5c80: 20 20 20 20 20 28 3c 3d 20 76 61 6c 75 65 20 28       (<= value (
5c90: 2b 20 65 78 70 65 63 74 65 64 20 65 72 72 6f 72  + expected error
5ca0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73  )))))..(define-s
5cb0: 79 6e 74 61 78 20 25 74 65 73 74 2d 63 6f 6d 70  yntax %test-comp
5cc0: 31 62 6f 64 79 0a 20 20 28 73 79 6e 74 61 78 2d  1body.  (syntax-
5cd0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 25  rules ().    ((%
5ce0: 74 65 73 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72  test-comp1body r
5cf0: 20 65 78 70 72 29 0a 20 20 20 20 20 28 6c 65 74   expr).     (let
5d00: 20 28 29 0a 20 20 20 20 20 20 20 28 69 66 20 28   ().       (if (
5d10: 25 74 65 73 74 2d 6f 6e 2d 74 65 73 74 2d 62 65  %test-on-test-be
5d20: 67 69 6e 20 72 29 0a 09 20 20 20 28 6c 65 74 20  gin r)..   (let 
5d30: 28 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28  ()..     (let ((
5d40: 72 65 73 20 28 25 74 65 73 74 2d 65 76 61 6c 75  res (%test-evalu
5d50: 61 74 65 2d 77 69 74 68 2d 63 61 74 63 68 20 65  ate-with-catch e
5d60: 78 70 72 29 29 29 0a 09 20 20 20 20 20 20 20 28  xpr)))..       (
5d70: 74 65 73 74 2d 72 65 73 75 6c 74 2d 73 65 74 21  test-result-set!
5d80: 20 72 20 27 61 63 74 75 61 6c 2d 76 61 6c 75 65   r 'actual-value
5d90: 20 72 65 73 29 0a 09 20 20 20 20 20 20 20 28 25   res)..       (%
5da0: 74 65 73 74 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64  test-on-test-end
5db0: 20 72 20 72 65 73 29 29 29 29 0a 20 20 20 20 20   r res)))).     
5dc0: 20 20 28 25 74 65 73 74 2d 72 65 70 6f 72 74 2d    (%test-report-
5dd0: 72 65 73 75 6c 74 29 29 29 29 29 0a 0a 28 63 6f  result)))))..(co
5de0: 6e 64 2d 65 78 70 61 6e 64 0a 20 28 28 61 6e 64  nd-expand. ((and
5df0: 20 28 6e 6f 74 20 72 36 72 73 29 20 28 6f 72 20   (not r6rs) (or 
5e00: 6b 61 77 61 20 6d 7a 73 63 68 65 6d 65 29 29 0a  kawa mzscheme)).
5e10: 20 20 3b 3b 20 53 68 6f 75 6c 64 20 62 65 20 6d    ;; Should be m
5e20: 61 64 65 20 74 6f 20 77 6f 72 6b 20 66 6f 72 20  ade to work for 
5e30: 61 6e 79 20 53 63 68 65 6d 65 20 77 69 74 68 20  any Scheme with 
5e40: 73 79 6e 74 61 78 2d 63 61 73 65 0a 20 20 3b 3b  syntax-case.  ;;
5e50: 20 48 6f 77 65 76 65 72 2c 20 49 20 68 61 76 65   However, I have
5e60: 6e 27 74 20 67 6f 74 74 65 6e 20 74 68 65 20 71  n't gotten the q
5e70: 75 6f 74 69 6e 67 20 77 6f 72 6b 69 6e 67 2e 20  uoting working. 
5e80: 20 46 49 58 4d 45 2e 0a 20 20 28 64 65 66 69 6e   FIXME..  (defin
5e90: 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 65 6e  e-syntax test-en
5ea0: 64 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78  d.    (lambda (x
5eb0: 29 0a 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d  ).      (syntax-
5ec0: 63 61 73 65 20 28 6c 69 73 74 20 78 20 28 6c 69  case (list x (li
5ed0: 73 74 20 27 71 75 6f 74 65 20 28 25 74 65 73 74  st 'quote (%test
5ee0: 2d 73 6f 75 72 63 65 2d 6c 69 6e 65 32 20 78 29  -source-line2 x)
5ef0: 29 29 20 28 29 0a 09 28 28 28 6d 61 63 20 73 75  )) ()..(((mac su
5f00: 69 74 65 2d 6e 61 6d 65 29 20 6c 69 6e 65 29 0a  ite-name) line).
5f10: 09 20 28 73 79 6e 74 61 78 0a 09 20 20 28 25 74  . (syntax..  (%t
5f20: 65 73 74 2d 65 6e 64 20 73 75 69 74 65 2d 6e 61  est-end suite-na
5f30: 6d 65 20 6c 69 6e 65 29 29 29 0a 09 28 28 28 6d  me line)))..(((m
5f40: 61 63 29 20 6c 69 6e 65 29 0a 09 20 28 73 79 6e  ac) line).. (syn
5f50: 74 61 78 0a 09 20 20 28 25 74 65 73 74 2d 65 6e  tax..  (%test-en
5f60: 64 20 23 66 20 6c 69 6e 65 29 29 29 29 29 29 0a  d #f line)))))).
5f70: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78    (define-syntax
5f80: 20 74 65 73 74 2d 61 73 73 65 72 74 0a 20 20 20   test-assert.   
5f90: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20   (lambda (x).   
5fa0: 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20     (syntax-case 
5fb0: 28 6c 69 73 74 20 78 20 28 6c 69 73 74 20 27 71  (list x (list 'q
5fc0: 75 6f 74 65 20 28 25 74 65 73 74 2d 73 6f 75 72  uote (%test-sour
5fd0: 63 65 2d 6c 69 6e 65 32 20 78 29 29 29 20 28 29  ce-line2 x))) ()
5fe0: 0a 09 28 28 28 6d 61 63 20 74 6e 61 6d 65 20 65  ..(((mac tname e
5ff0: 78 70 72 29 20 6c 69 6e 65 29 0a 09 20 28 73 79  xpr) line).. (sy
6000: 6e 74 61 78 0a 09 20 20 28 6c 65 74 2a 20 28 28  ntax..  (let* ((
6010: 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67  r (test-runner-g
6020: 65 74 29 29 0a 09 09 20 28 6e 61 6d 65 20 74 6e  et))... (name tn
6030: 61 6d 65 29 29 0a 09 20 20 20 20 28 74 65 73 74  ame))..    (test
6040: 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20 72  -result-alist! r
6050: 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 27 74 65   (cons (cons 'te
6060: 73 74 2d 6e 61 6d 65 20 74 6e 61 6d 65 29 20 6c  st-name tname) l
6070: 69 6e 65 29 29 0a 09 20 20 20 20 28 25 74 65 73  ine))..    (%tes
6080: 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72 20 65 78  t-comp1body r ex
6090: 70 72 29 29 29 29 0a 09 28 28 28 6d 61 63 20 65  pr))))..(((mac e
60a0: 78 70 72 29 20 6c 69 6e 65 29 0a 09 20 28 73 79  xpr) line).. (sy
60b0: 6e 74 61 78 0a 09 20 20 28 6c 65 74 2a 20 28 28  ntax..  (let* ((
60c0: 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67  r (test-runner-g
60d0: 65 74 29 29 29 0a 09 20 20 20 20 28 74 65 73 74  et)))..    (test
60e0: 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20 72  -result-alist! r
60f0: 20 6c 69 6e 65 29 0a 09 20 20 20 20 28 25 74 65   line)..    (%te
6100: 73 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72 20 65  st-comp1body r e
6110: 78 70 72 29 29 29 29 29 29 29 0a 20 20 28 64 65  xpr))))))).  (de
6120: 66 69 6e 65 2d 66 6f 72 2d 73 79 6e 74 61 78 20  fine-for-syntax 
6130: 28 25 74 65 73 74 2d 63 6f 6d 70 32 20 63 6f 6d  (%test-comp2 com
6140: 70 20 78 29 0a 20 20 20 20 28 73 79 6e 74 61 78  p x).    (syntax
6150: 2d 63 61 73 65 20 28 6c 69 73 74 20 78 20 28 6c  -case (list x (l
6160: 69 73 74 20 27 71 75 6f 74 65 20 28 25 74 65 73  ist 'quote (%tes
6170: 74 2d 73 6f 75 72 63 65 2d 6c 69 6e 65 32 20 78  t-source-line2 x
6180: 29 29 20 63 6f 6d 70 29 20 28 29 0a 20 20 20 20  )) comp) ().    
6190: 20 20 28 28 28 6d 61 63 20 74 6e 61 6d 65 20 65    (((mac tname e
61a0: 78 70 65 63 74 65 64 20 65 78 70 72 29 20 6c 69  xpected expr) li
61b0: 6e 65 20 63 6f 6d 70 29 0a 20 20 20 20 20 20 20  ne comp).       
61c0: 28 73 79 6e 74 61 78 0a 09 28 6c 65 74 2a 20 28  (syntax..(let* (
61d0: 28 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d  (r (test-runner-
61e0: 67 65 74 29 29 0a 09 20 20 20 20 20 20 20 28 6e  get))..       (n
61f0: 61 6d 65 20 74 6e 61 6d 65 29 29 0a 09 20 20 28  ame tname))..  (
6200: 74 65 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73  test-result-alis
6210: 74 21 20 72 20 28 63 6f 6e 73 20 28 63 6f 6e 73  t! r (cons (cons
6220: 20 27 74 65 73 74 2d 6e 61 6d 65 20 74 6e 61 6d   'test-name tnam
6230: 65 29 20 6c 69 6e 65 29 29 0a 09 20 20 28 25 74  e) line))..  (%t
6240: 65 73 74 2d 63 6f 6d 70 32 62 6f 64 79 20 72 20  est-comp2body r 
6250: 63 6f 6d 70 20 65 78 70 65 63 74 65 64 20 65 78  comp expected ex
6260: 70 72 29 29 29 29 0a 20 20 20 20 20 20 28 28 28  pr)))).      (((
6270: 6d 61 63 20 65 78 70 65 63 74 65 64 20 65 78 70  mac expected exp
6280: 72 29 20 6c 69 6e 65 20 63 6f 6d 70 29 0a 20 20  r) line comp).  
6290: 20 20 20 20 20 28 73 79 6e 74 61 78 0a 09 28 6c       (syntax..(l
62a0: 65 74 2a 20 28 28 72 20 28 74 65 73 74 2d 72 75  et* ((r (test-ru
62b0: 6e 6e 65 72 2d 67 65 74 29 29 29 0a 09 20 20 28  nner-get)))..  (
62c0: 74 65 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73  test-result-alis
62d0: 74 21 20 72 20 6c 69 6e 65 29 0a 09 20 20 28 25  t! r line)..  (%
62e0: 74 65 73 74 2d 63 6f 6d 70 32 62 6f 64 79 20 72  test-comp2body r
62f0: 20 63 6f 6d 70 20 65 78 70 65 63 74 65 64 20 65   comp expected e
6300: 78 70 72 29 29 29 29 29 29 0a 20 20 28 64 65 66  xpr)))))).  (def
6310: 69 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d  ine-syntax test-
6320: 65 71 76 0a 20 20 20 20 28 6c 61 6d 62 64 61 20  eqv.    (lambda 
6330: 28 78 29 20 28 25 74 65 73 74 2d 63 6f 6d 70 32  (x) (%test-comp2
6340: 20 28 73 79 6e 74 61 78 20 65 71 76 3f 29 20 78   (syntax eqv?) x
6350: 29 29 29 0a 20 20 28 64 65 66 69 6e 65 2d 73 79  ))).  (define-sy
6360: 6e 74 61 78 20 74 65 73 74 2d 65 71 0a 20 20 20  ntax test-eq.   
6370: 20 28 6c 61 6d 62 64 61 20 28 78 29 20 28 25 74   (lambda (x) (%t
6380: 65 73 74 2d 63 6f 6d 70 32 20 28 73 79 6e 74 61  est-comp2 (synta
6390: 78 20 65 71 3f 29 20 78 29 29 29 0a 20 20 28 64  x eq?) x))).  (d
63a0: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 74 65 73  efine-syntax tes
63b0: 74 2d 65 71 75 61 6c 0a 20 20 20 20 28 6c 61 6d  t-equal.    (lam
63c0: 62 64 61 20 28 78 29 20 28 25 74 65 73 74 2d 63  bda (x) (%test-c
63d0: 6f 6d 70 32 20 28 73 79 6e 74 61 78 20 65 71 75  omp2 (syntax equ
63e0: 61 6c 3f 29 20 78 29 29 29 0a 20 20 28 64 65 66  al?) x))).  (def
63f0: 69 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d  ine-syntax test-
6400: 61 70 70 72 6f 78 69 6d 61 74 65 20 3b 3b 20 46  approximate ;; F
6410: 49 58 4d 45 20 2d 20 6e 65 65 64 65 64 20 66 6f  IXME - needed fo
6420: 72 20 6e 6f 6e 2d 4b 61 77 61 0a 20 20 20 20 28  r non-Kawa.    (
6430: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20  lambda (x).     
6440: 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 28 6c   (syntax-case (l
6450: 69 73 74 20 78 20 28 6c 69 73 74 20 27 71 75 6f  ist x (list 'quo
6460: 74 65 20 28 25 74 65 73 74 2d 73 6f 75 72 63 65  te (%test-source
6470: 2d 6c 69 6e 65 32 20 78 29 29 29 20 28 29 0a 20  -line2 x))) (). 
6480: 20 20 20 20 20 28 28 28 6d 61 63 20 74 6e 61 6d       (((mac tnam
6490: 65 20 65 78 70 65 63 74 65 64 20 65 78 70 72 20  e expected expr 
64a0: 65 72 72 6f 72 29 20 6c 69 6e 65 29 0a 20 20 20  error) line).   
64b0: 20 20 20 20 28 73 79 6e 74 61 78 0a 09 28 6c 65      (syntax..(le
64c0: 74 2a 20 28 28 72 20 28 74 65 73 74 2d 72 75 6e  t* ((r (test-run
64d0: 6e 65 72 2d 67 65 74 29 29 0a 09 20 20 20 20 20  ner-get))..     
64e0: 20 20 28 6e 61 6d 65 20 74 6e 61 6d 65 29 29 0a    (name tname)).
64f0: 09 20 20 28 74 65 73 74 2d 72 65 73 75 6c 74 2d  .  (test-result-
6500: 61 6c 69 73 74 21 20 72 20 28 63 6f 6e 73 20 28  alist! r (cons (
6510: 63 6f 6e 73 20 27 74 65 73 74 2d 6e 61 6d 65 20  cons 'test-name 
6520: 74 6e 61 6d 65 29 20 6c 69 6e 65 29 29 0a 09 20  tname) line)).. 
6530: 20 28 25 74 65 73 74 2d 63 6f 6d 70 32 62 6f 64   (%test-comp2bod
6540: 79 20 72 20 28 25 74 65 73 74 2d 61 70 70 72 6f  y r (%test-appro
6550: 78 69 6d 69 6d 61 74 65 3d 20 65 72 72 6f 72 29  ximimate= error)
6560: 20 65 78 70 65 63 74 65 64 20 65 78 70 72 29 29   expected expr))
6570: 29 29 0a 20 20 20 20 20 20 28 28 28 6d 61 63 20  )).      (((mac 
6580: 65 78 70 65 63 74 65 64 20 65 78 70 72 20 65 72  expected expr er
6590: 72 6f 72 29 20 6c 69 6e 65 29 0a 20 20 20 20 20  ror) line).     
65a0: 20 20 28 73 79 6e 74 61 78 0a 09 28 6c 65 74 2a    (syntax..(let*
65b0: 20 28 28 72 20 28 74 65 73 74 2d 72 75 6e 6e 65   ((r (test-runne
65c0: 72 2d 67 65 74 29 29 29 0a 09 20 20 28 74 65 73  r-get)))..  (tes
65d0: 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20  t-result-alist! 
65e0: 72 20 6c 69 6e 65 29 0a 09 20 20 28 25 74 65 73  r line)..  (%tes
65f0: 74 2d 63 6f 6d 70 32 62 6f 64 79 20 72 20 28 25  t-comp2body r (%
6600: 74 65 73 74 2d 61 70 70 72 6f 78 69 6d 69 6d 61  test-approximima
6610: 74 65 3d 20 65 72 72 6f 72 29 20 65 78 70 65 63  te= error) expec
6620: 74 65 64 20 65 78 70 72 29 29 29 29 29 29 29 29  ted expr))))))))
6630: 0a 20 28 65 6c 73 65 0a 20 20 28 64 65 66 69 6e  . (else.  (defin
6640: 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 65 6e  e-syntax test-en
6650: 64 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75  d.    (syntax-ru
6660: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 74  les ().      ((t
6670: 65 73 74 2d 65 6e 64 29 0a 20 20 20 20 20 20 20  est-end).       
6680: 28 25 74 65 73 74 2d 65 6e 64 20 23 66 20 27 28  (%test-end #f '(
6690: 29 29 29 0a 20 20 20 20 20 20 28 28 74 65 73 74  ))).      ((test
66a0: 2d 65 6e 64 20 73 75 69 74 65 2d 6e 61 6d 65 29  -end suite-name)
66b0: 0a 20 20 20 20 20 20 20 28 25 74 65 73 74 2d 65  .       (%test-e
66c0: 6e 64 20 73 75 69 74 65 2d 6e 61 6d 65 20 27 28  nd suite-name '(
66d0: 29 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 2d  ))))).  (define-
66e0: 73 79 6e 74 61 78 20 74 65 73 74 2d 61 73 73 65  syntax test-asse
66f0: 72 74 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72  rt.    (syntax-r
6700: 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28  ules ().      ((
6710: 74 65 73 74 2d 61 73 73 65 72 74 20 74 6e 61 6d  test-assert tnam
6720: 65 20 74 65 73 74 2d 65 78 70 72 65 73 73 69 6f  e test-expressio
6730: 6e 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28  n).       (let (
6740: 28 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d  (r (test-runner-
6750: 67 65 74 29 29 29 0a 09 20 28 74 65 73 74 2d 72  get))).. (test-r
6760: 65 73 75 6c 74 2d 61 6c 69 73 74 21 20 72 20 60  esult-alist! r `
6770: 28 28 74 65 73 74 2d 6e 61 6d 65 20 2e 20 2c 74  ((test-name . ,t
6780: 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20  name).          
6790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
67a0: 20 20 20 20 20 20 20 28 73 6f 75 72 63 65 2d 66         (source-f
67b0: 6f 72 6d 20 2e 20 74 65 73 74 2d 65 78 70 72 65  orm . test-expre
67c0: 73 73 69 6f 6e 29 29 29 0a 09 20 28 25 74 65 73  ssion))).. (%tes
67d0: 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72 20 74 65  t-comp1body r te
67e0: 73 74 2d 65 78 70 72 65 73 73 69 6f 6e 29 29 29  st-expression)))
67f0: 0a 20 20 20 20 20 20 28 28 74 65 73 74 2d 61 73  .      ((test-as
6800: 73 65 72 74 20 74 65 73 74 2d 65 78 70 72 65 73  sert test-expres
6810: 73 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 6c 65  sion).       (le
6820: 74 20 28 28 72 20 28 74 65 73 74 2d 72 75 6e 6e  t ((r (test-runn
6830: 65 72 2d 67 65 74 29 29 29 0a 09 20 28 74 65 73  er-get))).. (tes
6840: 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20  t-result-alist! 
6850: 72 20 27 28 28 73 6f 75 72 63 65 2d 66 6f 72 6d  r '((source-form
6860: 20 2e 20 74 65 73 74 2d 65 78 70 72 65 73 73 69   . test-expressi
6870: 6f 6e 29 29 29 0a 09 20 28 25 74 65 73 74 2d 63  on))).. (%test-c
6880: 6f 6d 70 31 62 6f 64 79 20 72 20 74 65 73 74 2d  omp1body r test-
6890: 65 78 70 72 65 73 73 69 6f 6e 29 29 29 29 29 0a  expression))))).
68a0: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78    (define-syntax
68b0: 20 25 74 65 73 74 2d 63 6f 6d 70 32 0a 20 20 20   %test-comp2.   
68c0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28   (syntax-rules (
68d0: 29 0a 20 20 20 20 20 20 28 28 25 74 65 73 74 2d  ).      ((%test-
68e0: 63 6f 6d 70 32 20 63 6f 6d 70 20 74 6e 61 6d 65  comp2 comp tname
68f0: 20 65 78 70 65 63 74 65 64 20 65 78 70 72 29 0a   expected expr).
6900: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 20         (let ((r 
6910: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 67 65 74  (test-runner-get
6920: 29 29 29 0a 09 20 28 74 65 73 74 2d 72 65 73 75  ))).. (test-resu
6930: 6c 74 2d 61 6c 69 73 74 21 20 72 20 60 28 28 74  lt-alist! r `((t
6940: 65 73 74 2d 6e 61 6d 65 20 2e 20 2c 74 6e 61 6d  est-name . ,tnam
6950: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  e).             
6960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6970: 20 20 20 20 28 73 6f 75 72 63 65 2d 66 6f 72 6d      (source-form
6980: 20 2e 20 65 78 70 72 29 29 29 0a 09 20 28 25 74   . expr))).. (%t
6990: 65 73 74 2d 63 6f 6d 70 32 62 6f 64 79 20 72 20  est-comp2body r 
69a0: 63 6f 6d 70 20 65 78 70 65 63 74 65 64 20 65 78  comp expected ex
69b0: 70 72 29 29 29 0a 20 20 20 20 20 20 28 28 25 74  pr))).      ((%t
69c0: 65 73 74 2d 63 6f 6d 70 32 20 63 6f 6d 70 20 65  est-comp2 comp e
69d0: 78 70 65 63 74 65 64 20 65 78 70 72 29 0a 20 20  xpected expr).  
69e0: 20 20 20 20 20 28 6c 65 74 20 28 28 72 20 28 74       (let ((r (t
69f0: 65 73 74 2d 72 75 6e 6e 65 72 2d 67 65 74 29 29  est-runner-get))
6a00: 29 0a 09 20 28 74 65 73 74 2d 72 65 73 75 6c 74  ).. (test-result
6a10: 2d 61 6c 69 73 74 21 20 72 20 27 28 28 73 6f 75  -alist! r '((sou
6a20: 72 63 65 2d 66 6f 72 6d 20 2e 20 65 78 70 72 29  rce-form . expr)
6a30: 29 29 0a 09 20 28 25 74 65 73 74 2d 63 6f 6d 70  )).. (%test-comp
6a40: 32 62 6f 64 79 20 72 20 63 6f 6d 70 20 65 78 70  2body r comp exp
6a50: 65 63 74 65 64 20 65 78 70 72 29 29 29 29 29 0a  ected expr))))).
6a60: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78    (define-syntax
6a70: 20 74 65 73 74 2d 65 71 75 61 6c 0a 20 20 20 20   test-equal.    
6a80: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
6a90: 0a 20 20 20 20 20 20 28 28 74 65 73 74 2d 65 71  .      ((test-eq
6aa0: 75 61 6c 20 2e 20 72 65 73 74 29 0a 20 20 20 20  ual . rest).    
6ab0: 20 20 20 28 25 74 65 73 74 2d 63 6f 6d 70 32 20     (%test-comp2 
6ac0: 65 71 75 61 6c 3f 20 2e 20 72 65 73 74 29 29 29  equal? . rest)))
6ad0: 29 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74  ).  (define-synt
6ae0: 61 78 20 74 65 73 74 2d 65 71 76 0a 20 20 20 20  ax test-eqv.    
6af0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
6b00: 0a 20 20 20 20 20 20 28 28 74 65 73 74 2d 65 71  .      ((test-eq
6b10: 76 20 2e 20 72 65 73 74 29 0a 20 20 20 20 20 20  v . rest).      
6b20: 20 28 25 74 65 73 74 2d 63 6f 6d 70 32 20 65 71   (%test-comp2 eq
6b30: 76 3f 20 2e 20 72 65 73 74 29 29 29 29 0a 20 20  v? . rest)))).  
6b40: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 74  (define-syntax t
6b50: 65 73 74 2d 65 71 0a 20 20 20 20 28 73 79 6e 74  est-eq.    (synt
6b60: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
6b70: 20 20 28 28 74 65 73 74 2d 65 71 20 2e 20 72 65    ((test-eq . re
6b80: 73 74 29 0a 20 20 20 20 20 20 20 28 25 74 65 73  st).       (%tes
6b90: 74 2d 63 6f 6d 70 32 20 65 71 3f 20 2e 20 72 65  t-comp2 eq? . re
6ba0: 73 74 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65  st)))).  (define
6bb0: 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 61 70 70  -syntax test-app
6bc0: 72 6f 78 69 6d 61 74 65 0a 20 20 20 20 28 73 79  roximate.    (sy
6bd0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
6be0: 20 20 20 20 28 28 74 65 73 74 2d 61 70 70 72 6f      ((test-appro
6bf0: 78 69 6d 61 74 65 20 74 6e 61 6d 65 20 65 78 70  ximate tname exp
6c00: 65 63 74 65 64 20 65 78 70 72 20 65 72 72 6f 72  ected expr error
6c10: 29 0a 20 20 20 20 20 20 20 28 25 74 65 73 74 2d  ).       (%test-
6c20: 63 6f 6d 70 32 20 28 25 74 65 73 74 2d 61 70 70  comp2 (%test-app
6c30: 72 6f 78 69 6d 69 6d 61 74 65 3d 20 65 72 72 6f  roximimate= erro
6c40: 72 29 20 74 6e 61 6d 65 20 65 78 70 65 63 74 65  r) tname expecte
6c50: 64 20 65 78 70 72 29 29 0a 20 20 20 20 20 20 28  d expr)).      (
6c60: 28 74 65 73 74 2d 61 70 70 72 6f 78 69 6d 61 74  (test-approximat
6c70: 65 20 65 78 70 65 63 74 65 64 20 65 78 70 72 20  e expected expr 
6c80: 65 72 72 6f 72 29 0a 20 20 20 20 20 20 20 28 25  error).       (%
6c90: 74 65 73 74 2d 63 6f 6d 70 32 20 28 25 74 65 73  test-comp2 (%tes
6ca0: 74 2d 61 70 70 72 6f 78 69 6d 69 6d 61 74 65 3d  t-approximimate=
6cb0: 20 65 72 72 6f 72 29 20 65 78 70 65 63 74 65 64   error) expected
6cc0: 20 65 78 70 72 29 29 29 29 29 29 0a 0a 28 63 6f   expr))))))..(co
6cd0: 6e 64 2d 65 78 70 61 6e 64 0a 20 28 72 36 72 73  nd-expand. (r6rs
6ce0: 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61  .  (define-synta
6cf0: 78 20 25 74 65 73 74 2d 65 72 72 6f 72 0a 20 20  x %test-error.  
6d00: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20    (syntax-rules 
6d10: 28 29 0a 20 20 20 20 20 20 28 28 25 74 65 73 74  ().      ((%test
6d20: 2d 65 72 72 6f 72 20 65 74 79 70 65 20 65 78 70  -error etype exp
6d30: 72 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28  r).       (let (
6d40: 28 74 20 65 74 79 70 65 29 29 0a 20 20 20 20 20  (t etype)).     
6d50: 20 20 20 20 28 77 68 65 6e 20 28 70 72 6f 63 65      (when (proce
6d60: 64 75 72 65 3f 20 74 29 0a 20 20 20 20 20 20 20  dure? t).       
6d70: 20 20 20 20 28 74 65 73 74 2d 72 65 73 75 6c 74      (test-result
6d80: 2d 73 65 74 21 20 28 74 65 73 74 2d 72 75 6e 6e  -set! (test-runn
6d90: 65 72 2d 67 65 74 29 20 27 65 78 70 65 63 74 65  er-get) 'expecte
6da0: 64 2d 65 72 72 6f 72 20 74 29 29 0a 20 20 20 20  d-error t)).    
6db0: 20 20 20 20 20 28 67 75 61 72 64 20 28 65 78 20       (guard (ex 
6dc0: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20  (else.          
6dd0: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74             (test
6de0: 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 28 74 65  -result-set! (te
6df0: 73 74 2d 72 75 6e 6e 65 72 2d 67 65 74 29 20 27  st-runner-get) '
6e00: 61 63 74 75 61 6c 2d 65 72 72 6f 72 20 65 78 29  actual-error ex)
6e10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
6e20: 20 20 20 20 20 20 28 69 66 20 28 70 72 6f 63 65        (if (proce
6e30: 64 75 72 65 3f 20 74 29 20 28 74 20 65 78 29 20  dure? t) (t ex) 
6e40: 23 54 29 29 29 0a 20 20 20 20 20 20 20 20 20 20  #T))).          
6e50: 20 65 78 70 72 0a 20 20 20 20 20 20 20 20 20 20   expr.          
6e60: 20 23 46 29 29 29 29 29 29 0a 20 28 67 75 69 6c   #F)))))). (guil
6e70: 65 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74  e.  (define-synt
6e80: 61 78 20 25 74 65 73 74 2d 65 72 72 6f 72 0a 20  ax %test-error. 
6e90: 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73     (syntax-rules
6ea0: 20 28 29 0a 20 20 20 20 20 20 28 28 25 74 65 73   ().      ((%tes
6eb0: 74 2d 65 72 72 6f 72 20 72 20 65 74 79 70 65 20  t-error r etype 
6ec0: 65 78 70 72 29 0a 20 20 20 20 20 20 20 28 25 74  expr).       (%t
6ed0: 65 73 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72 20  est-comp1body r 
6ee0: 28 63 61 74 63 68 20 23 74 20 28 6c 61 6d 62 64  (catch #t (lambd
6ef0: 61 20 28 29 20 65 78 70 72 29 20 28 6c 61 6d 62  a () expr) (lamb
6f00: 64 61 20 28 6b 65 79 20 2e 20 61 72 67 73 29 20  da (key . args) 
6f10: 23 74 29 29 29 29 29 29 29 0a 20 28 6d 7a 73 63  #t))))))). (mzsc
6f20: 68 65 6d 65 0a 20 20 28 64 65 66 69 6e 65 2d 73  heme.  (define-s
6f30: 79 6e 74 61 78 20 25 74 65 73 74 2d 65 72 72 6f  yntax %test-erro
6f40: 72 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75  r.    (syntax-ru
6f50: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 25  les ().      ((%
6f60: 74 65 73 74 2d 65 72 72 6f 72 20 72 20 65 74 79  test-error r ety
6f70: 70 65 20 65 78 70 72 29 0a 20 20 20 20 20 20 20  pe expr).       
6f80: 28 25 74 65 73 74 2d 63 6f 6d 70 31 62 6f 64 79  (%test-comp1body
6f90: 20 72 20 28 77 69 74 68 2d 68 61 6e 64 6c 65 72   r (with-handler
6fa0: 73 20 28 28 28 6c 61 6d 62 64 61 20 28 68 29 20  s (((lambda (h) 
6fb0: 23 74 29 20 28 6c 61 6d 62 64 61 20 28 68 29 20  #t) (lambda (h) 
6fc0: 23 74 29 29 29 0a 09 09 09 09 09 20 28 6c 65 74  #t)))...... (let
6fd0: 20 28 29 0a 09 09 09 09 09 20 20 20 28 74 65 73   ()......   (tes
6fe0: 74 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 72 20  t-result-set! r 
6ff0: 27 61 63 74 75 61 6c 2d 76 61 6c 75 65 20 65 78  'actual-value ex
7000: 70 72 29 0a 09 09 09 09 09 20 20 20 23 66 29 29  pr)......   #f))
7010: 29 29 29 29 29 0a 20 28 63 68 69 63 6b 65 6e 0a  ))))). (chicken.
7020: 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78    (define-syntax
7030: 20 25 74 65 73 74 2d 65 72 72 6f 72 0a 20 20 20   %test-error.   
7040: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28   (syntax-rules (
7050: 29 0a 20 20 20 20 20 20 28 28 25 74 65 73 74 2d  ).      ((%test-
7060: 65 72 72 6f 72 20 72 20 65 74 79 70 65 20 65 78  error r etype ex
7070: 70 72 29 0a 20 20 20 20 20 20 20 20 28 25 74 65  pr).        (%te
7080: 73 74 2d 63 6f 6d 70 31 62 6f 64 79 20 72 20 28  st-comp1body r (
7090: 63 6f 6e 64 69 74 69 6f 6e 2d 63 61 73 65 20 65  condition-case e
70a0: 78 70 72 20 28 65 78 20 28 29 20 23 74 29 29 29  xpr (ex () #t)))
70b0: 29 29 29 29 0a 20 28 6b 61 77 61 0a 20 20 28 64  )))). (kawa.  (d
70c0: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65  efine-syntax %te
70d0: 73 74 2d 65 72 72 6f 72 0a 20 20 20 20 28 73 79  st-error.    (sy
70e0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
70f0: 20 20 20 20 28 28 25 74 65 73 74 2d 65 72 72 6f      ((%test-erro
7100: 72 20 72 20 65 74 79 70 65 20 65 78 70 72 29 0a  r r etype expr).
7110: 20 20 20 20 20 20 20 28 6c 65 74 20 28 29 0a 09         (let ()..
7120: 20 28 69 66 20 28 25 74 65 73 74 2d 6f 6e 2d 74   (if (%test-on-t
7130: 65 73 74 2d 62 65 67 69 6e 20 72 29 0a 09 20 20  est-begin r)..  
7140: 20 20 20 28 6c 65 74 20 28 28 65 74 20 65 74 79     (let ((et ety
7150: 70 65 29 29 0a 09 20 20 20 20 20 20 20 28 74 65  pe))..       (te
7160: 73 74 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 72  st-result-set! r
7170: 20 27 65 78 70 65 63 74 65 64 2d 65 72 72 6f 72   'expected-error
7180: 20 65 74 29 0a 09 20 20 20 20 20 20 20 28 25 74   et)..       (%t
7190: 65 73 74 2d 6f 6e 2d 74 65 73 74 2d 65 6e 64 20  est-on-test-end 
71a0: 72 0a 09 09 09 09 20 20 28 74 72 79 2d 63 61 74  r.....  (try-cat
71b0: 63 68 0a 09 09 09 09 20 20 20 28 6c 65 74 20 28  ch.....   (let (
71c0: 29 0a 09 09 09 09 20 20 20 20 20 28 74 65 73 74  ).....     (test
71d0: 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 72 20 27  -result-set! r '
71e0: 61 63 74 75 61 6c 2d 76 61 6c 75 65 20 65 78 70  actual-value exp
71f0: 72 29 0a 09 09 09 09 20 20 20 20 20 23 66 29 0a  r).....     #f).
7200: 09 09 09 09 20 20 20 28 65 78 20 3c 6a 61 76 61  ....   (ex <java
7210: 2e 6c 61 6e 67 2e 54 68 72 6f 77 61 62 6c 65 3e  .lang.Throwable>
7220: 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 65 73  .....       (tes
7230: 74 2d 72 65 73 75 6c 74 2d 73 65 74 21 20 72 20  t-result-set! r 
7240: 27 61 63 74 75 61 6c 2d 65 72 72 6f 72 20 65 78  'actual-error ex
7250: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 6f  ).....       (co
7260: 6e 64 20 28 28 61 6e 64 20 28 69 6e 73 74 61 6e  nd ((and (instan
7270: 63 65 3f 20 65 74 20 3c 67 6e 75 2e 62 79 74 65  ce? et <gnu.byte
7280: 63 6f 64 65 2e 43 6c 61 73 73 54 79 70 65 3e 29  code.ClassType>)
7290: 0a 09 09 09 09 09 09 20 20 20 28 67 6e 75 2e 62  .......   (gnu.b
72a0: 79 74 65 63 6f 64 65 2e 43 6c 61 73 73 54 79 70  ytecode.ClassTyp
72b0: 65 3a 69 73 53 75 62 63 6c 61 73 73 20 65 74 20  e:isSubclass et 
72c0: 3c 6a 61 76 61 2e 6c 61 6e 67 2e 54 68 72 6f 77  <java.lang.Throw
72d0: 61 62 6c 65 3e 29 29 0a 09 09 09 09 09 20 20 20  able>))......   
72e0: 20 20 20 28 69 6e 73 74 61 6e 63 65 3f 20 65 78     (instance? ex
72f0: 20 65 74 29 29 0a 09 09 09 09 09 20 20 20 20 20   et))......     
7300: 28 65 6c 73 65 20 23 74 29 29 29 29 29 0a 09 20  (else #t))))).. 
7310: 20 20 20 20 20 20 28 25 74 65 73 74 2d 72 65 70        (%test-rep
7320: 6f 72 74 2d 72 65 73 75 6c 74 29 29 29 29 29 29  ort-result))))))
7330: 29 29 0a 20 28 28 61 6e 64 20 73 72 66 69 2d 33  )). ((and srfi-3
7340: 34 20 73 72 66 69 2d 33 35 29 0a 20 20 28 64 65  4 srfi-35).  (de
7350: 66 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65 73  fine-syntax %tes
7360: 74 2d 65 72 72 6f 72 0a 20 20 20 20 28 73 79 6e  t-error.    (syn
7370: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
7380: 20 20 20 28 28 25 74 65 73 74 2d 65 72 72 6f 72     ((%test-error
7390: 20 72 20 65 74 79 70 65 20 65 78 70 72 29 0a 20   r etype expr). 
73a0: 20 20 20 20 20 20 28 25 74 65 73 74 2d 63 6f 6d        (%test-com
73b0: 70 31 62 6f 64 79 20 72 20 28 67 75 61 72 64 20  p1body r (guard 
73c0: 28 65 78 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d  (ex ((condition-
73d0: 74 79 70 65 3f 20 65 74 79 70 65 29 0a 09 09 20  type? etype)... 
73e0: 20 20 28 61 6e 64 20 28 63 6f 6e 64 69 74 69 6f    (and (conditio
73f0: 6e 3f 20 65 78 29 20 28 63 6f 6e 64 69 74 69 6f  n? ex) (conditio
7400: 6e 2d 68 61 73 2d 74 79 70 65 3f 20 65 78 20 65  n-has-type? ex e
7410: 74 79 70 65 29 29 29 0a 09 09 20 20 28 28 70 72  type)))...  ((pr
7420: 6f 63 65 64 75 72 65 3f 20 65 74 79 70 65 29 0a  ocedure? etype).
7430: 09 09 20 20 20 28 65 74 79 70 65 20 65 78 29 29  ..   (etype ex))
7440: 0a 09 09 20 20 28 28 65 71 75 61 6c 3f 20 74 79  ...  ((equal? ty
7450: 70 65 20 23 74 29 0a 09 09 20 20 20 23 74 29 0a  pe #t)...   #t).
7460: 09 09 20 20 28 65 6c 73 65 20 23 74 29 29 0a 09  ..  (else #t))..
7470: 20 20 20 20 20 20 65 78 70 72 29 29 29 29 29 29        expr))))))
7480: 0a 20 28 73 72 66 69 2d 33 34 0a 20 20 28 64 65  . (srfi-34.  (de
7490: 66 69 6e 65 2d 73 79 6e 74 61 78 20 25 74 65 73  fine-syntax %tes
74a0: 74 2d 65 72 72 6f 72 0a 20 20 20 20 28 73 79 6e  t-error.    (syn
74b0: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
74c0: 20 20 20 28 28 25 74 65 73 74 2d 65 72 72 6f 72     ((%test-error
74d0: 20 72 20 65 74 79 70 65 20 65 78 70 72 29 0a 20   r etype expr). 
74e0: 20 20 20 20 20 20 28 25 74 65 73 74 2d 63 6f 6d        (%test-com
74f0: 70 31 62 6f 64 79 20 72 20 28 67 75 61 72 64 20  p1body r (guard 
7500: 28 65 78 20 28 65 6c 73 65 20 23 74 29 29 20 65  (ex (else #t)) e
7510: 78 70 72 29 29 29 29 29 29 0a 20 28 65 6c 73 65  xpr)))))). (else
7520: 0a 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61  .  (define-synta
7530: 78 20 25 74 65 73 74 2d 65 72 72 6f 72 0a 20 20  x %test-error.  
7540: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20    (syntax-rules 
7550: 28 29 0a 20 20 20 20 20 20 28 28 25 74 65 73 74  ().      ((%test
7560: 2d 65 72 72 6f 72 20 72 20 65 74 79 70 65 20 65  -error r etype e
7570: 78 70 72 29 0a 20 20 20 20 20 20 20 28 62 65 67  xpr).       (beg
7580: 69 6e 0a 09 20 28 28 74 65 73 74 2d 72 75 6e 6e  in.. ((test-runn
7590: 65 72 2d 6f 6e 2d 74 65 73 74 2d 62 65 67 69 6e  er-on-test-begin
75a0: 20 72 29 20 72 29 0a 09 20 28 74 65 73 74 2d 72   r) r).. (test-r
75b0: 65 73 75 6c 74 2d 73 65 74 21 20 72 20 27 72 65  esult-set! r 're
75c0: 73 75 6c 74 2d 6b 69 6e 64 20 27 73 6b 69 70 29  sult-kind 'skip)
75d0: 0a 09 20 28 25 74 65 73 74 2d 72 65 70 6f 72 74  .. (%test-report
75e0: 2d 72 65 73 75 6c 74 29 29 29 29 29 29 29 0a 0a  -result)))))))..
75f0: 28 63 6f 6e 64 2d 65 78 70 61 6e 64 0a 20 28 28  (cond-expand. ((
7600: 61 6e 64 20 28 6e 6f 74 20 72 36 72 73 29 20 28  and (not r6rs) (
7610: 6f 72 20 6b 61 77 61 20 6d 7a 73 63 68 65 6d 65  or kawa mzscheme
7620: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 2d 73 79  ))..  (define-sy
7630: 6e 74 61 78 20 74 65 73 74 2d 65 72 72 6f 72 0a  ntax test-error.
7640: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a      (lambda (x).
7650: 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61        (syntax-ca
7660: 73 65 20 28 6c 69 73 74 20 78 20 28 6c 69 73 74  se (list x (list
7670: 20 27 71 75 6f 74 65 20 28 25 74 65 73 74 2d 73   'quote (%test-s
7680: 6f 75 72 63 65 2d 6c 69 6e 65 32 20 78 29 29 29  ource-line2 x)))
7690: 20 28 29 0a 09 28 28 28 6d 61 63 20 74 6e 61 6d   ()..(((mac tnam
76a0: 65 20 65 74 79 70 65 20 65 78 70 72 29 20 6c 69  e etype expr) li
76b0: 6e 65 29 0a 09 20 28 73 79 6e 74 61 78 0a 09 20  ne).. (syntax.. 
76c0: 20 28 6c 65 74 2a 20 28 28 72 20 28 74 65 73 74   (let* ((r (test
76d0: 2d 72 75 6e 6e 65 72 2d 67 65 74 29 29 0a 09 09  -runner-get))...
76e0: 20 28 6e 61 6d 65 20 74 6e 61 6d 65 29 29 0a 09   (name tname))..
76f0: 20 20 20 20 28 74 65 73 74 2d 72 65 73 75 6c 74      (test-result
7700: 2d 61 6c 69 73 74 21 20 72 20 28 63 6f 6e 73 20  -alist! r (cons 
7710: 28 63 6f 6e 73 20 27 74 65 73 74 2d 6e 61 6d 65  (cons 'test-name
7720: 20 74 6e 61 6d 65 29 20 6c 69 6e 65 29 29 0a 09   tname) line))..
7730: 20 20 20 20 28 25 74 65 73 74 2d 65 72 72 6f 72      (%test-error
7740: 20 72 20 65 74 79 70 65 20 65 78 70 72 29 29 29   r etype expr)))
7750: 29 0a 09 28 28 28 6d 61 63 20 65 74 79 70 65 20  )..(((mac etype 
7760: 65 78 70 72 29 20 6c 69 6e 65 29 0a 09 20 28 73  expr) line).. (s
7770: 79 6e 74 61 78 0a 09 20 20 28 6c 65 74 2a 20 28  yntax..  (let* (
7780: 28 72 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d  (r (test-runner-
7790: 67 65 74 29 29 29 0a 09 20 20 20 20 28 74 65 73  get)))..    (tes
77a0: 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73 74 21 20  t-result-alist! 
77b0: 72 20 6c 69 6e 65 29 0a 09 20 20 20 20 28 25 74  r line)..    (%t
77c0: 65 73 74 2d 65 72 72 6f 72 20 72 20 65 74 79 70  est-error r etyp
77d0: 65 20 65 78 70 72 29 29 29 29 0a 09 28 28 28 6d  e expr))))..(((m
77e0: 61 63 20 65 78 70 72 29 20 6c 69 6e 65 29 0a 09  ac expr) line)..
77f0: 20 28 73 79 6e 74 61 78 0a 09 20 20 28 6c 65 74   (syntax..  (let
7800: 2a 20 28 28 72 20 28 74 65 73 74 2d 72 75 6e 6e  * ((r (test-runn
7810: 65 72 2d 67 65 74 29 29 29 0a 09 20 20 20 20 28  er-get)))..    (
7820: 74 65 73 74 2d 72 65 73 75 6c 74 2d 61 6c 69 73  test-result-alis
7830: 74 21 20 72 20 6c 69 6e 65 29 0a 09 20 20 20 20  t! r line)..    
7840: 28 25 74 65 73 74 2d 65 72 72 6f 72 20 72 20 23  (%test-error r #
7850: 74 20 65 78 70 72 29 29 29 29 29 29 29 29 0a 20  t expr)))))))). 
7860: 28 65 6c 73 65 0a 20 20 28 64 65 66 69 6e 65 2d  (else.  (define-
7870: 73 79 6e 74 61 78 20 74 65 73 74 2d 65 72 72 6f  syntax test-erro
7880: 72 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75  r.    (syntax-ru
7890: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 28 28 74  les ().      ((t
78a0: 65 73 74 2d 65 72 72 6f 72 20 6e 61 6d 65 20 65  est-error name e
78b0: 74 79 70 65 20 65 78 70 72 29 0a 20 20 20 20 20  type expr).     
78c0: 20 20 28 74 65 73 74 2d 61 73 73 65 72 74 20 6e    (test-assert n
78d0: 61 6d 65 20 28 25 74 65 73 74 2d 65 72 72 6f 72  ame (%test-error
78e0: 20 65 74 79 70 65 20 65 78 70 72 29 29 29 0a 20   etype expr))). 
78f0: 20 20 20 20 20 28 28 74 65 73 74 2d 65 72 72 6f       ((test-erro
7900: 72 20 65 74 79 70 65 20 65 78 70 72 29 0a 20 20  r etype expr).  
7910: 20 20 20 20 20 28 74 65 73 74 2d 61 73 73 65 72       (test-asser
7920: 74 20 28 25 74 65 73 74 2d 65 72 72 6f 72 20 65  t (%test-error e
7930: 74 79 70 65 20 65 78 70 72 29 29 29 0a 20 20 20  type expr))).   
7940: 20 20 20 28 28 74 65 73 74 2d 65 72 72 6f 72 20     ((test-error 
7950: 65 78 70 72 29 0a 20 20 20 20 20 20 20 28 74 65  expr).       (te
7960: 73 74 2d 61 73 73 65 72 74 20 28 25 74 65 73 74  st-assert (%test
7970: 2d 65 72 72 6f 72 20 23 74 20 65 78 70 72 29 29  -error #t expr))
7980: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  )))))..(define (
7990: 74 65 73 74 2d 61 70 70 6c 79 20 66 69 72 73 74  test-apply first
79a0: 20 2e 20 72 65 73 74 29 0a 20 20 28 69 66 20 28   . rest).  (if (
79b0: 74 65 73 74 2d 72 75 6e 6e 65 72 3f 20 66 69 72  test-runner? fir
79c0: 73 74 29 0a 20 20 20 20 20 20 28 74 65 73 74 2d  st).      (test-
79d0: 77 69 74 68 2d 72 75 6e 6e 65 72 20 66 69 72 73  with-runner firs
79e0: 74 20 28 61 70 70 6c 79 20 74 65 73 74 2d 61 70  t (apply test-ap
79f0: 70 6c 79 20 72 65 73 74 29 29 0a 20 20 20 20 20  ply rest)).     
7a00: 20 28 6c 65 74 20 28 28 72 20 28 74 65 73 74 2d   (let ((r (test-
7a10: 72 75 6e 6e 65 72 2d 63 75 72 72 65 6e 74 29 29  runner-current))
7a20: 29 0a 09 28 69 66 20 72 0a 09 20 20 20 20 28 6c  )..(if r..    (l
7a30: 65 74 20 28 28 72 75 6e 2d 6c 69 73 74 20 28 25  et ((run-list (%
7a40: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 72 75 6e 2d  test-runner-run-
7a50: 6c 69 73 74 20 72 29 29 29 0a 09 20 20 20 20 20  list r)))..     
7a60: 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 72   (cond ((null? r
7a70: 65 73 74 29 0a 09 09 20 20 20 20 20 28 25 74 65  est)...     (%te
7a80: 73 74 2d 72 75 6e 6e 65 72 2d 72 75 6e 2d 6c 69  st-runner-run-li
7a90: 73 74 21 20 72 20 28 72 65 76 65 72 73 65 21 20  st! r (reverse! 
7aa0: 72 75 6e 2d 6c 69 73 74 29 29 0a 09 09 20 20 20  run-list))...   
7ab0: 20 20 28 66 69 72 73 74 29 29 20 3b 3b 20 61 63    (first)) ;; ac
7ac0: 74 75 61 6c 6c 79 20 61 70 70 6c 79 20 70 72 6f  tually apply pro
7ad0: 63 65 64 75 72 65 20 74 68 75 6e 6b 0a 09 09 20  cedure thunk... 
7ae0: 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 20 20     (else...     
7af0: 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d 72 75  (%test-runner-ru
7b00: 6e 2d 6c 69 73 74 21 0a 09 09 20 20 20 20 20 20  n-list!...      
7b10: 72 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 65  r...      (if (e
7b20: 71 3f 20 72 75 6e 2d 6c 69 73 74 20 23 74 29 20  q? run-list #t) 
7b30: 28 6c 69 73 74 20 66 69 72 73 74 29 20 28 63 6f  (list first) (co
7b40: 6e 73 20 66 69 72 73 74 20 72 75 6e 2d 6c 69 73  ns first run-lis
7b50: 74 29 29 29 0a 09 09 20 20 20 20 20 28 61 70 70  t)))...     (app
7b60: 6c 79 20 74 65 73 74 2d 61 70 70 6c 79 20 72 65  ly test-apply re
7b70: 73 74 29 0a 09 09 20 20 20 20 20 28 25 74 65 73  st)...     (%tes
7b80: 74 2d 72 75 6e 6e 65 72 2d 72 75 6e 2d 6c 69 73  t-runner-run-lis
7b90: 74 21 20 72 20 72 75 6e 2d 6c 69 73 74 29 29 29  t! r run-list)))
7ba0: 29 0a 09 20 20 20 20 28 6c 65 74 20 28 28 72 20  )..    (let ((r 
7bb0: 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 72 65  (test-runner-cre
7bc0: 61 74 65 29 29 29 0a 09 20 20 20 20 20 20 28 74  ate)))..      (t
7bd0: 65 73 74 2d 77 69 74 68 2d 72 75 6e 6e 65 72 20  est-with-runner 
7be0: 72 20 28 61 70 70 6c 79 20 74 65 73 74 2d 61 70  r (apply test-ap
7bf0: 70 6c 79 20 66 69 72 73 74 20 72 65 73 74 29 29  ply first rest))
7c00: 0a 09 20 20 20 20 20 20 28 28 74 65 73 74 2d 72  ..      ((test-r
7c10: 75 6e 6e 65 72 2d 6f 6e 2d 66 69 6e 61 6c 20 72  unner-on-final r
7c20: 29 20 72 29 29 29 29 29 29 0a 0a 28 64 65 66 69  ) r))))))..(defi
7c30: 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 77  ne-syntax test-w
7c40: 69 74 68 2d 72 75 6e 6e 65 72 0a 20 20 28 73 79  ith-runner.  (sy
7c50: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
7c60: 20 20 28 28 74 65 73 74 2d 77 69 74 68 2d 72 75    ((test-with-ru
7c70: 6e 6e 65 72 20 72 75 6e 6e 65 72 20 66 6f 72 6d  nner runner form
7c80: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 6c 65 74 20   ...).     (let 
7c90: 28 28 73 61 76 65 64 2d 72 75 6e 6e 65 72 20 28  ((saved-runner (
7ca0: 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63 75 72 72  test-runner-curr
7cb0: 65 6e 74 29 29 29 0a 20 20 20 20 20 20 20 28 64  ent))).       (d
7cc0: 79 6e 61 6d 69 63 2d 77 69 6e 64 0a 20 20 20 20  ynamic-wind.    
7cd0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28         (lambda (
7ce0: 29 20 28 74 65 73 74 2d 72 75 6e 6e 65 72 2d 63  ) (test-runner-c
7cf0: 75 72 72 65 6e 74 20 72 75 6e 6e 65 72 29 29 0a  urrent runner)).
7d00: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62             (lamb
7d10: 64 61 20 28 29 20 66 6f 72 6d 20 2e 2e 2e 29 0a  da () form ...).
7d20: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62             (lamb
7d30: 64 61 20 28 29 20 28 74 65 73 74 2d 72 75 6e 6e  da () (test-runn
7d40: 65 72 2d 63 75 72 72 65 6e 74 20 73 61 76 65 64  er-current saved
7d50: 2d 72 75 6e 6e 65 72 29 29 29 29 29 29 29 0a 0a  -runner)))))))..
7d60: 3b 3b 3b 20 50 72 65 64 69 63 61 74 65 73 0a 0a  ;;; Predicates..
7d70: 28 64 65 66 69 6e 65 20 28 25 74 65 73 74 2d 6d  (define (%test-m
7d80: 61 74 63 68 2d 6e 74 68 20 6e 20 63 6f 75 6e 74  atch-nth n count
7d90: 29 0a 20 20 28 6c 65 74 20 28 28 69 20 30 29 29  ).  (let ((i 0))
7da0: 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75  .    (lambda (ru
7db0: 6e 6e 65 72 29 0a 20 20 20 20 20 20 28 73 65 74  nner).      (set
7dc0: 21 20 69 20 28 2b 20 69 20 31 29 29 0a 20 20 20  ! i (+ i 1)).   
7dd0: 20 20 20 28 61 6e 64 20 28 3e 3d 20 69 20 6e 29     (and (>= i n)
7de0: 20 28 3c 20 69 20 28 2b 20 6e 20 63 6f 75 6e 74   (< i (+ n count
7df0: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d  ))))))..(define-
7e00: 73 79 6e 74 61 78 20 74 65 73 74 2d 6d 61 74 63  syntax test-matc
7e10: 68 2d 6e 74 68 0a 20 20 28 73 79 6e 74 61 78 2d  h-nth.  (syntax-
7e20: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 74  rules ().    ((t
7e30: 65 73 74 2d 6d 61 74 63 68 2d 6e 74 68 20 6e 29  est-match-nth n)
7e40: 0a 20 20 20 20 20 28 74 65 73 74 2d 6d 61 74 63  .     (test-matc
7e50: 68 2d 6e 74 68 20 6e 20 31 29 29 0a 20 20 20 20  h-nth n 1)).    
7e60: 28 28 74 65 73 74 2d 6d 61 74 63 68 2d 6e 74 68  ((test-match-nth
7e70: 20 6e 20 63 6f 75 6e 74 29 0a 20 20 20 20 20 28   n count).     (
7e80: 25 74 65 73 74 2d 6d 61 74 63 68 2d 6e 74 68 20  %test-match-nth 
7e90: 6e 20 63 6f 75 6e 74 29 29 29 29 0a 0a 28 64 65  n count))))..(de
7ea0: 66 69 6e 65 20 28 25 74 65 73 74 2d 6d 61 74 63  fine (%test-matc
7eb0: 68 2d 61 6c 6c 20 2e 20 70 72 65 64 2d 6c 69 73  h-all . pred-lis
7ec0: 74 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 72 75  t).  (lambda (ru
7ed0: 6e 6e 65 72 29 0a 20 20 20 20 28 6c 65 74 20 28  nner).    (let (
7ee0: 28 72 65 73 75 6c 74 20 23 74 29 29 0a 20 20 20  (result #t)).   
7ef0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c     (let loop ((l
7f00: 20 70 72 65 64 2d 6c 69 73 74 29 29 0a 09 28 69   pred-list))..(i
7f10: 66 20 28 6e 75 6c 6c 3f 20 6c 29 0a 09 20 20 20  f (null? l)..   
7f20: 20 72 65 73 75 6c 74 0a 09 20 20 20 20 28 62 65   result..    (be
7f30: 67 69 6e 0a 09 20 20 20 20 20 20 28 69 66 20 28  gin..      (if (
7f40: 6e 6f 74 20 28 28 63 61 72 20 6c 29 20 72 75 6e  not ((car l) run
7f50: 6e 65 72 29 29 0a 09 09 20 20 28 73 65 74 21 20  ner))...  (set! 
7f60: 72 65 73 75 6c 74 20 23 66 29 29 0a 09 20 20 20  result #f))..   
7f70: 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 6c 29     (loop (cdr l)
7f80: 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66 69  ))))))).  .(defi
7f90: 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d 6d  ne-syntax test-m
7fa0: 61 74 63 68 2d 61 6c 6c 0a 20 20 28 73 79 6e 74  atch-all.  (synt
7fb0: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
7fc0: 28 28 74 65 73 74 2d 6d 61 74 63 68 2d 61 6c 6c  ((test-match-all
7fd0: 20 70 72 65 64 20 2e 2e 2e 29 0a 20 20 20 20 20   pred ...).     
7fe0: 28 25 74 65 73 74 2d 6d 61 74 63 68 2d 61 6c 6c  (%test-match-all
7ff0: 20 28 25 74 65 73 74 2d 61 73 2d 73 70 65 63 69   (%test-as-speci
8000: 66 69 65 72 20 70 72 65 64 29 20 2e 2e 2e 29 29  fier pred) ...))
8010: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 74 65  ))..(define (%te
8020: 73 74 2d 6d 61 74 63 68 2d 61 6e 79 20 2e 20 70  st-match-any . p
8030: 72 65 64 2d 6c 69 73 74 29 0a 20 20 28 6c 61 6d  red-list).  (lam
8040: 62 64 61 20 28 72 75 6e 6e 65 72 29 0a 20 20 20  bda (runner).   
8050: 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 23   (let ((result #
8060: 66 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c  f)).      (let l
8070: 6f 6f 70 20 28 28 6c 20 70 72 65 64 2d 6c 69 73  oop ((l pred-lis
8080: 74 29 29 0a 09 28 69 66 20 28 6e 75 6c 6c 3f 20  t))..(if (null? 
8090: 6c 29 0a 09 20 20 20 20 72 65 73 75 6c 74 0a 09  l)..    result..
80a0: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20      (begin..    
80b0: 20 20 28 69 66 20 28 28 63 61 72 20 6c 29 20 72    (if ((car l) r
80c0: 75 6e 6e 65 72 29 0a 09 09 20 20 28 73 65 74 21  unner)...  (set!
80d0: 20 72 65 73 75 6c 74 20 23 74 29 29 0a 09 20 20   result #t))..  
80e0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 6c      (loop (cdr l
80f0: 29 29 29 29 29 29 29 29 0a 20 20 0a 28 64 65 66  )))))))).  .(def
8100: 69 6e 65 2d 73 79 6e 74 61 78 20 74 65 73 74 2d  ine-syntax test-
8110: 6d 61 74 63 68 2d 61 6e 79 0a 20 20 28 73 79 6e  match-any.  (syn
8120: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
8130: 20 28 28 74 65 73 74 2d 6d 61 74 63 68 2d 61 6e   ((test-match-an
8140: 79 20 70 72 65 64 20 2e 2e 2e 29 0a 20 20 20 20  y pred ...).    
8150: 20 28 25 74 65 73 74 2d 6d 61 74 63 68 2d 61 6e   (%test-match-an
8160: 79 20 28 25 74 65 73 74 2d 61 73 2d 73 70 65 63  y (%test-as-spec
8170: 69 66 69 65 72 20 70 72 65 64 29 20 2e 2e 2e 29  ifier pred) ...)
8180: 29 29 29 0a 0a 3b 3b 20 43 6f 65 72 63 65 20 74  )))..;; Coerce t
8190: 6f 20 61 20 70 72 65 64 69 63 61 74 65 20 66 75  o a predicate fu
81a0: 6e 63 74 69 6f 6e 3a 0a 28 64 65 66 69 6e 65 20  nction:.(define 
81b0: 28 25 74 65 73 74 2d 61 73 2d 73 70 65 63 69 66  (%test-as-specif
81c0: 69 65 72 20 73 70 65 63 69 66 69 65 72 29 0a 20  ier specifier). 
81d0: 20 28 63 6f 6e 64 20 28 28 70 72 6f 63 65 64 75   (cond ((procedu
81e0: 72 65 3f 20 73 70 65 63 69 66 69 65 72 29 20 73  re? specifier) s
81f0: 70 65 63 69 66 69 65 72 29 0a 09 28 28 69 6e 74  pecifier)..((int
8200: 65 67 65 72 3f 20 73 70 65 63 69 66 69 65 72 29  eger? specifier)
8210: 20 28 74 65 73 74 2d 6d 61 74 63 68 2d 6e 74 68   (test-match-nth
8220: 20 31 20 73 70 65 63 69 66 69 65 72 29 29 0a 09   1 specifier))..
8230: 28 28 73 74 72 69 6e 67 3f 20 73 70 65 63 69 66  ((string? specif
8240: 69 65 72 29 20 28 74 65 73 74 2d 6d 61 74 63 68  ier) (test-match
8250: 2d 6e 61 6d 65 20 73 70 65 63 69 66 69 65 72 29  -name specifier)
8260: 29 0a 09 28 65 6c 73 65 0a 09 20 28 65 72 72 6f  )..(else.. (erro
8270: 72 20 22 6e 6f 74 20 61 20 76 61 6c 69 64 20 74  r "not a valid t
8280: 65 73 74 20 73 70 65 63 69 66 69 65 72 22 29 29  est specifier"))
8290: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74  ))..(define-synt
82a0: 61 78 20 74 65 73 74 2d 73 6b 69 70 0a 20 20 28  ax test-skip.  (
82b0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a  syntax-rules ().
82c0: 20 20 20 20 28 28 74 65 73 74 2d 73 6b 69 70 20      ((test-skip 
82d0: 70 72 65 64 20 2e 2e 2e 29 0a 20 20 20 20 20 28  pred ...).     (
82e0: 6c 65 74 20 28 28 72 75 6e 6e 65 72 20 28 74 65  let ((runner (te
82f0: 73 74 2d 72 75 6e 6e 65 72 2d 67 65 74 29 29 29  st-runner-get)))
8300: 0a 20 20 20 20 20 20 20 28 25 74 65 73 74 2d 72  .       (%test-r
8310: 75 6e 6e 65 72 2d 73 6b 69 70 2d 6c 69 73 74 21  unner-skip-list!
8320: 20 72 75 6e 6e 65 72 0a 09 09 09 09 20 20 28 63   runner.....  (c
8330: 6f 6e 73 20 28 74 65 73 74 2d 6d 61 74 63 68 2d  ons (test-match-
8340: 61 6c 6c 20 28 25 74 65 73 74 2d 61 73 2d 73 70  all (%test-as-sp
8350: 65 63 69 66 69 65 72 20 70 72 65 64 29 20 20 2e  ecifier pred)  .
8360: 2e 2e 29 0a 09 09 09 09 09 28 25 74 65 73 74 2d  ..)......(%test-
8370: 72 75 6e 6e 65 72 2d 73 6b 69 70 2d 6c 69 73 74  runner-skip-list
8380: 20 72 75 6e 6e 65 72 29 29 29 29 29 29 29 0a 0a   runner)))))))..
8390: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 74  (define-syntax t
83a0: 65 73 74 2d 65 78 70 65 63 74 2d 66 61 69 6c 0a  est-expect-fail.
83b0: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20    (syntax-rules 
83c0: 28 29 0a 20 20 20 20 28 28 74 65 73 74 2d 65 78  ().    ((test-ex
83d0: 70 65 63 74 2d 66 61 69 6c 20 70 72 65 64 20 2e  pect-fail pred .
83e0: 2e 2e 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28  ..).     (let ((
83f0: 72 75 6e 6e 65 72 20 28 74 65 73 74 2d 72 75 6e  runner (test-run
8400: 6e 65 72 2d 67 65 74 29 29 29 0a 20 20 20 20 20  ner-get))).     
8410: 20 20 28 25 74 65 73 74 2d 72 75 6e 6e 65 72 2d    (%test-runner-
8420: 66 61 69 6c 2d 6c 69 73 74 21 20 72 75 6e 6e 65  fail-list! runne
8430: 72 0a 09 09 09 09 20 20 28 63 6f 6e 73 20 28 74  r.....  (cons (t
8440: 65 73 74 2d 6d 61 74 63 68 2d 61 6c 6c 20 28 25  est-match-all (%
8450: 74 65 73 74 2d 61 73 2d 73 70 65 63 69 66 69 65  test-as-specifie
8460: 72 20 70 72 65 64 29 20 20 2e 2e 2e 29 0a 09 09  r pred)  ...)...
8470: 09 09 09 28 25 74 65 73 74 2d 72 75 6e 6e 65 72  ...(%test-runner
8480: 2d 66 61 69 6c 2d 6c 69 73 74 20 72 75 6e 6e 65  -fail-list runne
8490: 72 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e  r)))))))..(defin
84a0: 65 20 28 74 65 73 74 2d 6d 61 74 63 68 2d 6e 61  e (test-match-na
84b0: 6d 65 20 6e 61 6d 65 29 0a 20 20 28 6c 61 6d 62  me name).  (lamb
84c0: 64 61 20 28 72 75 6e 6e 65 72 29 0a 20 20 20 20  da (runner).    
84d0: 28 65 71 75 61 6c 3f 20 6e 61 6d 65 20 28 74 65  (equal? name (te
84e0: 73 74 2d 72 75 6e 6e 65 72 2d 74 65 73 74 2d 6e  st-runner-test-n
84f0: 61 6d 65 20 72 75 6e 6e 65 72 29 29 29 29 0a 0a  ame runner))))..
8500: 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 72 65  (define (test-re
8510: 61 64 2d 65 76 61 6c 2d 73 74 72 69 6e 67 20 73  ad-eval-string s
8520: 74 72 69 6e 67 29 0a 20 20 28 6c 65 74 2a 20 28  tring).  (let* (
8530: 28 70 6f 72 74 20 28 6f 70 65 6e 2d 69 6e 70 75  (port (open-inpu
8540: 74 2d 73 74 72 69 6e 67 20 73 74 72 69 6e 67 29  t-string string)
8550: 29 0a 09 20 28 66 6f 72 6d 20 28 72 65 61 64 20  ).. (form (read 
8560: 70 6f 72 74 29 29 29 0a 20 20 20 20 28 69 66 20  port))).    (if 
8570: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 28 72 65  (eof-object? (re
8580: 61 64 2d 63 68 61 72 20 70 6f 72 74 29 29 0a 09  ad-char port))..
8590: 28 65 76 61 6c 20 66 6f 72 6d 29 0a 09 28 63 6f  (eval form)..(co
85a0: 6e 64 2d 65 78 70 61 6e 64 0a 09 20 28 73 72 66  nd-expand.. (srf
85b0: 69 2d 32 33 20 28 65 72 72 6f 72 20 22 28 6e 6f  i-23 (error "(no
85c0: 74 20 61 74 20 65 6f 66 29 22 29 29 0a 09 20 28  t at eof)")).. (
85d0: 65 6c 73 65 20 22 65 72 72 6f 72 22 29 29 29 29  else "error"))))
85e0: 29 0a 0a                                         )..