guile18/test-suite/tests/list.test

   1 ;;;; list.test --- tests guile's lists     -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2006 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This library is free software; you can redistribute it and/or
   5 ;;;; modify it under the terms of the GNU Lesser General Public
   6 ;;;; License as published by the Free Software Foundation; either
   7 ;;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;;
   9 ;;;; This library is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;;; Lesser General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU Lesser General Public
  15 ;;;; License along with this library; if not, write to the Free Software
  16 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18 (use-modules (test-suite lib)
  19              (ice-9 documentation))
  20
  21
  22 ;;;
  23 ;;; miscellaneous
  24 ;;;
  25
  26 (define (documented? object)
  27   (not (not (object-documentation object))))
  28
  29 ;;
  30 ;; This unique tag is reserved for the unroll and diff-unrolled functions.
  31 ;;
  32
  33 (define circle-indicator
  34   (cons 'circle 'indicator))
  35
  36 ;;
  37 ;; Extract every single scheme object that is contained within OBJ into a new
  38 ;; data structure.  That means, if OBJ somewhere contains a pair, the newly
  39 ;; created structure holds a reference to the pair as well as references to
  40 ;; the car and cdr of that pair.  For vectors, the newly created structure
  41 ;; holds a reference to that vector as well as references to every element of
  42 ;; that vector.  Since this is done recursively, the original data structure
  43 ;; is deeply unrolled.  If there are circles within the original data
  44 ;; structures, every reference that points backwards into the data structure
  45 ;; is denoted by storing the circle-indicator tag as well as the object the
  46 ;; circular reference points to.
  47 ;;
  48
  49 (define (unroll obj)
  50   (let unroll* ((objct obj)
  51                 (hist '()))
  52     (reverse!
  53      (let loop ((object objct)
  54                 (histry hist)
  55                 (result '()))
  56        (if (memq object histry)
  57            (cons (cons circle-indicator object) result)
  58            (let ((history (cons object histry)))
  59              (cond ((pair? object)
  60                     (loop (cdr object) history
  61                           (cons (cons object (unroll* (car object) history))
  62                                 result)))
  63                    ((vector? object)
  64                     (cons (cons object
  65                                 (map (lambda (x)
  66                                        (unroll* x history))
  67                                      (vector->list object)))
  68                           result))
  69                    (else (cons object result)))))))))
  70
  71 ;;
  72 ;; Compare two data-structures that were generated with unroll.  If any of the
  73 ;; elements found not to be eq?, return a pair that holds the position of the
  74 ;; first found differences of the two data structures.  If all elements are
  75 ;; found to be eq?, #f is returned.
  76 ;;
  77
  78 (define (diff-unrolled a b)
  79   (cond ;; has everything been compared already?
  80         ((and (null? a) (null? b))
  81          #f)
  82         ;; do both structures still contain elements?
  83         ((and (pair? a) (pair? b))
  84          (cond ;; are the next elements both plain objects?
  85                ((and (not (pair? (car a))) (not (pair? (car b))))
  86                 (if (eq? (car a) (car b))
  87                     (diff-unrolled (cdr a) (cdr b))
  88                     (cons a b)))
  89                ;; are the next elements both container objects?
  90                ((and (pair? (car a)) (pair? (car b)))
  91                 (if (eq? (caar a) (caar b))
  92                     (cond ;; do both objects close a circular structure?
  93                           ((eq? circle-indicator (caar a))
  94                            (if (eq? (cdar a) (cdar b))
  95                                (diff-unrolled (cdr a) (cdr b))
  96                                (cons a b)))
  97                           ;; do both objects hold a vector?
  98                           ((vector? (caar a))
  99                            (or (let loop ((a1 (cdar a)) (b1 (cdar b)))
 100                                  (cond
 101                                   ((and (null? a1) (null? b1))
 102                                    #f)
 103                                   ((and (pair? a1) (pair? b1))
 104                                    (or (diff-unrolled (car a1) (car b1))
 105                                        (loop (cdr a1) (cdr b1))))
 106                                   (else
 107                                    (cons a1 b1))))
 108                                (diff-unrolled (cdr a) (cdr b))))
 109                           ;; do both objects hold a pair?
 110                           (else
 111                            (or (diff-unrolled (cdar a) (cdar b))
 112                                (diff-unrolled (cdr a) (cdr b)))))
 113                     (cons a b)))
 114                (else
 115                 (cons a b))))
 116         (else
 117          (cons a b))))
 118
 119 ;;; list
 120
 121 (with-test-prefix "list"
 122
 123   (pass-if "documented?"
 124     (documented? list))
 125
 126   ;; in guile 1.6.7 and earlier `list' called using `apply' didn't make a
 127   ;; new list, it just returned the given list
 128   (pass-if "apply gets fresh list"
 129     (let* ((x '(1 2 3))
 130            (y (apply list x)))
 131       (not (eq? x y)))))
 132
 133 ;;; make-list
 134
 135 (with-test-prefix "make-list"
 136
 137   (pass-if "documented?"
 138     (documented? make-list))
 139
 140   (with-test-prefix "no init"
 141     (pass-if "0"
 142       (equal? '() (make-list 0)))
 143     (pass-if "1"
 144       (equal? '(()) (make-list 1)))
 145     (pass-if "2"
 146       (equal? '(() ()) (make-list 2)))
 147     (pass-if "3"
 148       (equal? '(() () ()) (make-list 3))))
 149
 150   (with-test-prefix "with init"
 151     (pass-if "0"
 152       (equal? '() (make-list 0 'foo)))
 153     (pass-if "1"
 154       (equal? '(foo) (make-list 1 'foo)))
 155     (pass-if "2"
 156       (equal? '(foo foo) (make-list 2 'foo)))
 157     (pass-if "3"
 158       (equal? '(foo foo foo) (make-list 3 'foo)))))
 159
 160 ;;; cons*
 161
 162 (with-test-prefix "cons*"
 163
 164   (pass-if "documented?"
 165     (documented? list))
 166
 167   (with-test-prefix "one arg"
 168     (pass-if "empty list"
 169       (eq? '() (cons* '())))
 170     (pass-if "one elem list"
 171       (let* ((lst '(1)))
 172         (eq? lst (cons* lst))))
 173     (pass-if "two elem list"
 174       (let* ((lst '(1 2)))
 175         (eq? lst (cons* lst)))))
 176
 177   (with-test-prefix "two args"
 178     (pass-if "empty list"
 179       (equal? '(1) (cons* 1 '())))
 180     (pass-if "one elem list"
 181       (let* ((lst '(1))
 182              (ret (cons* 2 lst)))
 183         (and (equal? '(2 1) ret)
 184              (eq? lst (cdr ret)))))
 185     (pass-if "two elem list"
 186       (let* ((lst '(1 2))
 187              (ret (cons* 3 lst)))
 188         (and (equal? '(3 1 2) ret)
 189              (eq? lst (cdr ret))))))
 190
 191   (with-test-prefix "three args"
 192     (pass-if "empty list"
 193       (equal? '(1 2) (cons* 1 2 '())))
 194     (pass-if "one elem list"
 195       (let* ((lst '(1))
 196              (ret (cons* 2 3 lst)))
 197         (and (equal? '(2 3 1) ret)
 198              (eq? lst (cddr ret)))))
 199     (pass-if "two elem list"
 200       (let* ((lst '(1 2))
 201              (ret (cons* 3 4 lst)))
 202         (and (equal? '(3 4 1 2) ret)
 203              (eq? lst (cddr ret))))))
 204
 205   ;; in guile 1.6.7 and earlier `cons*' called using `apply' modified its
 206   ;; list argument
 207   (pass-if "apply list unchanged"
 208     (let* ((lst '(1 2 (3 4)))
 209            (ret (apply cons* lst)))
 210       (and (equal? lst '(1 2 (3 4)))
 211            (equal? ret '(1 2 3 4))))))
 212
 213 ;;; null?
 214
 215
 216 ;;; list?
 217
 218
 219 ;;; length
 220
 221
 222 ;;; append
 223
 224
 225 ;;;
 226 ;;; append!
 227 ;;;
 228
 229 (with-test-prefix "append!"
 230
 231   (pass-if "documented?"
 232     (documented? append!))
 233
 234   ;; Is the handling of empty lists as arguments correct?
 235
 236   (pass-if "no arguments"
 237     (eq? (append!)
 238          '()))
 239
 240   (pass-if "empty list argument"
 241     (eq? (append! '())
 242          '()))
 243
 244   (pass-if "some empty list arguments"
 245     (eq? (append! '() '() '())
 246          '()))
 247
 248   ;; Does the last non-empty-list argument remain unchanged?
 249
 250   (pass-if "some empty lists with non-empty list"
 251     (let* ((foo (list 1 2))
 252            (foo-unrolled (unroll foo))
 253            (tst (append! '() '() '() foo))
 254            (tst-unrolled (unroll tst)))
 255       (and (eq? tst foo)
 256            (not (diff-unrolled foo-unrolled tst-unrolled)))))
 257
 258   (pass-if "some empty lists with improper list"
 259     (let* ((foo (cons 1 2))
 260            (foo-unrolled (unroll foo))
 261            (tst (append! '() '() '() foo))
 262            (tst-unrolled (unroll tst)))
 263       (and (eq? tst foo)
 264            (not (diff-unrolled foo-unrolled tst-unrolled)))))
 265
 266   (pass-if "some empty lists with circular list"
 267     (let ((foo (list 1 2)))
 268       (set-cdr! (cdr foo) (cdr foo))
 269       (let* ((foo-unrolled (unroll foo))
 270              (tst (append! '() '() '() foo))
 271              (tst-unrolled (unroll tst)))
 272         (and (eq? tst foo)
 273              (not (diff-unrolled foo-unrolled tst-unrolled))))))
 274
 275   (pass-if "some empty lists with non list object"
 276     (let* ((foo (vector 1 2 3))
 277            (foo-unrolled (unroll foo))
 278            (tst (append! '() '() '() foo))
 279            (tst-unrolled (unroll tst)))
 280       (and (eq? tst foo)
 281            (not (diff-unrolled foo-unrolled tst-unrolled)))))
 282
 283   (pass-if "non-empty list between empty lists"
 284     (let* ((foo (list 1 2))
 285            (foo-unrolled (unroll foo))
 286            (tst (append! '() '() '() foo '() '() '()))
 287            (tst-unrolled (unroll tst)))
 288       (and (eq? tst foo)
 289            (not (diff-unrolled foo-unrolled tst-unrolled)))))
 290
 291   ;; Are arbitrary lists append!ed correctly?
 292
 293   (pass-if "two one-element lists"
 294     (let* ((foo (list 1))
 295            (foo-unrolled (unroll foo))
 296            (bar (list 2))
 297            (bar-unrolled (unroll bar))
 298            (tst (append! foo bar))
 299            (tst-unrolled (unroll tst))
 300            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 301       (and (equal? tst '(1 2))
 302            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 303            (not (diff-unrolled bar-unrolled (cdr diff-foo-tst))))))
 304
 305   (pass-if "three one-element lists"
 306     (let* ((foo (list 1))
 307            (foo-unrolled (unroll foo))
 308            (bar (list 2))
 309            (bar-unrolled (unroll bar))
 310            (baz (list 3))
 311            (baz-unrolled (unroll baz))
 312            (tst (append! foo bar baz))
 313            (tst-unrolled (unroll tst))
 314            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 315       (and (equal? tst '(1 2 3))
 316            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 317            (let* ((tst-unrolled-2 (cdr diff-foo-tst))
 318                   (diff-foo-bar (diff-unrolled bar-unrolled tst-unrolled-2)))
 319              (and (not (diff-unrolled (car diff-foo-bar) (unroll '())))
 320                   (not (diff-unrolled baz-unrolled (cdr diff-foo-bar))))))))
 321
 322   (pass-if "two two-element lists"
 323     (let* ((foo (list 1 2))
 324            (foo-unrolled (unroll foo))
 325            (bar (list 3 4))
 326            (bar-unrolled (unroll bar))
 327            (tst (append! foo bar))
 328            (tst-unrolled (unroll tst))
 329            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 330       (and (equal? tst '(1 2 3 4))
 331            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 332            (not (diff-unrolled bar-unrolled (cdr diff-foo-tst))))))
 333
 334   (pass-if "three two-element lists"
 335     (let* ((foo (list 1 2))
 336            (foo-unrolled (unroll foo))
 337            (bar (list 3 4))
 338            (bar-unrolled (unroll bar))
 339            (baz (list 5 6))
 340            (baz-unrolled (unroll baz))
 341            (tst (append! foo bar baz))
 342            (tst-unrolled (unroll tst))
 343            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 344       (and (equal? tst '(1 2 3 4 5 6))
 345            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 346            (let* ((tst-unrolled-2 (cdr diff-foo-tst))
 347                   (diff-foo-bar (diff-unrolled bar-unrolled tst-unrolled-2)))
 348              (and (not (diff-unrolled (car diff-foo-bar) (unroll '())))
 349                   (not (diff-unrolled baz-unrolled (cdr diff-foo-bar))))))))
 350
 351   (pass-if "empty list between non-empty lists"
 352     (let* ((foo (list 1 2))
 353            (foo-unrolled (unroll foo))
 354            (bar (list 3 4))
 355            (bar-unrolled (unroll bar))
 356            (baz (list 5 6))
 357            (baz-unrolled (unroll baz))
 358            (tst (append! foo '() bar '() '() baz '() '() '()))
 359            (tst-unrolled (unroll tst))
 360            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 361       (and (equal? tst '(1 2 3 4 5 6))
 362            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 363            (let* ((tst-unrolled-2 (cdr diff-foo-tst))
 364                   (diff-foo-bar (diff-unrolled bar-unrolled tst-unrolled-2)))
 365              (and (not (diff-unrolled (car diff-foo-bar) (unroll '())))
 366                   (not (diff-unrolled baz-unrolled (cdr diff-foo-bar))))))))
 367
 368   (pass-if "list and improper list"
 369     (let* ((foo (list 1 2))
 370            (foo-unrolled (unroll foo))
 371            (bar (cons 3 4))
 372            (bar-unrolled (unroll bar))
 373            (tst (append! foo bar))
 374            (tst-unrolled (unroll tst))
 375            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 376       (and (equal? tst '(1 2 3 . 4))
 377            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 378            (not (diff-unrolled bar-unrolled (cdr diff-foo-tst))))))
 379
 380   (pass-if "list and circular list"
 381     (let* ((foo (list 1 2))
 382            (foo-unrolled (unroll foo))
 383            (bar (list 3 4 5)))
 384       (set-cdr! (cddr bar) (cdr bar))
 385       (let* ((bar-unrolled (unroll bar))
 386              (tst (append! foo bar))
 387              (tst-unrolled (unroll tst))
 388              (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 389         (and (equal? (map (lambda (n x) (eqv? (list-ref tst n) x))
 390                           (iota 9)
 391                           '(1 2 3 4 5 4 5 4 5))
 392                      '(#t #t #t #t #t #t #t #t #t))
 393              (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 394              (not (diff-unrolled bar-unrolled (cdr diff-foo-tst)))))))
 395
 396   (pass-if "list and non list object"
 397     (let* ((foo (list 1 2))
 398            (foo-unrolled (unroll foo))
 399            (bar (vector 3 4))
 400            (bar-unrolled (unroll bar))
 401            (tst (append! foo bar))
 402            (tst-unrolled (unroll tst))
 403            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 404       (and (equal? tst '(1 2 . #(3 4)))
 405            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 406            (not (diff-unrolled bar-unrolled (cdr diff-foo-tst))))))
 407
 408   (pass-if "several arbitrary lists"
 409     (equal? (append! (list 1 2)
 410                      (list (list 3) 4)
 411                      (list (list 5) (list 6))
 412                      (list 7 (cons 8 9))
 413                      (list 10 11)
 414                      (list (cons 12 13) 14)
 415                      (list (list)))
 416             (list 1 2
 417                   (list 3) 4
 418                   (list 5) (list 6)
 419                   7 (cons 8 9)
 420                   10 11
 421                   (cons 12 13)
 422                   14 (list))))
 423
 424   (pass-if "list to itself"
 425     (let* ((foo (list 1 2))
 426            (foo-unrolled (unroll foo))
 427            (tst (append! foo foo))
 428            (tst-unrolled (unroll tst))
 429            (diff-foo-tst (diff-unrolled foo-unrolled tst-unrolled)))
 430       (and (equal? (map (lambda (n x) (eqv? (list-ref tst n) x))
 431                         (iota 6)
 432                         '(1 2 1 2 1 2))
 433                    '(#t #t #t #t #t #t))
 434            (not (diff-unrolled (car diff-foo-tst) (unroll '())))
 435            (eq? (caar (cdr diff-foo-tst)) circle-indicator)
 436            (eq? (cdar (cdr diff-foo-tst)) foo))))
 437
 438   ;; Are wrong type arguments detected correctly?
 439
 440   (with-test-prefix "wrong argument"
 441
 442     (expect-fail-exception "improper list and empty list"
 443       exception:wrong-type-arg
 444       (append! (cons 1 2) '()))
 445
 446     (expect-fail-exception "improper list and list"
 447       exception:wrong-type-arg
 448       (append! (cons 1 2) (list 3 4)))
 449
 450     (expect-fail-exception "list, improper list and list"
 451       exception:wrong-type-arg
 452       (append! (list 1 2) (cons 3 4) (list 5 6)))
 453
 454     (expect-fail "circular list and empty list"
 455       (let ((foo (list 1 2 3)))
 456         (set-cdr! (cddr foo) (cdr foo))
 457         (catch #t
 458           (lambda ()
 459             (catch 'wrong-type-arg
 460               (lambda ()
 461                 (append! foo '())
 462                 #f)
 463               (lambda (key . args)
 464                 #t)))
 465           (lambda (key . args)
 466             #f))))
 467
 468     (expect-fail "circular list and list"
 469       (let ((foo (list 1 2 3)))
 470         (set-cdr! (cddr foo) (cdr foo))
 471         (catch #t
 472           (lambda ()
 473             (catch 'wrong-type-arg
 474               (lambda ()
 475                 (append! foo (list 4 5))
 476                 #f)
 477               (lambda (key . args)
 478                 #t)))
 479           (lambda (key . args)
 480             #f))))
 481
 482     (expect-fail "list, circular list and list"
 483       (let ((foo (list 3 4 5)))
 484         (set-cdr! (cddr foo) (cdr foo))
 485         (catch #t
 486           (lambda ()
 487             (catch 'wrong-type-arg
 488               (lambda ()
 489                 (append! (list 1 2) foo (list 6 7))
 490                 #f)
 491               (lambda (key . args)
 492                 #t)))
 493           (lambda (key . args)
 494             #f))))))
 495
 496
 497 ;;; last-pair
 498
 499
 500 ;;; reverse
 501
 502
 503 ;;; reverse!
 504
 505
 506 ;;; list-ref
 507
 508 (with-test-prefix "list-ref"
 509
 510   (pass-if "documented?"
 511     (documented? list-ref))
 512
 513   (with-test-prefix "argument error"
 514
 515     (with-test-prefix "non list argument"
 516       #t)
 517
 518     (with-test-prefix "improper list argument"
 519       #t)
 520
 521     (with-test-prefix "non integer index"
 522       #t)
 523
 524     (with-test-prefix "index out of range"
 525
 526       (with-test-prefix "empty list"
 527
 528         (pass-if-exception "index 0"
 529           exception:out-of-range
 530           (list-ref '() 0))
 531
 532         (pass-if-exception "index > 0"
 533           exception:out-of-range
 534           (list-ref '() 1))
 535
 536         (pass-if-exception "index < 0"
 537           exception:out-of-range
 538           (list-ref '() -1)))
 539
 540       (with-test-prefix "non-empty list"
 541
 542         (pass-if-exception "index > length"
 543           exception:out-of-range
 544           (list-ref '(1) 1))
 545
 546         (pass-if-exception "index < 0"
 547           exception:out-of-range
 548           (list-ref '(1) -1))))))
 549
 550
 551 ;;; list-set!
 552
 553 (with-test-prefix "list-set!"
 554
 555   (pass-if "documented?"
 556     (documented? list-set!))
 557
 558   (with-test-prefix "argument error"
 559
 560     (with-test-prefix "non list argument"
 561       #t)
 562
 563     (with-test-prefix "improper list argument"
 564       #t)
 565
 566     (with-test-prefix "read-only list argument"
 567       #t)
 568
 569     (with-test-prefix "non integer index"
 570       #t)
 571
 572     (with-test-prefix "index out of range"
 573
 574       (with-test-prefix "empty list"
 575
 576         (pass-if-exception "index 0"
 577           exception:out-of-range
 578           (list-set! (list) 0 #t))
 579
 580         (pass-if-exception "index > 0"
 581           exception:out-of-range
 582           (list-set! (list) 1 #t))
 583
 584         (pass-if-exception "index < 0"
 585           exception:out-of-range
 586           (list-set! (list) -1 #t)))
 587
 588       (with-test-prefix "non-empty list"
 589
 590         (pass-if-exception "index > length"
 591           exception:out-of-range
 592           (list-set! (list 1) 1 #t))
 593
 594         (pass-if-exception "index < 0"
 595           exception:out-of-range
 596           (list-set! (list 1) -1 #t))))))
 597
 598
 599 ;;; list-cdr-ref
 600
 601
 602 ;;; list-tail
 603
 604
 605 ;;; list-cdr-set!
 606
 607 (with-test-prefix "list-cdr-set!"
 608
 609   (pass-if "documented?"
 610     (documented? list-cdr-set!))
 611
 612   (with-test-prefix "argument error"
 613
 614     (with-test-prefix "non list argument"
 615       #t)
 616
 617     (with-test-prefix "improper list argument"
 618       #t)
 619
 620     (with-test-prefix "read-only list argument"
 621       #t)
 622
 623     (with-test-prefix "non integer index"
 624       #t)
 625
 626     (with-test-prefix "index out of range"
 627
 628       (with-test-prefix "empty list"
 629
 630         (pass-if-exception "index 0"
 631           exception:out-of-range
 632           (list-cdr-set! (list) 0 #t))
 633
 634         (pass-if-exception "index > 0"
 635           exception:out-of-range
 636           (list-cdr-set! (list) 1 #t))
 637
 638         (pass-if-exception "index < 0"
 639           exception:out-of-range
 640           (list-cdr-set! (list) -1 #t)))
 641
 642       (with-test-prefix "non-empty list"
 643
 644         (pass-if-exception "index > length"
 645           exception:out-of-range
 646           (list-cdr-set! (list 1) 1 #t))
 647
 648         (pass-if-exception "index < 0"
 649           exception:out-of-range
 650           (list-cdr-set! (list 1) -1 #t))))))
 651
 652
 653 ;;; list-head
 654
 655
 656 ;;; list-copy
 657
 658
 659 ;;; memq
 660
 661
 662 ;;; memv
 663
 664
 665 ;;; member
 666
 667
 668 ;;; delq!
 669
 670
 671 ;;; delv!
 672
 673
 674 ;;; delete!
 675
 676
 677 ;;; delq
 678
 679
 680 ;;; delv
 681
 682
 683 ;;; delete
 684
 685
 686 ;;; delq1!
 687
 688
 689 ;;; delv1!
 690
 691
 692 ;;; delete1!