Commit 310e41eb authored by Carl Shapiro's avatar Carl Shapiro
Browse files

Merge branch 'mapcan' into 'master'

Address #196: Fix issues with mapping and nconc accumulation

See merge request !162
parents 33f11724 a8ced15b
Loading
Loading
Loading
Loading
Loading
+4 −1
Original line number Diff line number Diff line
@@ -1050,7 +1050,10 @@
	(setf (car l) (cdar l)))
      (setq res (apply function (nreverse args)))
      (case accumulate
	(:nconc (setq temp (last (nconc temp res))))
	(:nconc (when res
		  (let ((next-temp (last res)))
		    (rplacd temp res)
		    (setq temp next-temp))))
	(:list (rplacd temp (list res))
	       (setq temp (cdr temp)))))))

+8 −2
Original line number Diff line number Diff line
@@ -36,12 +36,18 @@
	  (ecase accumulate
	    (:nconc
	     (let ((temp (gensym))
		   (map-result (gensym)))
		   (map-result (gensym))
		   (res (gensym))
		   (next-temp (gensym)))
	       `(let ((,map-result (list nil)))
		  (declare (dynamic-extent ,map-result))
		  (do-anonymous ((,temp ,map-result) . ,(do-clauses))
				 (,endtest (cdr ,map-result))
		    (setq ,temp (last (nconc ,temp ,call)))))))
		    (let ((,res ,call))
		      (when ,res
			(let ((,next-temp (last ,res)))
			  (rplacd ,temp ,res)
			  (setq ,temp ,next-temp))))))))
	    (:list
	     (let ((temp (gensym))
		   (map-result (gensym)))

tests/list.lisp

0 → 100644
+193 −0
Original line number Diff line number Diff line
(defpackage "LIST-TESTS"
  (:use "COMMON-LISP"
	"LISP-UNIT"))

(in-package "LIST-TESTS")

(define-test mapcan-empty-list-returns-nil
  (locally (declare (notinline mapcan))
    (assert-equal '() (mapcan #'identity '())))
  (locally (declare (inline mapcan))
    (assert-equal '() (mapcan #'identity '()))))

(define-test mapcon-empty-list-returns-nil
  (locally (declare (notinline mapcon))
    (assert-equal '() (mapcon #'identity '())))
  (locally (declare (inline mapcon))
    (assert-equal '() (mapcon #'identity '()))))

(define-test mapcan-accumulate-non-nil-signals-type-error
  (locally (declare (notinline mapcan))
    (assert-error 'type-error (mapcan #'identity (list 42))))
  (locally (declare (inline mapcan))
    (assert-error 'type-error (mapcan #'identity (list 42)))))

(define-test mapcon-accumulate-non-nil-signals-type-error
  (locally (declare (notinline mapcan))
    (assert-error 'type-error (mapcon #'car (list 42))))
  (locally (declare (inline mapcan))
    (assert-error 'type-error (mapcon #'car (list 42)))))

(define-test mapcan-accumulate-nil-returns-nil
  (locally (declare (notinline mapcan))
    (assert-equal '() (mapcan (constantly nil) '(1)))
    (assert-equal '() (mapcan (constantly nil) '(1 2)))
    (assert-equal '() (mapcan (constantly nil) '(1 2 3))))
  (locally (declare (inline mapcan))
    (assert-equal '() (mapcan (constantly nil) '(1)))
    (assert-equal '() (mapcan (constantly nil) '(1 2)))
    (assert-equal '() (mapcan (constantly nil) '(1 2 3)))))

(define-test mapcon-accumulate-nil-returns-nil
  (locally (declare (notinline mapcon))
    (assert-equal '() (mapcon (constantly nil) '(1)))
    (assert-equal '() (mapcon (constantly nil) '(1 2)))
    (assert-equal '() (mapcon (constantly nil) '(1 2 3))))
  (locally (declare (inline mapcon))
    (assert-equal '() (mapcon (constantly nil) '(1)))
    (assert-equal '() (mapcon (constantly nil) '(1 2)))
    (assert-equal '() (mapcon (constantly nil) '(1 2 3)))))

(define-test mapcan-accumulate-one-list-returns-same-list
  (locally (declare (notinline mapcan))
    (let ((list1 (list 1)))
      (assert-eq list1 (mapcan (constantly list1) '(nil)))))
  (locally (declare (inline mapcan))
    (let ((list1 (list 1)))
      (assert-eq list1 (mapcan (constantly list1) '(nil))))))

(define-test mapcon-accumulate-one-list-returns-same-list
  (locally (declare (notinline mapcon))
    (let ((list1 (list 1)))
      (assert-eq list1 (mapcon (constantly list1) '(nil)))))
  (locally (declare (inline mapcon))
    (let ((list1 (list 1)))
      (assert-eq list1 (mapcon (constantly list1) '(nil))))))

(define-test mapcan-accumulate-two-lists-returns-same-lists
  (locally (declare (notinline mapcan))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12))))
  (locally (declare (inline mapcan))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))))

(define-test mapcon-accumulate-two-lists-returns-same-lists
  (locally (declare (notinline mapcon))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12))))
  (locally (declare (inline mapcon))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))))

(define-test mapcan-accumulate-two-lists-skips-nil-returns-same-lists
  (locally (declare (notinline mapcan))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list nil list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 nil list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 list2 nil))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12))))
  (locally (declare (inline mapcan))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list nil list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 nil list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcan #'identity (list list1 list2 nil))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))))

(define-test mapcon-accumulate-two-lists-skips-nil-returns-same-lists
  (locally (declare (notinline mapcon))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list nil list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 nil list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 list2 nil))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12))))
  (locally (declare (inline mapcon))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list nil list1 list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 nil list2))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))
    (let* ((list1 (list 1))
	   (list2 (list 2))
	   (list12 (mapcon #'car (list list1 list2 nil))))
      (assert-eq list1 list12)
      (assert-eq list2 (cdr list12)))))

(define-test mapcan-accumulate-same-list-twice-returns-circular-list
  (locally (declare (notinline mapcan))
    (let ((list12 (list 1 2)))
      ;; check that list12 equals #1=(1 2 . #1#)
      (assert-eq list12 (mapcan (constantly list12) '(nil nil)))
      (assert-eql 1 (elt list12 0))
      (assert-eql 2 (elt list12 1))
      (assert-eq (nthcdr 2 list12) list12)))
  (locally (declare (inline mapcan))
    (let ((list12 (list 1 2)))
      ;; check that list12 equals #1=(1 2 . #1#)
      (assert-eq list12 (mapcan (constantly list12) '(nil nil)))
      (assert-eql 1 (elt list12 0))
      (assert-eql 2 (elt list12 1))
      (assert-eq (nthcdr 2 list12) list12))))

(define-test mapcon-accumulate-same-list-twice-returns-circular-list
  (locally (declare (notinline mapcon))
    (let ((list12 (list 1 2)))
      ;; check that list12 equals #1=(1 2 . #1#)
      (assert-eq list12 (mapcon (constantly list12) '(nil nil)))
      (assert-eql 1 (elt list12 0))
      (assert-eql 2 (elt list12 1))
      (assert-eq (nthcdr 2 list12) list12)))
  (locally (declare (notinline mapcon))
    (let ((list12 (list 1 2)))
      ;; check that list12 equals #1=(1 2 . #1#)
      (assert-eq list12 (mapcon (constantly list12) '(nil nil)))
      (assert-eql 1 (elt list12 0))
      (assert-eql 2 (elt list12 1))
      (assert-eq (nthcdr 2 list12) list12))))