Changeset 35190 in project


Ignore:
Timestamp:
02/23/18 20:48:08 (4 months ago)
Author:
kon
Message:

add csi+csc test run , bump ver , add pair-ref , list-set! , list-copy* , fix alist-delete... names

Location:
release/4/list-utils/trunk
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/list-utils/trunk/list-utils.scm

    r34652 r35190  
    22;;;; Kon Lovett, Jul '07
    33;;;; Kon Lovett, Sep '17
     4;;;; Kon Lovett, Feb '18
    45
    56(module list-utils
     
    910  split-at+
    1011  section
    11   length=0?
    12   length=1?
    13   length=2?
    14   length>1?
     12  length=0? length=1? length=2? length>1?
    1513  ensure-list
    1614  not-null?
    1715  alist?
    18   alist-delete-first
    19   alist-delete-first!
    20   assoc-def
    21   assq-def
    22   assv-def
     16  alist-delete-first alist-delete-first!
     17  alist-delete-duplicates alist-delete-duplicates!
     18  assoc-def assq-def assv-def
    2319  alist-inverse-ref
    24   alist-delete-for-count
    25   alist-delete-for-count!
    26   plist->alist
    27   alist->plist
    28   unzip-alist
    29   zip-alist
    30   shift!
    31   unshift!
    32   shift!/set
    33   andmap
    34   ormap
     20  plist->alist alist->plist
     21  unzip-alist zip-alist
     22  shift! unshift! shift!/set
     23  andmap ormap
     24  pair-ref
     25  list-set!
     26  list-copy*
    3527  ;DEPRECATED
    3628  alist-delete/count
    37   alist-delete!/count)
    38 
    39 (import scheme)
    40 
    41 (import chicken)
    42 
    43 (import
     29  alist-delete!/count
     30  alist-delete-with-count
     31  alist-delete-with-count!
     32  alist-delete-for-count
     33  alist-delete-for-count! )
     34
     35(import scheme chicken)
     36(use
    4437  (only data-structures
    45     rassoc))
    46 (require-library
    47   data-structures)
    48 
    49 (import
     38    rassoc)
    5039  (only (srfi 1)
    51     cons* reverse! append-reverse!
    52     proper-list? every))
    53 (require-library
    54   (srfi 1))
    55 
    56 (import
     40    make-list cons*
     41    proper-list?
     42    reverse! append-reverse! append!
     43    take drop
     44    every
     45    split-at)
    5746  (only type-checks
    58     check-list check-alist check-pair check-procedure check-fixnum check-positive-fixnum)
     47    check-list check-alist check-pair
     48    check-procedure
     49    check-fixnum check-positive-fixnum)
    5950  (only type-errors
    60     error-alist define-error-type))
    61 (require-library
    62   type-checks type-errors)
     51    error-alist define-error-type) )
    6352
    6453;;;
    6554
     55(define-type binary-predicate (* * --> boolean))
     56
     57(define-type alist (or null (list-of (pair * *))))
     58
     59;;
     60
     61(define-error-type plist)
     62
     63;;;
     64
    6665;; Returns the original list starting at element n.
    6766
     67(: skip+ (list fixnum --> list fixnum))
     68;
    6869(define (skip+ ls n)
    6970  (*skip+ (check-list 'skip+ ls 'ls) (check-fixnum 'skip+ n 'n)) )
     
    7576;; no padding & paritial section.
    7677
     78(: split-at+ (list fixnum #!optional (or boolean list) --> list list))
     79;
    7780(define (split-at+ ls n #!optional pads)
    7881  (*split-at+
     
    9093;pads - remainder fill
    9194
     95(: section (list fixnum #!optional fixnum (or boolean list) --> list))
     96;
    9297(define (section ls n #!optional (step n) (pads '()))
    9398  (cond
     
    96101    ((null? (check-list 'section ls 'ls))
    97102      '() )
     103    ;Remaining elements between sections
    98104    (else
    99       ;Remaining elements between sections
    100       (let ((inc
    101               (fx-
    102                 (check-positive-fixnum 'section step 'step)
    103                 (check-positive-fixnum 'section n 'size))))
     105      (let (
     106        (bias
     107          (fx-
     108            (check-positive-fixnum 'section step 'step)
     109            (check-positive-fixnum 'section n 'size))))
    104110        (let loop ((ls ls) (parts '()))
    105111          ;Get this section
     
    117123                      (cond
    118124                        ;step = n
    119                         ((fx= 0 inc)
     125                        ((fx= 0 bias)
    120126                          nls )
    121127                        ;step < n so skip from starting this section element
    122                         ((fx> 0 inc)
    123                           (*skip+ ls (+ n inc)) )
     128                        ((fx> 0 bias)
     129                          (receive (ls _) (*skip+ ls (+ n bias)) ls) )
    124130                        ;step > n so skip remaining elements in between
    125131                        (else
    126                           (*skip+ nls inc) ) ) ) )
     132                          (receive (ls _) (*skip+ nls bias) ls) ) ) ) )
    127133                  (loop ls (cons part parts)) ) ) ) ) ) ) ) ) )
    128 
    129 ;;
    130 
    131 (define-error-type plist)
    132134
    133135;; shift! with a variable
     
    258260; (<key>1 <val>1 ... <key>n <val>n) -> ((<key>1 . <val>1) ... (<key>n . <val>n))
    259261
     262(: plist->alist (list --> alist))
     263;
    260264(define (plist->alist pls)
    261265  (let loop ((pls (check-list 'plist->alist pls)) (als '()))
    262266    (if (null? pls)
    263267      (reverse! als)
    264       (let ((hd (car pls))
    265             (tl (cdr pls)) )
     268      (let (
     269        (hd (car pls))
     270        (tl (cdr pls)) )
    266271        (if (null? tl)
    267272          (error-plist 'plist->alist pls)
     
    270275; ((<key>1 . <val>1) ... (<key>n . <val>n)) -> (<key>1 <val>1 ... <key>n <val>n)
    271276
     277(: alist->plist (alist --> list))
     278;
    272279(define (alist->plist als)
    273280  (let loop ((als (check-list 'alist->plist als)) (pls '()))
     
    281288;;
    282289
     290(: alist? (* -> boolean : alist))
     291;
    283292(define (alist? obj)
    284293  (and
     
    288297;; Search the alist from back to front.
    289298
     299(: alist-inverse-ref (* alist #!optional binary-predicate * --> *))
     300;
    290301(define (alist-inverse-ref val alist #!optional (cmp eqv?) default)
    291302  (let (
    292       (elt
    293         (rassoc
    294           val
    295           (check-alist 'alist-inverse-ref alist)
    296           (check-procedure  'alist-inverse-ref cmp))))
     303    (elt
     304      (rassoc
     305        val
     306        (check-alist 'alist-inverse-ref alist)
     307        (check-procedure  'alist-inverse-ref cmp))))
    297308    (if elt
    298309      (car elt)
     
    301312;; Remove 1st N matching elements from the alist (functional)
    302313
    303 (define (alist-delete-for-count key al #!optional (cmp eqv?) (cnt most-positive-fixnum))
    304   (*alist-delete-for-count 'alist-delete-for-count key al cmp cnt) )
    305 
    306 (define (alist-delete-with-count key al #!optional (cnt most-positive-fixnum) (cmp eqv?))
    307   (*alist-delete-for-count 'alist-delete-for-count key al cmp cnt) )
    308 
    309 ;; Remove 1st N matching elements from the alist (destructive)
    310 
    311 (define (alist-delete-for-count! key al #!optional (cmp eqv?) (cnt most-positive-fixnum))
    312   (*alist-delete-for-count! 'alist-delete-for-count! key al cmp cnt) )
    313 
    314 (define (alist-delete-with-count! key al #!optional (cnt most-positive-fixnum) (cmp eqv?))
    315   (*alist-delete-for-count! 'alist-delete-for-count! key al cmp cnt) )
     314(: alist-delete-duplicates (* alist #!optional binary-predicate fixnum --> alist))
     315;
     316(define (alist-delete-duplicates key al #!optional (cmp eqv?) (cnt most-positive-fixnum))
     317  (*alist-delete-duplicates 'alist-delete-duplicates key al cmp cnt) )
     318
     319(: alist-delete-duplicates! (* alist #!optional binary-predicate fixnum --> alist))
     320;
     321(define (alist-delete-duplicates! key al #!optional (cmp eqv?) (cnt most-positive-fixnum))
     322  (*alist-delete-duplicates! 'alist-delete-duplicates! key al cmp cnt) )
    316323
    317324;; Returns alist of improper lists
     
    319326
    320327; This works with any proper list, not just an alist.
     328(: zip-alist (list list --> alist))
     329;
    321330(define (zip-alist keys vals)
    322331  (unless
    323       (= (length (check-list 'zip-alist keys)) (length (check-list 'zip-alist vals)))
     332    (= (length (check-list 'zip-alist keys)) (length (check-list 'zip-alist vals)))
    324333    (error 'zip-alist "lists are not of same length" keys vals) )
    325334  (map cons keys vals) )
     
    327336;; Split alist into (values keys vals)
    328337
     338(: unzip-alist (alist --> list list))
     339;
    329340(define (unzip-alist al)
    330341  (let loop ((al (check-list 'unzip-alist al)) (keys '()) (vals '()))
     
    338349;;; Handy little things:
    339350
    340 (define (shift! ls #!optional default)
     351(: shift! (list #!optional * --> *))
     352;
     353(define (shift! ls #!optional def)
    341354  (check-list 'shift! ls)
    342355  (if (null? ls)
    343     default
    344     (begin
    345       (let ((x (car ls))
    346             (d (cdr ls)) )
    347         (check-pair 'shift! d)
    348         (set-car! ls (car d))
    349         (set-cdr! ls (cdr d))
    350         x ) ) ) )
    351 
     356    def
     357    (let (
     358      (x (car ls))
     359      (d (cdr ls)) )
     360      (check-pair 'shift! d)
     361      (set-car! ls (car d))
     362      (set-cdr! ls (cdr d))
     363      x ) ) )
     364
     365(: unshift! (* list --> list))
     366;
    352367(define (unshift! x ls)
    353368  (check-pair 'unshift! ls)
     
    358373;;
    359374
     375(: andmap (procedure list #!rest list --> *))
     376;
    360377(define (andmap func ls0 . rest)
    361378  (cond
     
    385402            (mapf (cdr ls0) (map cdr rest)))) ) ) ) )
    386403
     404(: ormap (procedure list #!rest list --> *))
     405;
    387406(define (ormap func ls0 . rest)
    388407  (and
     
    393412        (apply ormap func (map cdr rest)) ) ) ) )
    394413
     414(: pair-ref (list fixnum --> list))
     415;
     416(define pair-ref drop)
     417
     418(: list-set! (list fixnum * -> void))
     419;
     420(define (list-set! ls idx val)
     421  (let ((ls (pair-ref ls idx)))
     422    (if (null? ls)
     423      (error 'list-set! "index out-of-bounds" idx ls)
     424      (set-car! ls val) ) ) )
     425
     426(: list-copy* (list #!optional fixnum fixnum * --> list))
     427;
     428(define (list-copy* ls #!optional (start 0) (end (length ls)) (fill (void)))
     429  (unless (fx<= start end)
     430    (error 'list-copy* "start > end" start end) )
     431  (let* (
     432    (tot (fx- end start))
     433    (end (fxmin end (length ls)))
     434    (len (fx- end start))
     435    (ls (take (drop ls start) len)) )
     436    ;(assert (fx<= tot len))
     437    (append! ls (make-list (fx- tot len) fill)) ) )
     438
    395439;;;
    396440
     441(: *skip+ (list fixnum --> list fixnum))
     442;
    397443(define (*skip+ ls n)
    398444  (if (or (null? ls) (fx<= n 0))
     
    400446    (*skip+ (cdr ls) (fx- n 1))) )
    401447
     448(: *split-at+ (list fixnum list --> list list))
     449;
    402450(define (*split-at+ ls n pads)
    403451  ;Do not attempt to padout when the primary list is empty.
     
    416464              (values (reverse! part) '()) )
    417465            (else
    418               (values (append-reverse! part (*split-at+ pads n '())) '()) ) ) )
     466              (receive (ls _) (*split-at+ pads n '())
     467                (values (append-reverse! part ls) '()) ) ) ) )
    419468        (else
    420469          (loop (cdr ls) (fx- n 1) (cons (car ls) part)) ) ) ) ) )
    421470
    422 (define (*alist-delete-for-count loc key al cmp cnt)
     471(: *alist-delete-duplicates (symbol * alist binary-predicate fixnum --> alist))
     472;
     473(define (*alist-delete-duplicates loc key al cmp cnt)
    423474  (check-procedure loc cmp)
    424475  (let loop ((cal (check-list loc al)) (cnt (check-fixnum loc cnt)) (oal '()))
     
    441492        (error-alist loc al) ) ) ) )
    442493
    443 (define (*alist-delete-for-count! loc key al cmp cnt)
     494(: *alist-delete-duplicates! (symbol * alist binary-predicate fixnum --> alist))
     495;
     496(define (*alist-delete-duplicates! loc key al cmp cnt)
    444497  (check-procedure loc cmp)
    445498  (let ((ral (check-list loc al)))
     
    449502          ral )
    450503        ((pair? cal)
    451           (let ((elt (car cal))
    452                 (nxt (cdr cal)))
     504          (let (
     505            (elt (car cal))
     506            (nxt (cdr cal)))
    453507            (if (not (pair? elt))
    454508              (error-alist loc al)
     
    466520;;;DEPRECATED
    467521
     522(define alist-delete-for-count alist-delete-duplicates)
     523(define alist-delete-for-count! alist-delete-duplicates! )
     524
    468525(define alist-delete/count alist-delete-for-count)
    469526(define alist-delete!/count alist-delete-for-count!)
    470527
     528(: alist-delete-with-count (* alist #!optional fixnum binary-predicate --> alist))
     529(define (alist-delete-with-count key al #!optional (cnt most-positive-fixnum) (cmp eqv?))
     530  (*alist-delete-duplicates 'alist-delete-for-count key al cmp cnt) )
     531
     532(: alist-delete-with-count! (* alist #!optional fixnum binary-predicate --> alist))
     533(define (alist-delete-with-count! key al #!optional (cnt most-positive-fixnum) (cmp eqv?))
     534  (*alist-delete-duplicates! 'alist-delete-for-count! key al cmp cnt) )
     535
    471536) ;module list-utils
  • release/4/list-utils/trunk/list-utils.setup

    r34652 r35190  
    55(verify-extension-name "list-utils")
    66
    7 (setup-shared-extension-module 'list-utils (extension-version "1.3.0")
     7(setup-shared-extension-module 'list-utils (extension-version "1.4.0")
    88  #:inline? #t
    99  #:types? #t
  • release/4/list-utils/trunk/tests/run.scm

    r34649 r35190  
    1 (use test)
    2 (use data-structures)
    3 (use list-utils)
    41
    5 (test-group  "Skip+"
    6   (test '(() -1) (receive (skip+ '() -1)))
    7   (test '(() 0) (receive (skip+ '() 0)))
    8   (test '(() 1) (receive (skip+ '() 1)))
    9   (test '((1) -1) (receive (skip+ '(1) -1)))
    10   (test '((1) 0) (receive (skip+ '(1) 0)))
    11   (test '(() 0) (receive (skip+ '(1) 1)))
    12   (test '(() 1) (receive (skip+ '(1) 2)))
    13   (test '((1 2) -1) (receive (skip+ '(1 2) -1)))
    14   (test '((1 2) 0) (receive (skip+ '(1 2) 0)))
    15   (test '((2) 0) (receive (skip+ '(1 2) 1)))
    16   (test '(() 0) (receive (skip+ '(1 2) 2)))
    17 )
     2(define EGG-NAME "list-utils")
    183
    19 (test-group  "Split-at+"
    20   (test '(() ()) (receive (split-at+ '() -1 #f)))
    21   (test '(() ()) (receive (split-at+ '() 0 #f)))
    22   (test '(() ()) (receive (split-at+ '() 1 #f)))
    23   (test '(() ()) (receive (split-at+ '() -1 '())))
    24   (test '(() ()) (receive (split-at+ '() 0 '())))
    25   (test '(() ()) (receive (split-at+ '() 1 '())))
    26   (test '(() ()) (receive (split-at+ '() -1 '(1))))
    27   (test '(() ()) (receive (split-at+ '() 0 '(1))))
    28   (test '(() ()) (receive (split-at+ '() 1 '(1))))
    29   (test '(() (1)) (receive (split-at+ '(1) -1 #f)))
    30   (test '(() (1)) (receive (split-at+ '(1) 0 #f)))
    31   (test '((1) ()) (receive (split-at+ '(1) 1 #f)))
    32   (test '(() ()) (receive (split-at+ '(1) 2 #f)))
    33   (test '(() (1)) (receive (split-at+ '(1) -1 '())))
    34   (test '(() (1)) (receive (split-at+ '(1) 0 '())))
    35   (test '((1) ()) (receive (split-at+ '(1) 1 '())))
    36   (test '((1) ()) (receive (split-at+ '(1) 2 '())))
    37   (test '(() (1)) (receive (split-at+ '(1) -1 '(2))))
    38   (test '(() (1)) (receive (split-at+ '(1) 0 '(2))))
    39   (test '((1) ()) (receive (split-at+ '(1) 1 '(2))))
    40   (test '((1 2) ()) (receive (split-at+ '(1) 2 '(2))))
    41 )
     4;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    425
    43 (test-group  "Section"
    44   ;(section LIST SIZE [STEP [PADS]])
    45   ;Needs more tests
     6(use files)
    467
    47   (test-error "size <= 0" (section '(1 2) -1 1 #f))
    48   (test-error "size <= 0" (section '(1 2) 0 1 #f))
    49   (test-error "step <= 0" (section '(1 2) 1 -1 #f))
    50   (test-error "step <= 0" (section '(1 2) 1 0 #f))
     8;no -disable-interrupts
     9(define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    5110
    52   (test "null primary" '() (section '() 1 1 #f))
    53   (test "size > length primary & no pad" '() (section '(1) 2 2 #f))
     11(define *args* (argv))
    5412
    55   (test '((1) (2)) (section '(1 2) 1 1 #f))
    56   (test '((1 2)) (section '(1 2) 2 2 #f))
    57   (test "size > length primary & clip" '((1 2)) (section '(1 2) 3 3 '()))
    58   (test "size > length primary & pad" '((1 2 3)) (section '(1 2) 3 3 '(3 4 5)))
     13(define (test-name #!optional (eggnam EGG-NAME))
     14  (string-append eggnam "-test") )
    5915
    60   (test "size > step" '((1 2) (2 3)) (section '(1 2 3) 2 1))
    61   (test "size < step" '((1) (3)) (section '(1 2 3) 1 2))
     16(define (egg-name #!optional (def EGG-NAME))
     17  (cond
     18    ((<= 4 (length *args*))
     19      (cadddr *args*) )
     20    (def
     21      def )
     22    (else
     23      (error 'test "cannot determine egg-name") ) ) )
    6224
    63   (test '((1 2) (2 3)) (section '(1 2 3) 2 1 '(a b c)))
    64   (test '((1 2 a)) (section '(1 2) 3 3 '(a b c)))
    65   (test '((1 2) (3 a)) (section '(1 2 3) 2 2 '(a b c)))
    66   (test '((1 2) (3)) (section '(1 2 3) 2 2))
    67 )
     25;;;
    6826
    69 (define alst1 '((a 1) (b 2) (b 3) (c 4) (b 5) (a 6) (d 7)))
    70 (define alst2 '((a . 1) (b . 2) (b . 3) (c . 4) (b . 5) (a . 6) (d . 7)))
     27(set! EGG-NAME (egg-name))
    7128
    72 (test-group  "Length"
    73         (test-assert (length=0? '()))
    74         (test-assert (not (length=0? '(1))))
    75         (test-assert (length=1? '(1)))
    76         (test-assert (not (length=1? '())))
    77         (test-assert (not (length=1? '(1 2))))
    78         (test-assert (length=2? '(1 2)))
    79         (test-assert (not (length=2? '())))
    80         (test-assert (not (length=2? '(1))))
    81         (test-assert (not (length=2? '(1 2 3))))
    82         (test-assert (length>1? '(1 2)))
    83         (test-assert (not (length>1? '())))
    84         (test-assert (not (length>1? '(1))))
    85 )
     29(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
     30  (let ((tstnam (test-name eggnam)))
     31    (print "*** csi ***")
     32    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
     33    (newline)
     34    (print "*** csc (" cscopts ") ***")
     35    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
     36    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
    8637
    87 (test-group  "Null Stuff"
    88   (test '(1) (ensure-list '(1)))
    89   (test '(1) (ensure-list 1))
     38(define (run-tests eggnams #!optional (cscopts *csc-options*))
     39  (for-each (cut run-test <> cscopts) eggnams) )
    9040
    91   (test '(1) (not-null? '(1)))
    92   (test-assert (not (not-null? '())))
    93 )
     41;;;
    9442
    95 (test-group  "Shift Set"
    96   (let ((lst '(1 2)))
    97     (test 1 (shift!/set lst))
    98     (test '(2) (identity lst))
    99     (test 2 (shift!/set lst))
    100     (test '() (identity lst))
    101     (test-assert (not (shift!/set lst)))
    102     (test '() (identity lst))
    103   )
    104 )
    105 
    106 (test-group  "Alist Zip"
    107   (test '((a b) ((1) (2))) (receive (unzip-alist '((a 1) (b 2)))))
    108   (test '((a . 1) (b . 2)) (zip-alist '(a b) '(1 2)))
    109   (test '((a 1) (b 2)) (zip-alist '(a b) '((1) (2))))
    110   (test '((a . 1) (b . 2)) (zip-alist '(a b) '(1 2)))
    111 )
    112 
    113 (test-group  "Plist <-> Alist"
    114   (test '(a (1) b (2) b (3) c (4) b (5) a (6) d (7)) (alist->plist alst1))
    115   (test '(a 1 b 2 b 3 c 4 b 5 a 6 d 7) (alist->plist alst2))
    116   (test alst1 (plist->alist '(a (1) b (2) b (3) c (4) b (5) a (6) d (7))))
    117   (test alst2 (plist->alist '(a 1 b 2 b 3 c 4 b 5 a 6 d 7)))
    118 )
    119 
    120 #; ;
    121 (test-group  "Alist Delete"
    122   (test '((a 1) (c 4) (b 5) (a 6) (d 7)) (alist-delete/count 'b alst1 eq? 2))
    123   (test '((a 1) (c 4) (a 6) (d 7)) (alist-delete/count 'b alst1 eq?))
    124   (test '((a 1) (b 2) (b 3) (c 4) (b 5) (a 6)) (alist-delete/count 'd alst1 eq?))
    125   (test '((a 1) (b 2) (b 3) (b 5) (a 6) (d 7)) (alist-delete/count 'c alst1 eq?))
    126   (test '((b 2) (b 3) (c 4) (b 5) (a 6) (d 7)) (alist-delete/count 'a alst1 eq? 1))
    127 
    128   (test '((a 1) (c 4) (b 5) (a 6) (d 7)) (alist-delete!/count 'b alst1 eq? 2))
    129   (test '((a 1) (c 4) (a 6) (d 7)) (alist-delete!/count 'b alst1 eq?))
    130   (test '((a 1) (c 4) (a 6)) (alist-delete!/count 'd alst1 eq?))
    131   (test '((a 1) (a 6)) (alist-delete!/count 'c alst1 eq?))
    132   (test '((a 6)) (alist-delete!/count 'a alst1 eq? 1))
    133 )
    134 
    135 (test-group  "Alist Delete"
    136   (test '((a 1) (c 4) (b 5) (a 6) (d 7)) (alist-delete-for-count 'b alst1 eq? 2))
    137   (test '((a 1) (c 4) (a 6) (d 7)) (alist-delete-for-count 'b alst1 eq?))
    138   (test '((a 1) (b 2) (b 3) (c 4) (b 5) (a 6)) (alist-delete-for-count 'd alst1 eq?))
    139   (test '((a 1) (b 2) (b 3) (b 5) (a 6) (d 7)) (alist-delete-for-count 'c alst1 eq?))
    140   (test '((b 2) (b 3) (c 4) (b 5) (a 6) (d 7)) (alist-delete-for-count 'a alst1 eq? 1))
    141 
    142   (test '((a 1) (c 4) (b 5) (a 6) (d 7)) (alist-delete-for-count! 'b alst1 eq? 2))
    143   (test '((a 1) (c 4) (a 6) (d 7)) (alist-delete-for-count! 'b alst1 eq?))
    144   (test '((a 1) (c 4) (a 6)) (alist-delete-for-count! 'd alst1 eq?))
    145   (test '((a 1) (a 6)) (alist-delete-for-count! 'c alst1 eq?))
    146   (test '((a 6)) (alist-delete-for-count! 'a alst1 eq? 1))
    147 )
    148 
    149 (test-exit)
     43(run-test)
Note: See TracChangeset for help on using the changeset viewer.