/[guile]/guile/guile-core/test-suite/tests/srfi-1.test
ViewVC logotype

Diff of /guile/guile-core/test-suite/tests/srfi-1.test

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by kryde, Tue Jul 8 00:13:06 2003 UTC revision 1.4 by kryde, Sun Jul 13 23:06:33 2003 UTC
# Line 322  Line 322 
322    (pass-if "'(a b . c) 2"    (pass-if "'(a b . c) 2"
323      (equal? '(a b)      (equal? '(a b)
324              (take '(a b . c) 2))))              (take '(a b . c) 2))))
325    
326    ;;
327    ;; partition
328    ;;
329    
330    (define (test-partition pred list kept-good dropped-good)
331      (call-with-values (lambda ()
332                            (partition pred list))
333          (lambda (kept dropped)
334            (and (equal? kept kept-good)
335                 (equal? dropped dropped-good)))))
336    
337    (with-test-prefix "partition"
338                      
339      (pass-if "with dropped tail"
340        (test-partition even? '(1 2 3 4 5 6 7)
341                        '(2 4 6) '(1 3 5 7)))
342    
343      (pass-if "with kept tail"
344        (test-partition even? '(1 2 3 4 5 6)
345                        '(2 4 6) '(1 3 5)))
346    
347      (pass-if "with everything dropped"
348        (test-partition even? '(1 3 5 7)
349                        '() '(1 3 5 7)))
350    
351      (pass-if "with everything kept"
352        (test-partition even? '(2 4 6)
353                        '(2 4 6) '()))
354    
355      (pass-if "with empty list"
356        (test-partition even? '()
357                        '() '()))
358    
359      (pass-if "with reasonably long list"
360        ;; the old implementation from SRFI-1 reference implementation
361        ;; would signal a stack-overflow for a list of only 500 elements!
362        (call-with-values (lambda ()
363                            (partition even?
364                                       (make-list 10000 1)))
365          (lambda (even odd)
366            (and (= (length odd) 10000)
367                 (= (length even) 0))))))
368    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26