~ chicken-core (master) /tests/test-optional.scm

  1;;;; test-optional.scm - by Alan Post
  2
  3
  4(define (test baseline result)
  5  (assert (equal? baseline result)))
  6
  7;;
  8;; basic optional arguments with default value.
  9;;
 10
 11(define (foo0 #!optional a0 a1 a2 a3)
 12  (list a0 a1 a2 a3))
 13
 14(define (foo1 a0 #!optional a1 a2 a3)
 15  (list a0 a1 a2 a3))
 16
 17(define (foo2 a0 a1 #!optional a2 a3)
 18  (list a0 a1 a2 a3))
 19
 20(define (foo3 a0 a1 a2 #!optional a3)
 21  (list a0 a1 a2 a3))
 22
 23(test '(#f #f #f #f) (foo0))
 24(test '(1  #f #f #f) (foo0 1))
 25(test '(1  2  #f #f) (foo0 1 2))
 26(test '(1  2   3 #f) (foo0 1 2 3))
 27(test '(1  2   3  4) (foo0 1 2 3 4))
 28
 29;(test '(#f #f #f #f) (foo1)) ; invalid, too few arguments.
 30(test '(1  #f #f #f) (foo1 1))
 31(test '(1  2  #f #f) (foo1 1 2))
 32(test '(1  2   3 #f) (foo1 1 2 3))
 33(test '(1  2   3  4) (foo1 1 2 3 4))
 34
 35;(test '(#f #f #f #f) (foo2)) ; invalid, too few arguments.
 36;(test '(1 #f  #f #f) (foo2 0)) ; invalid, too few arguments.
 37(test '(1  2  #f #f) (foo2 1 2))
 38(test '(1  2  #f #f) (foo2 1 2))
 39(test '(1  2   3 #f) (foo2 1 2 3))
 40(test '(1  2   3  4) (foo2 1 2 3 4))
 41
 42;(test '(#f #f #f #f) (foo3)) ; invalid, too few arguments.
 43;(test '(1  #f #f #f) (foo3 1)) ; invalid, too few arguments.
 44;(test '(1  2  #f #f) (foo3 1 2)) ; invalid, too few arguments.
 45(test '(1  2   3 #f) (foo3 1 2 3))
 46(test '(1  2   3  4) (foo3 1 2 3 4))
 47
 48;;
 49;; basic optional arguments with manual default value.
 50;;
 51
 52(define (foo0 #!optional (a0 -1) (a1 -2) (a2 -3) (a3 -4))
 53  (list a0 a1 a2 a3))
 54
 55(define (foo1 a0 #!optional (a1 -2) (a2 -3) (a3 -4))
 56  (list a0 a1 a2 a3))
 57
 58(define (foo2 a0 a1 #!optional (a2 -3) (a3 -4))
 59  (list a0 a1 a2 a3))
 60
 61(define (foo3 a0 a1 a2 #!optional (a3 -4))
 62  (list a0 a1 a2 a3))
 63
 64
 65(test '(-1 -2 -3 -4) (foo0))
 66(test '(1  -2 -3 -4) (foo0 1))
 67(test '(1  2  -3 -4) (foo0 1 2))
 68(test '(1  2   3 -4) (foo0 1 2 3))
 69(test '(1  2   3  4) (foo0 1 2 3 4))
 70
 71;(test '(-1 -2 -3 -4) (foo1)) ; invalid, too few arguments.
 72(test '(1  -2 -3 -4) (foo1 1))
 73(test '(1  2  -3 -4) (foo1 1 2))
 74(test '(1  2   3 -4) (foo1 1 2 3))
 75(test '(1  2   3  4) (foo1 1 2 3 4))
 76
 77;(test '(-1 -2 -3 -4) (foo2)) ; invalid, too few arguments.
 78;(test '(1 -2  -3 -4) (foo2 0)) ; invalid, too few arguments.
 79(test '(1  2  -3 -4) (foo2 1 2))
 80(test '(1  2  -3 -4) (foo2 1 2))
 81(test '(1  2   3 -4) (foo2 1 2 3))
 82(test '(1  2   3  4) (foo2 1 2 3 4))
 83
 84;(test '(-1 -2 -3 -4) (foo3)) ; invalid, too few arguments.
 85;(test '(1  -2 -3 -4) (foo3 1)) ; invalid, too few arguments.
 86;(test '(1  2  -3 -4) (foo3 1 2)) ; invalid, too few arguments.
 87(test '(1  2   3 -4) (foo3 1 2 3))
 88(test '(1  2   3  4) (foo3 1 2 3 4))
 89
 90;;
 91;; optional arguments with default value set from previous default.
 92;;
 93;; NOTE: these currently fail.
 94
 95(define (foo0 #!optional (a0 -1) (a1 (- a0 1)) (a2 (- a1 1)) (a3 (- a2 1)))
 96  (list a0 a1 a2 a3))
 97
 98(define (foo1 a0 #!optional (a1 -2) (a2 (- a1 1)) (a3 (- a2 1)))
 99  (list a0 a1 a2 a3))
100
101(define (foo2 a0 a1 #!optional (a2 -3) (a3 (- a2 1)))
102  (list a0 a1 a2 a3))
103
104(define (foo3 a0 a1 a2 #!optional (a3 -4))
105  (list a0 a1 a2 a3))
106
107
108(test '(-1 -2 -3 -4) (foo0))
109(test '(1  0 -1 -2) (foo0 1))
110(test '(1  2  1  0) (foo0 1 2))
111(test '(1  2  3  2) (foo0 1 2 3))
112(test '(1  2  3  4) (foo0 1 2 3 4))
113
114;(test '(-1 -2 -3 -4) (foo1)) ; invalid, too few arguments.
115(test '(1  -2 -3 -4) (foo1 1))
116(test '(1  2  1  0) (foo1 1 2))
117(test '(1  2  3  2) (foo1 1 2 3))
118(test '(1  2  3  4) (foo1 1 2 3 4))
119
120;(test '(-1 -2 -3 -4) (foo2)) ; invalid, too few arguments.
121;(test '(1 -2  -3 -4) (foo2 0)) ; invalid, too few arguments.
122(test '(1  2  -3 -4) (foo2 1 2))
123(test '(1  2   3  2) (foo2 1 2 3))
124(test '(1  2   3  4) (foo2 1 2 3 4))
125
126;(test '(-1 -2 -3 -4) (foo3)) ; invalid, too few arguments.
127;(test '(1  -2 -3 -4) (foo3 1)) ; invalid, too few arguments.
128;(test '(1  2  -3 -4) (foo3 1 2)) ; invalid, too few arguments.
129(test '(1  2   3 -4) (foo3 1 2 3))
130(test '(1  2   3  4) (foo3 1 2 3 4))