[rucksack-cvs] CVS rucksack

[alemmens]

Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv30226/rucksack

Modified Files:
	queue.lisp 
Log Message:
Fix bug in QUEUE-PEEK (fix from Edi Weitz).


--- /project/rucksack/cvsroot/rucksack/queue.lisp	2006/05/16 22:01:27	1.2
+++ /project/rucksack/cvsroot/rucksack/queue.lisp	2006/05/18 22:09:40	1.3
@@ -1,4 +1,4 @@
-;; $Id: queue.lisp,v 1.2 2006/05/16 22:01:27 alemmens Exp $
+;; $Id: queue.lisp,v 1.3 2006/05/18 22:09:40 alemmens Exp $
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Queues
@@ -78,12 +78,11 @@
     (if (null contents)
         (and errorp
              (error 'empty-queue-error :queue queue))
-      (let ((result (first contents)))
-        (setf contents (rest contents))
+      (prog1
+          (pop contents)
         (when (null contents)
-          (setf end nil))
-        (decf size)
-        result))))
+          (setq end nil))
+        (decf size)))))
 
 
 (defun queue-empty-p (queue)
@@ -96,13 +95,17 @@
   "Returns the first object in the queue that has the given type (and removes
 all objects from the queue before it).  Returns NIL (and clears the entire queue)
 if there is no such object."
-  (with-slots (contents)
+  (with-slots (contents size end)
       queue
     (loop while (and contents 
                      (not (typep (first contents) type)))
-          do (setq contents (rest contents)))
+          do (decf size)
+             (pop contents))
+    (when (null contents)
+      (setq end nil))
     (first contents)))
 
+
 (defun queue-clear (queue)
   "Removes all elements from the queue (and returns the empty queue)."
   (with-slots (end contents size)