67 KiB
67 KiB
From Emacs Lisp to Common Lisp
- Introduction
- Elisp Regression Testing of "queue.el"
- Translate "queue.el" to "queue.lisp"
- Validation of package "queue"
- Common Lisp "QUEUE" regression testing
- Failing list based "QUEUE-LIST" Emacs Lisp implementation
- Failing list based "QUEUE-LIST" Common Lisp implementation
- Common Lisp Code Critique
- Fiveam Common Lisp Regression Testing Framework
- Common Lisp "How do you DO?" do-loop example
- Why I like CALL-WITH-* style in macros
,#+latex_header: <<latex-header>>\clearpage
Introduction
The Emacs Lisp queue library (src_emacs-lisp{(describe-package 'queue)})
implements a QUEUE by means of a cl-defstruct holding the head and the
rear of the QUEUE. Here, I re-implement a QUEUE in by translating the
Emacs Lisp queue.el file to the Common Lisp queue.lisp file.
Note: I am trying to implement similar functionality starting from the form
(list nil nil) instead of the queue structure. This attempt is either
impossible or unsuccessful.
Elisp Regression Testing of "queue.el"
The file test-queue.el contains an implementation of Elisp Regression Testing
for queue.el. Implementing test-queue.el clarifies the queue.el client
contract which is useful for any re-implementation of queue.el in Emacs Lisp
or Common Lisp. The file test-queue.el has been tangled from listings
lst:test-queue-1, lst:test-queue-2, and lst:test-queue-3.
;;; test-queue.el --- ERT for queue.el -*- lexical-binding: t; -*-
(require 'ert)
(require 'queue)
(ert-deftest queue-create-test ()
(let ((queue (queue-create)))
(should (equal t (and (equal (queue-head queue) nil)
(equal (queue-tail queue) nil))))))
(ert-deftest queue-enqueue-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-create)))
(dolist (item datum)
(queue-enqueue queue item))
(should (equal t (and (equal datum (queue-head queue))
(equal (list (car (reverse datum)))
(queue-tail queue)))))))))
(ert-deftest queue-dequeue-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-create)))
(dolist (item datum)
(queue-enqueue queue item))
(let (mutad)
(dotimes (n (length datum))
(push (queue-dequeue queue) mutad))
(should (equal datum (reverse mutad))))))))
(ert-deftest queue-prepend-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-create)) enqueue prepend)
;; Enqueue/prepend items at even/odd positions:
(dotimes (n (length datum))
(let ((item (nth n datum)))
(if (= 0 (mod n 2))
(progn
(push item enqueue)
(queue-enqueue queue item))
(push item prepend)
(queue-prepend queue item))))
(should (equal (append prepend (reverse enqueue))
(queue-all queue)))))))(ert-deftest queue-empty-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-create)))
(queue-clear queue)
(dolist (item datum)
(queue-enqueue queue item))
(dotimes (count (1- (length datum)))
(queue-dequeue queue))
;; Check that QUEUE is not empty:
(should (equal nil (queue-empty queue)))
(queue-dequeue queue)
;; Check that QUEUE is empty:
(should (equal t (queue-empty queue)))))))
(ert-deftest queue-copy-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((one (queue-create)) two)
(dolist (item datum)
(queue-enqueue one item))
;; Check that the queues have identical contents.
(setq two (queue-copy one))
(should (equal t (and (equal (queue-head one) (queue-head two))
(equal (queue-tail one) (queue-tail two)))))
;; Check that changing queue ONE does not change queue TWO.
(dotimes (count (length datum))
(queue-dequeue one))
(should (equal t (and (equal nil (queue-head one))
(equal nil (queue-tail one))
(equal datum (queue-head two))
(equal (list (car (reverse datum)))
(queue-tail two)))))
;; Check that changing queue TWO does not change queue ONE.
(setq one (queue-copy two))
(setq two (queue-copy one))
(queue-clear two)
(should (equal t (and (equal nil (queue-head two))
(equal nil (queue-tail two))
(equal datum (queue-head one))
(equal (list (car (reverse datum)))
(queue-tail one)))))))))(ert-deftest queue-iterator-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-create)))
(dolist (item datum)
(queue-enqueue queue item))
(let ((queue-iterator (queue-iter queue)))
(dotimes (n (length datum))
(should (equal (nth n datum) (iter-next queue-iterator)))))))))
;;; test-queue.el ends hereTranslate "queue.el" to "queue.lisp"
The queue.lisp file is a translation to Common Lisp of queue.el. The
translation is wrapped in a Common Lisp package definition named queue. The
design of the queue package offers its client code to use the exported symbols
queue:all, queue:clear, queue:copy, queue:create, queue:dequeue,
queue:empty, queue:enqueue, queue:first, queue:head, queue:last,
queue:length, queue:nth, queue:p, queue:prepend, and queue:tail.
Limit access to the private queue::queue structure to reading documentation
with for instance (describe-object 'queue::queue t).
The queue.lisp code has a package header section, a code section which contains
the translation of queue.el to Common Lisp, and package footer section. The
package footer section defines a kind of short function aliases that the package
header section exports. See The Common Lisp Cookbook: Packages for additional
information.
The translation takes into account the following points:
(setcar place content)must be replaced with(setf (car place content)).(setcdr place content)must be replaced with(setf (cdr place content)).- The
whileloop in the Emacs Lisp version ofqueue-copyis no valid Common Lisp, where it has been replaced with adotimesloop in listing lst:2nd-part-queue.lisp. - Chris Riesbeck's code critique recommends to replace recursively
(cons item nil)with(list item).
Section #sec:queue-code-critiques shows that only the Common Lisp implementation
of queue-nth fails to pass the code critique implying that client code should
not use queue:nth. In order to ensure that the queue.lisp code is robust:
- Validate all compiler message by loading queue.lisp as shown in section #sec:queue-loading-check
- Validate all external symbols of queue.lisp as shown in section #sec:queue-externals-check.
- Write a test suite as client code of queue.lisp as shown in section #sec:queue-client-testing.
Note: ensure that there is an operational sly-mrepl-mode buffer by means of
executing for instance src_emacs-lisp{(call-interactively 'sly)} and execute
src_emacs-lisp{(sly-hyperspec-lookup "fdefinition")} to read the fdefinition
documentation; fdefinition is used in listing lst:3rd-part-queue.lisp to
define the short function aliases for export in listing lst:1st-part-queue.lisp.
;;; queue.lisp --- a translation of queue.el to Common Lisp
;;; Package header:
(defpackage queue
(:use :cl)
;; Beware of shadowing!
(:shadow :first :last :length :nth)
;; Use the short function names defined near the end of this file!
;; Export all 15 functions!
;; No `queue' structure export because of package name symbol conflicts!
(:export #:all #:clear #:copy #:create #:dequeue #:empty #:enqueue
#:first #:head #:last #:length #:nth #:p #:prepend #:tail))
(in-package :queue)
;;; Code:
(defstruct queue
"QUEUE structure holding the HEAD and the TAIL of QUEUE.
HEAD is a list of all items and TAIL is a list of the last item.
QUEUE is empty when HEAD and TAIL are nil."
(head) (tail))
(defun queue-enqueue (queue item)
"Add ITEM to the end of QUEUE."
(if (queue-head queue)
(setf (cdr (queue-tail queue))
(setf (queue-tail queue) (list item)))
(setf (queue-head queue)
(setf (queue-tail queue) (list item)))))
(defun queue-prepend (queue item)
"Add ITEM before the front of QUEUE."
(if (queue-head queue)
(push item (queue-head queue))
(setf (queue-head queue)
(setf (queue-tail queue) (list item)))))
(defun queue-dequeue (queue)
"Remove the first item of QUEUE and return it.
Return nil if QUEUE is empty."
(unless (cdr (queue-head queue))
(setf (queue-tail queue) nil))
(pop (queue-head queue)))
(defun queue-empty (queue)
"Return t if QUEUE is empty, otherwise return nil."
(null (queue-head queue)))(defun queue-first (queue)
"Return the first item in QUEUE, without removing it.
Return nil if QUEUE is empty."
(car (queue-head queue)))
(defun queue-nth (queue n)
"Return the item at index N in QUEUE, without removing it.
Return nil if the length of QUEUE is less than N.
The first item in QUEUE has index 0."
(cl:nth n (queue-head queue)))
(defun queue-last (queue)
"Return the last item in QUEUE, without removing it.
Return nil if QUEUE is empty."
(car (queue-tail queue)))
(defun queue-all (queue)
"Return a list of all items in QUEUE or nil if QUEUE is empty.
The oldest item in QUEUE is the first in the list."
(queue-head queue))
(defun queue-copy (queue)
"Return a copy of QUEUE.
The new queue contains all items of QUEUE in the same order.
The items themselves are *not* copied."
(let ((q (make-queue))
(items (queue-head queue)))
(when (queue-head queue)
(setf (queue-head q) (list (car (queue-head queue)))
(queue-tail q) (queue-head q))
(dotimes (count (1- (cl:length items)))
(setq items (cdr items))
(setf (queue-tail q)
(setf (cdr (queue-tail q)) (list (car items))))))
q))
(defun queue-length (queue)
"Return the number of items in QUEUE."
(cl:length (queue-head queue)))
(defun queue-clear (queue)
"Remove all items from QUEUE."
(setf (queue-head queue) nil
(queue-tail queue) nil));;; Package footer:
;;; Make short function names for export with prefix `queue:' in `defpackage'.
(setf (fdefinition 'all) #'queue-all)
(setf (fdefinition 'clear) #'queue-clear)
(setf (fdefinition 'copy) #'queue-copy)
(setf (fdefinition 'create) #'make-queue)
(setf (fdefinition 'dequeue) #'queue-dequeue)
(setf (fdefinition 'empty) #'queue-empty)
(setf (fdefinition 'enqueue) #'queue-enqueue)
(setf (fdefinition 'first) #'queue-first)
(setf (fdefinition 'head) #'queue-head)
(setf (fdefinition 'last) #'queue-last)
(setf (fdefinition 'length) #'queue-length)
(setf (fdefinition 'nth) #'queue-nth)
(setf (fdefinition 'prepend) #'queue-prepend)
(setf (fdefinition 'p) #'queue-p)
(setf (fdefinition 'tail) #'queue-tail)
;;; queue.lisp ends here\clearpage
Code critiques of "queue.lisp"
Execution of listing lst:1st-part-queue-critiques, lst:2nd-part-queue-critiques,
and lst:3rd-part-queue-critiques may require prior execution of listing
lst:load-cs325 (or its equivalence) to ql:quickload the :cs325 package.
(critique
(defstruct queue
"QUEUE structure holding the HEAD and the TAIL of QUEUE.
HEAD is a list of all items and TAIL is a list of the last item.
QUEUE is empty when HEAD and TAIL are nil."
(head) (tail)))
(critique
(defun queue-enqueue (queue item)
"Add ITEM to the end of QUEUE."
(if (queue-head queue)
(setf (cdr (queue-tail queue))
(setf (queue-tail queue) (list item)))
(setf (queue-head queue)
(setf (queue-tail queue) (list item))))))
(critique
(defun queue-prepend (queue item)
"Add ITEM before the front of QUEUE."
(if (queue-head queue)
(push item (queue-head queue))
(setf (queue-head queue)
(setf (queue-tail queue) (list item))))))
(critique
(defun queue-dequeue (queue)
"Remove the first item of QUEUE and return it.
Return nil if QUEUE is empty."
(unless (cdr (queue-head queue))
(setf (queue-tail queue) nil))
(pop (queue-head queue))))
(critique
(defun queue-empty (queue)
"Return t if QUEUE is empty, otherwise return nil."
(null (queue-head queue))))(critique
(defun queue-first (queue)
"Return the first item in QUEUE, without removing it.
Return nil if QUEUE is empty."
(car (queue-head queue))))
;; CRITIQUE says of QUEUE-NTH:
;; (NTH ...) is expensive. Lists are not arrays.
;; Hint: use FIRST, REST, and/or a pointer to access elements of a list
(critique
(defun queue-nth (queue n)
"Return the item at index N in QUEUE, without removing it.
Return nil if the length of QUEUE is less than N.
The first item in QUEUE has index 0."
(cl:nth n (queue-head queue))))
(critique
(defun queue-last (queue)
"Return the last item in QUEUE, without removing it.
Return nil if QUEUE is empty."
(car (queue-tail queue))))
(critique
(defun queue-all (queue)
"Return a list of all items in QUEUE or nil if QUEUE is empty.
The oldest item in QUEUE is the first in the list."
(queue-head queue)))(critique
(defun queue-copy (queue)
"Return a copy of QUEUE.
The new queue contains all items of QUEUE in the same order.
The items themselves are *not* copied."
(let ((q (make-queue))
(items (queue-head queue)))
(when (queue-head queue)
(setf (queue-head q) (list (car (queue-head queue)))
(queue-tail q) (queue-head q))
(dotimes (count (1- (length items)))
(setq items (cdr items))
(setf (queue-tail q)
(setf (cdr (queue-tail q)) (list (car items))))))
q)))
(critique
(defun queue-length (queue)
"Return the number of items in QUEUE."
(length (queue-head queue))))
(critique
(defun queue-clear (queue)
"Remove all items from QUEUE."
(setf (queue-head queue) nil
(queue-tail queue) nil)))Validation of package "queue"
Validation of all "queue" package loading loading messages
(load "queue.lisp" :verbose t :print t); loading #P"/Users/vermeulen/.emacs.d/queue.lisp"
; #<PACKAGE "QUEUE">
; #<PACKAGE "QUEUE">
; QUEUE
; QUEUE-ENQUEUE
; QUEUE-PREPEND
; QUEUE-DEQUEUE
; QUEUE-EMPTY
; QUEUE-FIRST
; QUEUE-NTH
; QUEUE-LAST
; QUEUE-ALL
; QUEUE-COPY
; QUEUE-LENGTH
; QUEUE-CLEAR
; #<FUNCTION QUEUE-ALL>
; #<FUNCTION QUEUE-CLEAR>
; #<FUNCTION QUEUE-COPY>
; #<FUNCTION MAKE-QUEUE>
; #<FUNCTION QUEUE-DEQUEUE>
; #<FUNCTION QUEUE-EMPTY>
; #<FUNCTION QUEUE-ENQUEUE>
; #<FUNCTION QUEUE-FIRST>
; #<FUNCTION QUEUE-HEAD>
; #<FUNCTION QUEUE-LAST>
; #<FUNCTION QUEUE-LENGTH>
; #<FUNCTION QUEUE-NTH>
; #<FUNCTION QUEUE-PREPEND>
; #<FUNCTION QUEUE-P>
; #<FUNCTION QUEUE-TAIL>queue package loading messages.
\clearpage
Validation of all external "queue" package symbols
;; BUG: Remove the first empty line of the output. This is not easy!
(do-external-symbols (s (find-package :queue))
(print s))QUEUE:HEAD
QUEUE:LAST
QUEUE:DEQUEUE
QUEUE:LENGTH
QUEUE:PREPEND
QUEUE:FIRST
QUEUE:NTH
QUEUE:ENQUEUE
QUEUE:COPY
QUEUE:CREATE
QUEUE:P
QUEUE:ALL
QUEUE:EMPTY
QUEUE:CLEAR
QUEUE:TAILqueue package symbols.
Common Lisp "QUEUE" regression testing
Listing lst:5am-test-queue-header, lst:5am-test-queue-create, lst:5am-test-queue-enqueue, lst:5am-test-queue-prepend, lst:5am-test-queue-empty, lst:5am-test-queue-first, lst:5am-test-queue-nth, lst:5am-test-queue-last, lst:5am-test-queue-all, lst:5am-test-queue-copy, lst:5am-test-queue-length, lst:5am-test-queue-clear and lst:5am-test-queue-footer are tangled into test-queue.lisp.
;;; test-queue.lisp --- 5am regression testing of queue.lisp
(ql:quickload :fiveam)
(load "queue.lisp" :verbose t :print t)
(5am:def-suite all-queue-tests)
(5am:in-suite all-queue-tests)(5am:test test-queue-create
"Test queue:create."
(let ((queue (queue:create)))
(5am:is (eq nil (queue:head queue))
"Not: (eq nil (queue:head queue))")
(5am:is (eq nil (queue:tail queue))
"Not: (eq nil (queue:tail queue))")))(5am:run! 'test-queue-create)#+begin_"src text -n
Running test TEST-QUEUE-CREATE .. Did 2 checks. Pass: 2 (100%) Skip: 0 ( 0%) Fail: 0 ( 0%) #+end_"src
(5am:test test-queue-enqueue
"Test queue:enqueue."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (equal (queue:head queue) datum)
"Not: (equal (queue:head queue) datum)")
(5am:is (eq (car (queue:tail queue)) (car (reverse datum)))
"Not: (eq (car (queue:tail queue)) (car (reverse datum)))")))))(5am:run! 'test-queue-enqueue)Running test TEST-QUEUE-ENQUEUE ....................
Did 20 checks.
Pass: 20 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-prepend
"Test queue:prepend."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:prepend queue item))
(5am:is (equal (queue:head queue) (reverse datum))
"Not: (equal (queue:head queue) (reverse datum))")
(5am:is (eq (car (queue:tail queue)) (car datum))
"Not: (eq (car (queue:tail queue)) (car datum))")))))(5am:run! 'test-queue-prepend)Running test TEST-QUEUE-PREPEND ....................
Did 20 checks.
Pass: 20 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-dequeue
"Test queue:dequeue."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(5am:is (not (car (queue:dequeue (queue:create))))
"Not: (not (car (queue:dequeue (queue:create))))")
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(dotimes (n (length datum))
(5am:is (equal (queue:dequeue queue) (cl:nth n datum))
"Not: (equal (queue:dequeue queue) (cl:nth n datum))"))))))(5am:run! 'test-queue-dequeue)Running test TEST-QUEUE-DEQUEUE ...............................
Did 31 checks.
Pass: 31 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-empty
"Test queue:empty."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(dotimes (count (1- (length datum)))
(queue:dequeue queue))
(5am:is (not (queue:empty queue)) "Not: (not (queue:empty queue))")
(queue:dequeue queue)
(5am:is (queue:empty queue) "Not: (queue:empty queue)")))))(5am:run! 'test-queue-empty)Running test TEST-QUEUE-EMPTY ....................
Did 20 checks.
Pass: 20 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-first
"Test queue:first."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (eq (queue:first queue) (car datum))
"Not: (eq (queue:first queue) (car datum))")
(5am:is (equal (queue:head queue) datum)
"Not: (equal (queue:head queue) datum)")))))(5am:run! 'test-queue-first)Running test TEST-QUEUE-FIRST ....................
Did 20 checks.
Pass: 20 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-nth
"Test queue:nth."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(dotimes (n (1- (length datum)))
(5am:is (eq (queue:nth queue n) (cl:nth n datum))
"Not: (eq (queue:nth queue n) (cl:nth n datum))")
(5am:is (not (queue:nth queue (length datum)))
"Not: (not (queue:nth queue (length datum)))"))))))(5am:run! 'test-queue-nth)Running test TEST-QUEUE-NTH ........................................
Did 40 checks.
Pass: 40 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-last
"Test queue:last."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(5am:is (eq (queue:last (queue:create)) nil)
"Not: (eq (queue:last (queue:create)) nil)")
(dolist (datum data)
(let ((queue (queue:create)))
(queue:clear queue)
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (eq (queue:last queue) (car (reverse datum)))
"Not: (eq (queue:last queue) (car (reverse datum)))")))))(5am:run! 'test-queue-last)Running test TEST-QUEUE-LAST ...........
Did 11 checks.
Pass: 11 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-all
"Test queue:all."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(5am:is (eq (queue:all (queue:create)) nil)
"Not: (eq (queue:all (queue:create)) nil)")
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (equal (queue:all queue) datum)
"Not: (equal (queue:all queue) datum)")))))(5am:run! 'test-queue-all)Running test TEST-QUEUE-ALL ...........
Did 11 checks.
Pass: 11 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-copy
"Test queue:copy."
(let ((one (queue:create))
(two nil)
(data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(queue:clear one)
(dolist (item datum)
(queue:enqueue one item))
;; Check for equality of ORIGINAL and COPY:
(setq two (queue:copy one)) ;;
(5am:is (equal (queue:head one) (queue:head two))
"Not: (equal (queue:head one) (queue:head two))")
(5am:is (equal (queue:tail one) (queue:tail two))
"Not: (equal (queue:tail one) (queue:tail two))")
;; Check that the COPY does not share structure with the ORIGINAL:
(queue:clear one)
(5am:is (eq nil (queue:head one))
"Not: (eq nil (queue:head one))")
(5am:is (eq nil (queue:tail one))
"Not: (eq nil (queue:tail one))")
(5am:is (equal (queue:head two) datum)
"Not: (equal (queue:head two) datum)")
(5am:is (eq (car (queue:tail two)) (car (reverse datum)))
"Not: (eq (car (queue:tail two)) (car (reverse datum)))")
;; Check that the ORIGINAL does not share structure with the COPY:
(setq one (queue:copy two))
(setq two (queue:copy one))
(queue:clear two)
(5am:is (eq nil (queue:head two))
"Not: (eq nil (queue:head two))")
(5am:is (eq nil (queue:tail two))
"Not: (eq nil (queue:tail two))")
(5am:is (equal (queue:head one) datum)
"Not: (equal (queue:head one) datum)")
(5am:is (eq (car (queue:tail one)) (car (reverse datum)))
"Not: (eq (car (queue:tail one)) (car (reverse datum)))"))))(5am:run! 'test-queue-copy)Running test TEST-QUEUE-COPY ....................................................................................................
Did 100 checks.
Pass: 100 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-length
"Test queue:all."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(5am:is (eq (queue:length (queue:create)) (cl:length nil))
"Not: (eq (queue:length (queue:create)) (cl:length nil))")
(dolist (datum data)
(let ((queue (queue:create)))
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (equal (queue:length queue) (cl:length datum))
"Not: (queue:length queue) (cl:length datum)")))))(5am:run! 'test-queue-length)Running test TEST-QUEUE-LENGTH ...........
Did 11 checks.
Pass: 11 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-clear
"Test queue:clear."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
(queue (queue:create)))
(5am:is (queue:empty queue) "Not: (queue:empty queue)")
(dolist (datum data)
(queue:clear queue)
(5am:is (queue:empty queue) "Not: (queue:empty queue)")
(dolist (item datum)
(queue:enqueue queue item))
(5am:is (not (queue:empty queue)) "Not: (not (queue:empty queue))"))))(5am:run! 'test-queue-clear)Running test TEST-QUEUE-CLEAR .....................
Did 21 checks.
Pass: 21 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:run! 'all-queue-tests)
;;; test-queue.lisp ends hereRunning test suite ALL-QUEUE-TESTS
Running test TEST-QUEUE-CREATE ..
Running test TEST-QUEUE-ENQUEUE ....................
Running test TEST-QUEUE-PREPEND ....................
Running test TEST-QUEUE-DEQUEUE ...............................
Running test TEST-QUEUE-EMPTY ....................
Running test TEST-QUEUE-FIRST ....................
Running test TEST-QUEUE-NTH ........................................
Running test TEST-QUEUE-LAST ...........
Running test TEST-QUEUE-ALL ...........
Running test TEST-QUEUE-COPY ....................................................................................................
Running test TEST-QUEUE-LENGTH ...........
Running test TEST-QUEUE-CLEAR .....................
Did 307 checks.
Pass: 307 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)Failing list based "QUEUE-LIST" Emacs Lisp implementation
Using (list nil nil) to keep track of the head and the tail of queue does
not work because emptying queue by calling (queue-list-dequeue queue) breaks
an invariant. Now, queue equals the bad (list nil) instead of the good
(list nil nil) which I cannot fix.
Listing lst:queue-list-el shows a minimal queue-list implementation and where
the implementation breaks down in the code of queue-list-dequeue.
Listing lst:test-queue-list-el shows Emacs Lisp regression tests of the
functions defined in listing lst:queue-list-el and where in
queue-list-dequeue-test the regression test of queue-list-dequeue fails.
;;; queue-list.el --- handle queues of items -*- lexical-binding: t; -*-
;;;
;;; Start from an empty queue equal to (list nil nil)
(defun queue-list-create ()
"Create an empty queue."
(list nil nil))
(defun queue-list-enqueue (queue item)
"Add ITEM to the rear of QUEUE."
(if (car queue)
(setcdr (cadr queue) (setf (cadr queue) (list item)))
(setcar queue (car (setcdr queue (list (list item)))))))
(defun queue-list-prepend (queue item)
"Add ITEM in front of the QUEUE head."
(if (car queue)
(push item (car queue))
(setcar queue (car (setcdr queue (list (list item)))))))
(defun queue-list-dequeue (queue)
"Remove the first ITEM from QUEUE and return it.
Returns nil if QUEUE is empty."
(unless (cdr (car queue))
;; BUG: but how to obtain (list nil nil)?
(setf (cdr queue) nil))
(pop (car queue)))
(provide 'queue-list)
;;; queue-list.el ends here;;; test-queue-list.el --- ERT for queue-list.el -*- lexical-binding: t; -*-
(require 'ert)
(require 'queue-list)
(ert-deftest queue-list-create-test ()
(should (equal (queue-list-create) (list nil nil))))
(ert-deftest queue-list-enqueue-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-enqueue queue item))
(should (equal queue (list datum (list (car (reverse datum))))))))))
(ert-deftest queue-list-prepend-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-prepend queue item))
(should (equal queue (list (reverse datum) (list (car datum)))))))))
(ert-deftest queue-list-dequeue-test ()
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-enqueue queue item))
(let (mutad)
(dotimes (n (1- (length datum)))
(push (queue-list-dequeue queue) mutad))
(should (equal (car (cadr queue)) (car (reverse datum))))
(push (queue-list-dequeue queue) mutad)
;; BUG: queue equals wrong (list nil) instead of good (list nil nil).
(should (equal datum (reverse mutad)))
(should (equal (car queue) nil))
(should (equal queue (list nil))) ;; should fail, but it does not.
(should (equal (cdr queue) '(nil))) ;; should pass, but it does not.
)))))
;;; test-queue-list.el ends hereFailing list based "QUEUE-LIST" Common Lisp implementation
Listing lst:queue-list is tangled into queue-list.el and listing lst:5am-test-queue-list-header, lst:5am-test-queue-list-create, lst:5am-test-queue-list-enqueue, lst:5am-test-queue-list-prepend, lst:5am-test-queue-list-dequeue, and lst:5am-test-queue-list-footer are tangled into test-queue-list.el
;;; queue-list.lisp --- handle queues of items
;;;
;;; Start from an empty queue equal to (list nil nil)
(defun queue-list-create ()
"Create an empty keu."
(list nil nil))
;; BUG: in case of `(null item)'
(defun queue-list-enqueue (queue item)
"Add ITEM to the rear of QUEUE."
(if (car queue)
(setf (cdr (cadr queue)) (setf (cadr queue) (list item)))
(setf (car queue) (car (setf (cdr queue) (list (list item)))))))
(defun queue-list-prepend (queue item)
"Add ITEM in front of the QUEUE head."
(if (car queue)
(push item (car queue))
(setf (car queue) (car (setf (cdr queue) (list (list item)))))))
(defun queue-list-dequeue (queue)
"Remove the first ITEM from QUEUE and return it.
Returns nil if the QUEUE is empty."
(unless (cdr (car queue))
;; BUG: but how to obtain (list nil nil)?
(setf (cdr queue) nil))
(pop (car queue)))
;;; queue-list.lisp ends here;;; test-queue-list.lisp --- 5am regression testing of queue-lisp.lisp
(ql:quickload :fiveam)
(load "queue-list.lisp" :verbose t :print t)
(5am:def-suite all-queue-list-tests)
(5am:in-suite all-queue-list-tests)To load "fiveam":
Load 1 ASDF system:
fiveam
; Loading "fiveam"
; loading #P"/Users/vermeulen/.emacs.d/queue-list.lisp"
; QUEUE-LIST-CREATE
; QUEUE-LIST-ENQUEUE
; QUEUE-LIST-PREPEND
; QUEUE-LIST-DEQUEUE(5am:test test-queue-list-create
"Test queue-list-create."
(let ((queue (queue-list-create)))
(5am:is (eq nil (car queue))
"Not: (eq nil (car queue))")
(5am:is (eq nil (cadr queue))
"Not: (eq nil (cadr queue))")))(5am:run! 'test-queue-list-create)(5am:test test-queue-list-enqueue
"Test queue-list-enqueue."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-enqueue queue item))
(5am:is (equal (car queue) datum)
"Not: (equal (car queue) datum)")
(5am:is (eq (caadr queue) (car (reverse datum)))
"Not: (eq (car (cdr queue)) (car (reverse datum)))")))))(5am:run! 'test-queue-list-enqueue)(5am:test test-queue-list-prepend
"Test queue-list-prepend."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c))))
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-prepend queue item))
(5am:is (equal (car queue) (reverse datum))
"Not: (equal (car queue) (reverse datum))")
(5am:is (eq (caadr queue) (car datum))
"Not: (eq (caadr queue) (car datum))")))))(5am:run! 'test-queue-list-prepend)Running test TEST-QUEUE-LIST-PREPEND ....................
Did 20 checks.
Pass: 20 (100%)
Skip: 0 ( 0%)
Fail: 0 ( 0%)(5am:test test-queue-list-dequeue
"Test queue-list-dequeue."
(let ((data '((nil) (nil a) (nil a nil) (nil a nil b) (nil a nil b nil)
(a) (a nil) (a nil b) (a nil b nil) (a nil b nil c)))
(queue (queue-list-create)))
(5am:is (eq nil (queue-list-dequeue queue))
"Not: (eq nil (queue-list-dequeue queue))")
(5am:is (not (equal queue '(nil)))
"Not: (equal queue '(nil))") ;; should fail, but it does not.
(5am:is (not (equal queue '(nil nil))) ;; should pass, but it does not
"Not: (equal queue '(nil nil))")
(dolist (datum data)
(let ((queue (queue-list-create)))
(dolist (item datum)
(queue-list-enqueue queue item))
(dotimes (n (length datum))
(5am:is (equal (queue-list-dequeue queue) (cl:nth n datum))
"Not: (equal (queue-list-dequeue queue) (cl:nth n datum))"))
(5am:is (equal queue '(nil))) ;; should fail, but it does not.
(5am:is (equal queue '(nil nil))) ;; should pass, but it does not
))))(5am:run! 'test-queue-list-dequeue)Running test TEST-QUEUE-LIST-DEQUEUE .f...f...f....f.....f......f..f...f....f.....f......f
Did 53 checks.
Pass: 42 (79%)
Skip: 0 ( 0%)
Fail: 11 (20%)
Failure Details:
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
Not: (equal queue '(nil))
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------(5am:run! 'all-queue-list-tests)
;;; test-queue-list.lisp ends hereRunning test suite ALL-QUEUE-LIST-TESTS
Running test TEST-QUEUE-LIST-CREATE ..
Running test TEST-QUEUE-LIST-ENQUEUE ....................
Running test TEST-QUEUE-LIST-PREPEND ....................
Running test TEST-QUEUE-LIST-DEQUEUE .f...f...f....f.....f......f..f...f....f.....f......f
Did 95 checks.
Pass: 84 (88%)
Skip: 0 ( 0%)
Fail: 11 (11%)
Failure Details:
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
Not: (equal queue '(nil))
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------
--------------------------------
TEST-QUEUE-LIST-DEQUEUE in ALL-QUEUE-LIST-TESTS [Test queue-list-dequeue.]:
'(NIL NIL)
evaluated to
(NIL NIL)
which is not
EQUAL
to
(NIL)
--------------------------------\appendix
Common Lisp Code Critique
I use the critique macro in Chris Riesbeck's Common Lisp CS325-USER package
to improve my Common Lisp code. Therefore, I have installed the CS325 library
according to the CS325 Common Lisp Setup instructions and I have to execute
listing lst:load-cs325 (or its equivalence) to ql:quickload the :cs325
package. This is a prerequisite for executing listing
lst:1st-part-queue-critiques, lst:2nd-part-queue-critiques, and
lst:3rd-part-queue-critiques.
;; The call (ql:quickload :cs325) is equivalent.
(ql:quickload "cs325")To load "cs325":
Load 1 ASDF system:
cs325
; Loading "cs325"(critique
(defun foo (x)
(setq x (+ x 1))))----------------------------------------------------------------------
INCF would be simpler to add 1 to X than SETQ
----------------------------------------------------------------------
It's bad style to reassign input parameters like X -- and often
useless.
----------------------------------------------------------------------
Don't use (+ X 1), use (1+ X) for its value or (INCF X) to change X,
whichever is appropriate here.
----------------------------------------------------------------------Fiveam Common Lisp Regression Testing Framework
After executing listing lst:load-fiveam to ql:quickload fiveam, one can
explore this package:
- from within the
:fiveampackage in listing lst:define-5am-test-demo and lst:run-5am-test-demo. - from within the
:cl-userpackage in listing lst:define-cl-test-demo and lst:run-cl-test-demo. This point indicates how to use fiveam to test other packages.
(ql:quickload :fiveam)To load "fiveam":
Load 1 ASDF system:
fiveam
; Loading "fiveam"(test 5am-test-demo
"This demonstrates the basic use of test and check."
(is (listp (list 1 2)))
(is (= 5 (+ 2 3)) "This should pass.")
(is (= 4 4.1) "~D and ~D are not = to each other." 4 4.1))(format t "~&In package ~A:" (package-name *package*))
(run! '5am-test-demo)In package IT.BESE.FIVEAM:
Running test 5AM-TEST-DEMO ..f
Did 3 checks.
Pass: 2 (66%)
Skip: 0 ( 0%)
Fail: 1 (33%)
Failure Details:
--------------------------------
5AM-TEST-DEMO [This demonstrates the basic use of test and check.]:
4 and 4.1 are not = to each other.
--------------------------------(5am:test cl-test-demo
"This demonstrates the basic use of test and check."
(5am:is (listp (list 1 2)))
(5am:is (= 5 (+ 2 3)) "This should pass.")
(5am:is (= 4 4.1) "~D and ~D are not = to each other." 4 4.1))(format t "~&In package ~A:" (package-name *package*))
(5am:run! 'cl-test-demo)In package COMMON-LISP-USER:
Running test CL-TEST-DEMO ..f
Did 3 checks.
Pass: 2 (66%)
Skip: 0 ( 0%)
Fail: 1 (33%)
Failure Details:
--------------------------------
CL-TEST-DEMO [This demonstrates the basic use of test and check.]:
4 and 4.1 are not = to each other.
--------------------------------Common Lisp "How do you DO?" do-loop example
Listing lst:how-do-you-do is an complete do-loop example with variable
clauses, exit clauses, and a body. I have gleaned listing lst:how-do-you-do
from:
- How do you DO? by Chris Riesbeck.
- Successful Lisp: How to understand and use Common Lisp by David B. Lamkins.
(defun how-do-you-do? (items)
(let ((result))
;; do loop:
(do (;; variable clauses:
(i 1 (1+ i))
(items items (cdr items)))
(;; exit clauses:
(null items) 'done)
;; body:
(format t "~&Item ~D is ~S~%" i (car items))
(push (car items) result))
;; rest of `how-do-you-do?':
(format t "~&~A~%" (reverse result))))
(let ((items '(how do you do \?)))
(how-do-you-do? items))Item 1 is HOW
Item 2 is DO
Item 3 is YOU
Item 4 is DO
Item 5 is ?
(HOW DO YOU DO ?)Why I like CALL-WITH-* style in macros
Listing /gav451/emacs.d/src/branch/main/lst The post João Távora: permanently fix org breakage during builds links to the origin of the code in listing lst:call-with-macros.
BUG: make a concrete CALL-WITH-* macro example.
(defmacro with-foo ((foo) &body body)
`(call-with-foo (lambda (,foo) ,@body)))
(defun call-with-foo (function)
(let (foo)
(unwind-protect
(funcall function (setf foo (get-foo)))
(when foo (release-foo foo)))))