mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

srfi-1 lset-difference!: move from C to Scheme

Browse source 
* libguile/srfi-1.c (scm_srfi1_lset-difference_x): delete.
* libguile/srfi-1.h (scm_srfi1_lset-difference_x): delete.
* module/srfi/srfi-1.scm: add lset-difference!.
* test-suite/tests/srfi-1.test: extend lset-difference! tests to cover
lset-difference.
This commit is contained in:
Rob Browning 2024-07-17 23:12:14 -05:00
parent 3eb6afe738
commit 945c97b14d
4 changed files with 71 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

102
test-suite/tests/srfi-1.test
View file

@ -1769,72 +1769,64 @@
(equal? '(1 2) (lset-adjoin = '(2) 1 1))))
;;
;; lset-difference
;; lset-difference and lset-difference!
;;
(with-test-prefix "lset-difference"
(begin
(define (test-shared-behavior diff)
(pass-if-exception "proc - num" exception:wrong-type-arg
(diff 123 '(4)))
(pass-if-exception "proc - list" exception:wrong-type-arg
(diff (list 1 2 3) '(4)))
(pass-if "called arg order"
(let ((good #f))
(lset-difference (lambda (x y)
(set! good (and (= x 1) (= y 2)))
(= x y))
'(1) '(2))
good)))
(pass-if "called arg order"
(let ((good #f))
(diff (lambda (x y)
(set! good (and (= x 1) (= y 2)))
(= x y))
(list 1) (list 2))
good))
;;
;; lset-difference!
;;
(pass-if (equal? '() (diff = '())))
(pass-if (equal? '(1) (diff = (list 1))))
(pass-if (equal? '(1 2) (diff = (list 1 2))))
(with-test-prefix "lset-difference!"
(pass-if (equal? '() (diff = (list ) '(3))))
(pass-if (equal? '() (diff = (list 3) '(3))))
(pass-if (equal? '(1) (diff = (list 1 3) '(3))))
(pass-if (equal? '(1) (diff = (list 3 1) '(3))))
(pass-if (equal? '(1) (diff = (list 1 3 3) '(3))))
(pass-if (equal? '(1) (diff = (list 3 1 3) '(3))))
(pass-if (equal? '(1) (diff = (list 3 3 1) '(3))))
(pass-if-exception "proc - num" exception:wrong-type-arg
(lset-difference! 123 '(4)))
(pass-if-exception "proc - list" exception:wrong-type-arg
(lset-difference! (list 1 2 3) '(4)))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(2 3))))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(3 2))))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(3) '(2))))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(3))))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(2 3))))
(pass-if (equal? '(1) (diff = (list 1 2 3) '(2) '(3 2))))
(pass-if "called arg order"
(let ((good #f))
(lset-difference! (lambda (x y)
(set! good (and (= x 1) (= y 2)))
(= x y))
(list 1) (list 2))
good))
(pass-if (equal? '(1 2) (diff = (list 1 2 3) '(3) '(3))))
(pass-if (equal? '(1 2) (diff = (list 1 3 2) '(3) '(3))))
(pass-if (equal? '(1 2) (diff = (list 3 1 2) '(3) '(3))))
(pass-if (equal? '() (lset-difference! = '())))
(pass-if (equal? '(1) (lset-difference! = (list 1))))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 2))))
(pass-if (equal? '(1 2 3) (diff = (list 1 2 3 4) '(4))))
(pass-if (equal? '(1 2 3) (diff = (list 1 2 4 3) '(4))))
(pass-if (equal? '(1 2 3) (diff = (list 1 4 2 3) '(4))))
(pass-if (equal? '(1 2 3) (diff = (list 4 1 2 3) '(4))))
(pass-if (equal? '() (lset-difference! = (list ) '(3))))
(pass-if (equal? '() (lset-difference! = (list 3) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 1 3) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 3 1) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 1 3 3) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 3 1 3) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 3 3 1) '(3))))
(pass-if (equal? '(1 2) (diff = (list 1 2 3 4) '(4) '(3))))
(pass-if (equal? '(1 2) (diff = (list 1 3 2 4) '(4) '(3))))
(pass-if (equal? '(1 2) (diff = (list 3 1 2 4) '(4) '(3))))
(pass-if (equal? '(1 2) (diff = (list 1 3 4 2) '(4) '(3))))
(pass-if (equal? '(1 2) (diff = (list 3 1 4 2) '(4) '(3))))
(pass-if (equal? '(1 2) (diff = (list 3 4 1 2) '(4) '(3)))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2 3))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(3 2))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(3) '(2))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(3))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(2 3))))
(pass-if (equal? '(1) (lset-difference! = (list 1 2 3) '(2) '(3 2))))
(with-test-prefix "lset-difference"
(test-shared-behavior lset-difference))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 2 3) '(3) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 3 2) '(3) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 3 1 2) '(3) '(3))))
(pass-if (equal? '(1 2 3) (lset-difference! = (list 1 2 3 4) '(4))))
(pass-if (equal? '(1 2 3) (lset-difference! = (list 1 2 4 3) '(4))))
(pass-if (equal? '(1 2 3) (lset-difference! = (list 1 4 2 3) '(4))))
(pass-if (equal? '(1 2 3) (lset-difference! = (list 4 1 2 3) '(4))))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 2 3 4) '(4) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 3 2 4) '(4) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 3 1 2 4) '(4) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 1 3 4 2) '(4) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 3 1 4 2) '(4) '(3))))
(pass-if (equal? '(1 2) (lset-difference! = (list 3 4 1 2) '(4) '(3)))))
(with-test-prefix "lset-difference!"
(test-shared-behavior lset-difference!)))
;;
;; lset-diff+intersection