guile-vocabulary-explorer/lib/contracts/test.log

%%%% Starting test test
Group begin: test
Group begin: ck-base
Test begin:
  test-name: "c-cons conses a number onto every sublist"
  source-file: "test.scm"
  source-line: 21
  source-form: (test-equal "c-cons conses a number onto every sublist" (quote ((10 1) (10 2))) (ck () (c-quote (c-map (quote (c-cons (quote 10))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: ((10 1) (10 2))
  expected-value: ((10 1) (10 2))
Test begin:
  test-name: "c-cons conses a + onto every sublist"
  source-file: "test.scm"
  source-line: 28
  source-form: (test-equal "c-cons conses a + onto every sublist" (quote ((+ 1) (+ 2))) (ck () (c-quote (c-map (quote (c-cons (quote +))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: ((+ 1) (+ 2))
  expected-value: ((+ 1) (+ 2))
Test begin:
  test-name: "c-cons conses a function onto a list to make a function call"
  source-file: "test.scm"
  source-line: 35
  source-form: (test-eqv "c-cons conses a function onto a list to make a function call" 3 (ck () (c-cons (quote +) (quote (1 2)))))
Test end:
  result-kind: pass
  actual-value: 3
  expected-value: 3
Test begin:
  test-name: "c-map maps to all elements of a list - 1"
  source-file: "test.scm"
  source-line: 39
  source-form: (test-equal "c-map maps to all elements of a list - 1" (quote ((10 1) (10 2))) (ck () (c-quote (c-map (quote (c-cons (quote 10))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: ((10 1) (10 2))
  expected-value: ((10 1) (10 2))
Test begin:
  test-name: "c-map maps to all elements of a list - 2"
  source-file: "test.scm"
  source-line: 46
  source-form: (test-equal "c-map maps to all elements of a list - 2" (quote ((+ 1) (+ 2))) (ck () (c-quote (c-map (quote (c-cons (quote +))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: ((+ 1) (+ 2))
  expected-value: ((+ 1) (+ 2))
Test begin:
  test-name: "c-map maps to all elements of a list - 3"
  source-file: "test.scm"
  source-line: 53
  source-form: (test-equal "c-map maps to all elements of a list - 3" (quote (((lambda (elem) (+ elem 1)) 1) ((lambda (elem) (+ elem 1)) 2))) (ck () (c-quote (c-map (quote (c-cons (quote (lambda (elem) (+ elem 1))))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: (((lambda (elem) (+ elem 1)) 1) ((lambda (elem) (+ elem 1)) 2))
  expected-value: (((lambda (elem) (+ elem 1)) 1) ((lambda (elem) (+ elem 1)) 2))
Test begin:
  test-name: "c-apply applies procedure to list of arguments - 1"
  source-file: "test.scm"
  source-line: 63
  source-form: (test-equal "c-apply applies procedure to list of arguments - 1" 5 (ck () (c-apply (quote +) (c-map (quote (c-cons (quote (lambda (elem) (+ elem 1))))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: 5
  expected-value: 5
Test begin:
  test-name: "c-apply applies procedure to list of arguments - 2"
  source-file: "test.scm"
  source-line: 70
  source-form: (test-equal "c-apply applies procedure to list of arguments - 2" 6 (let ((result 3)) (ck () (c-replace-placeholder (quote result) (quote (apply + (list 1 2 <?>)))))))
Test end:
  result-kind: pass
  actual-value: 6
  expected-value: 6
Test begin:
  test-name: "c-quote quotes things"
  source-file: "test.scm"
  source-line: 77
  source-form: (test-equal "c-quote quotes things" (quote ((anything 1) (anything 2))) (ck () (c-quote (c-map (quote (c-cons (quote anything))) (quote ((1) (2)))))))
Test end:
  result-kind: pass
  actual-value: ((anything 1) (anything 2))
  expected-value: ((anything 1) (anything 2))
Test begin:
  test-name: "c-unquote unquotes things"
  source-file: "test.scm"
  source-line: 84
  source-form: (test-equal "c-unquote unquotes things" (quote x) (ck () (c-unquote (quote (quote x)))))
Test end:
  result-kind: pass
  actual-value: x
  expected-value: x
Group end: ck-base
Group begin: ck-extra
Test begin:
  test-name: "c-and-raise raises a contract violation for a trivial case."
  source-file: "test.scm"
  source-line: 93
  source-form: (test-assert "c-and-raise raises a contract violation for a trivial case." (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn)) #t)) (ck () (c-and-raise (quote "unknown origin") (quote (list (= 1 1) (= 2 3)))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "c-and-raise does not raise an exception when all expressions are true."
  source-file: "test.scm"
  source-line: 109
  source-form: (test-assert "c-and-raise does not raise an exception when all expressions are true." (ck () (c-and-raise (quote "unknown origin") (quote (list (= 1 1))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "c-replace-placeholder replaces the placeholder in a simple expression"
  source-file: "test.scm"
  source-line: 115
  source-form: (test-eqv "c-replace-placeholder replaces the placeholder in a simple expression" 6 (let ((result 3)) (ck () (c-replace-placeholder (quote result) (quote (+ 1 2 <?>))))))
Test end:
  result-kind: pass
  actual-value: 6
  expected-value: 6
Test begin:
  test-name: "c-replace-placeholder replaces the placeholder in a list"
  source-file: "test.scm"
  source-line: 123
  source-form: (test-equal "c-replace-placeholder replaces the placeholder in a list" (quote (1 2 3)) (let ((result 3)) (ck () (c-replace-placeholder (quote result) (quote (list 1 2 <?>))))))
Test end:
  result-kind: pass
  actual-value: (1 2 3)
  expected-value: (1 2 3)
Test begin:
  test-name: "c-replace-placeholder replaces the placeholder in a compound expression"
  source-file: "test.scm"
  source-line: 131
  source-form: (test-equal "c-replace-placeholder replaces the placeholder in a compound expression" (quote (1 2 3)) (let ((result 7)) (ck () (c-replace-placeholder (quote result) (quote (list 1 2 (vector-index (λ (elem) (= elem <?>)) (vector 4 5 6 7 8))))))))
Test end:
  result-kind: pass
  actual-value: (1 2 3)
  expected-value: (1 2 3)
Test begin:
  test-name: "c-replace-placeholder replaces the placeholder multiple times in a compound expression"
  source-file: "test.scm"
  source-line: 143
  source-form: (test-equal "c-replace-placeholder replaces the placeholder multiple times in a compound expression" (quote (1 2 7 3)) (let ((result 7)) (ck () (c-replace-placeholder (quote result) (quote (list 1 2 <?> (vector-index (λ (elem) (= elem <?>)) (vector 4 5 6 7 8))))))))
Test end:
  result-kind: pass
  actual-value: (1 2 7 3)
  expected-value: (1 2 7 3)
Test begin:
  test-name: "c-list->vector converts a list to a vector - 1"
  source-file: "test.scm"
  source-line: 156
  source-form: (test-equal "c-list->vector converts a list to a vector - 1" (vector 1 2 3) (ck () (c-list->vector (quote (list 1 2 3)))))
Test end:
  result-kind: pass
  actual-value: #(1 2 3)
  expected-value: #(1 2 3)
Test begin:
  test-name: "c-list->vector converts a list to a vector - 2"
  source-file: "test.scm"
  source-line: 161
  source-form: (test-equal "c-list->vector converts a list to a vector - 2" (vector 1 2 3) (ck () (c-list->vector (quote (quote (1 2 3))))))
Test end:
  result-kind: pass
  actual-value: #(1 2 3)
  expected-value: #(1 2 3)
Test begin:
  test-name: "c-vector->list converts a vector to a list - 1"
  source-file: "test.scm"
  source-line: 166
  source-form: (test-equal "c-vector->list converts a vector to a list - 1" (list 1 2 3) (ck () (c-vector->list (quote (vector 1 2 3)))))
Test end:
  result-kind: pass
  actual-value: (1 2 3)
  expected-value: (1 2 3)
Test begin:
  test-name: "c-vector->list converts a vector to a list - 2"
  source-file: "test.scm"
  source-line: 171
  source-form: (test-equal "c-vector->list converts a vector to a list - 2" (list 1 2 3) (ck () (c-vector->list (quote #(1 2 3)))))
Test end:
  result-kind: pass
  actual-value: (1 2 3)
  expected-value: (1 2 3)
Group end: ck-extra
Group begin: contract
Group begin: lambda*-with-contract
Test begin:
  test-name: "lambda*-with-contract - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 179
  source-form: (test-equal "lambda*-with-contract - contract does not raise an exception when not violated" "00234" ((lambda*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-char padding-length) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (cond ((< counter len-diff) (display padding-char port) (iter (+ counter 1))) (else (display num-as-str port))))))) (else num-as-str)))) 234 #\0 5))
Test end:
  result-kind: pass
  actual-value: "00234"
  expected-value: "00234"
Test begin:
  test-name: "lambda*-with-contract - raises when requirement violated"
  source-file: "test.scm"
  source-line: 206
  source-form: (test-assert "lambda*-with-contract - raises when requirement violated" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (integer? num)) (exception-irritants exn))) #t)) ((lambda*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-char padding-length) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (cond ((< counter len-diff) (display padding-char port) (iter (+ counter 1))) (else (display num-as-str port))))))) (else num-as-str)))) "234" #\0 5)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "lambda*-with-contract - raises when ensure violated"
  source-file: "test.scm"
  source-line: 247
  source-form: (test-assert "lambda*-with-contract - raises when ensure violated" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (>= (string-length result) padding-length)) (exception-irritants exn))) #t)) ((lambda*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-char padding-length) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (when (<= counter len-diff) (display padding-char port) (iter (+ counter 1))) (display num-as-str port))))) (else num-as-str)))) 234 #\0 5)))
Test end:
  result-kind: pass
  actual-value: "000234234234234"
Test begin:
  test-name: "lambda*-with-contract - works with optional args"
  source-file: "test.scm"
  source-line: 289
  source-form: (test-assert "lambda*-with-contract - works with optional args" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (char? padding-char)) (exception-irritants exn))) #t)) ((lambda*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-length #:optional (padding-char #\0)) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (when (< counter len-diff) (display padding-char port) (iter (+ counter 1))) (display num-as-str port))))) (else num-as-str)))) 234 5 "9")))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "lambda*-with-contract - works with keyword args"
  source-file: "test.scm"
  source-line: 327
  source-form: (test-assert "lambda*-with-contract - works with keyword args" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (char? padding-char)) (exception-irritants exn))) #t)) ((lambda*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-length #:key (padding-char #\0)) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (when (< counter len-diff) (display padding-char port) (iter (+ counter 1))) (display num-as-str port))))) (else num-as-str)))) 234 5 #:padding-char "9")))
Test end:
  result-kind: pass
  actual-value: #t
Group end: lambda*-with-contract
Group begin: lambda-with-contract
Test begin:
  test-name: "lambda-with-contract - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 366
  source-form: (test-eqv "lambda-with-contract - contract does not raise an exception when not violated" 7 ((lambda-with-contract (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance) (- account-balance amount)) 5 12))
Test end:
  result-kind: pass
  actual-value: 7
  expected-value: 7
Test begin:
  test-name: "lambda-with-contract - simple number contract works"
  source-file: "test.scm"
  source-line: 388
  source-form: (test-assert "lambda-with-contract - simple number contract works" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (<= amount account-balance)) (exception-irritants exn))) #t)) ((lambda-with-contract (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance) (- account-balance amount)) 100 90)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "lambda-with-contract - simple number contract works with negative numbers"
  source-file: "test.scm"
  source-line: 411
  source-form: (test-assert "lambda-with-contract - simple number contract works with negative numbers" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (string=? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (>= amount 0)) (exception-irritants exn))) #t)) ((lambda-with-contract (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance) (- account-balance amount)) -15 -10)))
Test end:
  result-kind: pass
  actual-value: #t
Group end: lambda-with-contract
Group begin: define-with-contract
Test begin:
  test-name: "define-with-contract - does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 435
  source-form: (test-eqv "define-with-contract - does not raise an exception when not violated" 7 (begin (define-with-contract account-withdraw (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (λ (amount account-balance) (- account-balance amount))) (account-withdraw 5 12)))
Test end:
  result-kind: pass
  actual-value: 7
  expected-value: 7
Test begin:
  test-name: "define-with-contract - simple number contract works"
  source-file: "test.scm"
  source-line: 446
  source-form: (test-assert "define-with-contract - simple number contract works" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw)) (exception-with-irritants? exn) (equal? (quote (<= amount account-balance)) (exception-irritants exn))) #t)) (begin (define-with-contract account-withdraw (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (λ (amount account-balance) (- account-balance amount))) (account-withdraw 100 90))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "define-with-contract - simple number contract works with negative numbers"
  source-file: "test.scm"
  source-line: 471
  source-form: (test-assert "define-with-contract - simple number contract works with negative numbers" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw)) (exception-with-irritants? exn) (equal? (quote (>= amount 0)) (exception-irritants exn))) #t)) (begin (define-with-contract account-withdraw (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (λ (amount account-balance) (- account-balance amount))) (account-withdraw -15 -10))))
Test end:
  result-kind: pass
  actual-value: #t
Group end: define-with-contract
Group begin: define*-with-contract
Test begin:
  test-name: "define*-with-contract - does not raise an exception when not violated - long form"
  source-file: "test.scm"
  source-line: 497
  source-form: (test-eqv "define*-with-contract - does not raise an exception when not violated - long form" 55 (begin (define*-with-contract account-withdraw (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance #:optional (fee 0) #:key (tip 10)) (- account-balance amount fee tip)) (account-withdraw 50 120 5 #:tip 10)))
Test end:
  result-kind: pass
  actual-value: 55
  expected-value: 55
Test begin:
  test-name: "define*-with-contract - does not raise an exception when not violated - short form"
  source-file: "test.scm"
  source-line: 511
  source-form: (test-eqv "define*-with-contract - does not raise an exception when not violated - short form" 55 (begin (define*-with-contract (account-withdraw amount account-balance #:optional (fee 0) #:key (tip 10)) (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (- account-balance amount fee tip)) (account-withdraw 50 120 5 #:tip 10)))
Test end:
  result-kind: pass
  actual-value: 55
  expected-value: 55
Test begin:
  test-name: "define*-with-contract - simple number contract works"
  source-file: "test.scm"
  source-line: 527
  source-form: (test-assert "define*-with-contract - simple number contract works" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw-extra)) (exception-with-irritants? exn) (equal? (quote (>= result 0)) (exception-irritants exn))) #t)) (begin (define*-with-contract account-withdraw-extra (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance #:optional (fee 0) #:key (tip 10)) (- account-balance amount fee tip)) (account-withdraw-extra 50 90 30 #:tip 15))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "define*-with-contract - number contract works with negative numbers"
  source-file: "test.scm"
  source-line: 555
  source-form: (test-assert "define*-with-contract - number contract works with negative numbers" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw-extra)) (exception-with-irritants? exn) (equal? (quote (>= result 0)) (exception-irritants exn))) #t)) (begin (define*-with-contract account-withdraw-extra (require (<= amount account-balance)) (ensure (>= <?> 0)) (amount account-balance #:optional (fee 0) #:key (tip 10)) (- account-balance amount fee tip)) (account-withdraw-extra -20 10 30 #:tip 1))))
Test end:
  result-kind: pass
  actual-value: #t
Group end: define*-with-contract
Group begin: lambda-aliases
Test begin:
  test-name: "λ*-with-contract - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 583
  source-form: (test-equal "λ*-with-contract - contract does not raise an exception when not violated" "00234" ((λ*-with-contract (require (integer? num) (char? padding-char) (integer? padding-length) (or (positive? padding-length) (zero? padding-length))) (ensure (string? <?>) (>= (string-length <?>) padding-length)) (num padding-char padding-length) (let* ((num-as-str (number->string num)) (len-diff (- padding-length (string-length num-as-str)))) (cond ((positive? len-diff) (call-with-output-string (λ (port) (let iter ((counter 0)) (cond ((< counter len-diff) (display padding-char port) (iter (+ counter 1))) (else (display num-as-str port))))))) (else num-as-str)))) 234 #\0 5))
Test end:
  result-kind: pass
  actual-value: "00234"
  expected-value: "00234"
Test begin:
  test-name: "λ-with-contract - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 610
  source-form: (test-eqv "λ-with-contract - contract does not raise an exception when not violated" 7 ((λ-with-contract (require (<= amount account-balance) (>= amount 0)) (ensure (>= <?> 0)) (amount account-balance) (- account-balance amount)) 5 12))
Test end:
  result-kind: pass
  actual-value: 7
  expected-value: 7
Group end: lambda-aliases
Group begin: rest-argument-definitions
Test begin:
  test-name: "define-with-contract - with rest args - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 620
  source-form: (test-equal "define-with-contract - with rest args - contract does not raise an exception when not violated" 5 (begin (define-with-contract account-withdraw (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance . other-fees) (apply - account-balance amount other-fees)) (account-withdraw 40 100 50 5)))
Test end:
  result-kind: pass
  actual-value: 5
  expected-value: 5
Test begin:
  test-name: "define*-with-contract - with rest args - contract does not raise an exception when not violated"
  source-file: "test.scm"
  source-line: 634
  source-form: (test-equal "define*-with-contract - with rest args - contract does not raise an exception when not violated" 10 (begin (define*-with-contract account-withdraw (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance #:optional (fee1 5) #:key (fee2 10) . other-fees) (apply - account-balance amount fee1 fee2 other-fees)) (account-withdraw 40 100 30 1 2 3 4)))
Test end:
  result-kind: pass
  actual-value: 10
  expected-value: 10
Test begin:
  test-name: "define*-with-contract - with rest args - raises for require violation"
  source-file: "test.scm"
  source-line: 653
  source-form: (test-assert "define*-with-contract - with rest args - raises for require violation" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw)) (exception-with-irritants? exn) (equal? (quote (<= amount account-balance)) (exception-irritants exn))) #t)) (begin (define*-with-contract account-withdraw (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance #:optional (fee1 5) #:key (fee2 10) . other-fees) (apply - account-balance amount fee1 fee2 other-fees)) (account-withdraw 400 100))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "define*-with-contract - with rest args - raises for ensure violation"
  source-file: "test.scm"
  source-line: 686
  source-form: (test-assert "define*-with-contract - with rest args - raises for ensure violation" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw)) (exception-with-irritants? exn) (equal? (quote (>= result 0)) (exception-irritants exn))) #t)) (begin (define*-with-contract account-withdraw (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance #:optional (fee1 5) #:key (fee2 10) . other-fees) (apply - account-balance amount fee1 fee2 200 other-fees)) (account-withdraw 50 100))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "define*-with-contract - with rest args - raises for violation of rest args"
  source-file: "test.scm"
  source-line: 720
  source-form: (test-assert "define*-with-contract - with rest args - raises for violation of rest args" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) (quote account-withdraw)) (exception-with-irritants? exn) (equal? (quote (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (exception-irritants exn))) #t)) (begin (define*-with-contract account-withdraw (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance #:optional (fee1 5) #:key (fee2 10) . other-fees) (apply - account-balance amount fee1 fee2 200 other-fees)) (account-withdraw 50 100 1 2 3 4 -5))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "lambda*-with-contract - with rest args - works"
  source-file: "test.scm"
  source-line: 757
  source-form: (test-assert "lambda*-with-contract - with rest args - works" (guard (exn ((and (contract-violated-exception? exn) (exception-with-message? exn) (string=? (exception-message exn) "contract violated") (exception-with-origin? exn) (eq? (exception-origin exn) "unknown origin") (exception-with-irritants? exn) (equal? (quote (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (exception-irritants exn))) #t)) ((lambda*-with-contract (require (<= amount account-balance) (fold (λ (current accumulated) (and accumulated current)) #t (map positive? other-fees))) (ensure (>= <?> 0)) (amount account-balance #:optional (fee1 5) #:key (fee2 10) . other-fees) (apply - account-balance amount other-fees)) 50 100 1 2 3 4 -5)))
Test end:
  result-kind: pass
  actual-value: #t
Group end: rest-argument-definitions
Group end: contract
Group end: test
# of expected passes      43