* added tests for procedure "for-all"

This commit is contained in:
Abdulaziz Ghuloum 2007-10-10 05:28:07 -04:00
parent 82eb606715
commit 995944723d
6 changed files with 27 additions and 13 deletions

Binary file not shown.

View File

@ -2340,7 +2340,7 @@
(define eval-core
(lambda (x) ((compile-core-expr x))))
(include "libaltcogen.ss")
(include "ikarus.compiler.altcogen.ss")
(define current-primitive-locations
(let ([plocs (lambda (x) #f)])

View File

@ -2,10 +2,11 @@
(import (ikarus)
(tests reader)
(tests lists)
(tests bytevectors)
(tests strings)
(tests numbers)
(tests bignums)
;(tests numbers)
;(tests bignums)
(tests fxcarry)
(tests bignum-to-flonum)
(tests string-to-number))
@ -29,7 +30,8 @@
(test-exact-integer-sqrt)
(test-bignum-to-flonum)
(test-string-to-number)
(test-div-and-mod)
(test-bignums)
;(test-div-and-mod)
;(test-bignums)
(test-fxcarry)
(test-lists)
(printf "Happy Happy Joy Joy\n")

19
src/tests/lists.ss Normal file
View File

@ -0,0 +1,19 @@
(library (tests lists)
(export test-lists)
(import (ikarus) (tests framework))
(define-tests test-lists
[values (equal? (for-all even? '(1 2 3 4)) #f)]
[values (equal? (for-all even? '(10 12 14 16)) #t)]
[values (equal? (for-all even? '(2 3 4)) #f)]
[values (equal? (for-all even? '(12 14 16)) #t)]
[values (equal? (for-all (lambda (x) x) '(12 14 16)) 16)]
[values (equal? (for-all (lambda (x) x) '(12 14)) 14)]
[values (equal? (for-all (lambda (x) x) '(12)) 12)]
[values (equal? (for-all (lambda (x) x) '()) #t)]
[values (equal? (for-all even? '(13 . 14)) #f)]
[values (equal? (for-all cons '(1 2 3) '(a b c)) '(3 . c))]
[values (equal? (for-all (lambda (a b) (= a 1)) '(1 2 3) '(a b c)) #f)]
[values (equal? (for-all (lambda (a b) (= a 1)) '(1 2) '(a b c)) #f)]
))

View File

@ -21,7 +21,7 @@
[(or (fx= i n) (memv (string-ref str i) '(#\; #\#))) i]
[else (find-semi/hash str (+ i 1) n)]))
(define (cleanup^ str)
(define (cleanup str)
(let ([lo
(let f ([i 0] [n (string-length str)])
(cond
@ -40,13 +40,6 @@
(substring str lo hi)
"")))
(define (cleanup str)
(let ([s (cleanup^ str)])
(when
(and (= (string-length str) 1)
(not (= (string-length s) 1)))
(error 'cleanup "duuh ~s ~s" s str))
s))
(define (split str)
(let f ([i 0] [n (string-length str)])