[anaphora-cvs] CVS src

[jsquires]

Update of /project/anaphora/cvsroot/src
In directory common-lisp:/tmp/cvs-serv24465

Modified Files:
	anaphora.lisp packages.lisp tests.lisp 
Log Message:
Added Gary King's aprog1.
Updated tests.


--- /project/anaphora/cvsroot/src/anaphora.lisp	2006/02/17 20:53:59	1.2
+++ /project/anaphora/cvsroot/src/anaphora.lisp	2006/02/18 12:46:07	1.3
@@ -48,6 +48,11 @@
 	   ,then
 	   (symbolic ignore-first ,test ,else))))
 
+(defmacro aprog1 (first &body rest)
+  "Binds IT to the first form so that it can be used in the rest of the
+forms. The whole thing returns IT."
+  `(anaphoric prog1 ,first , at rest))
+
 (defmacro awhen (test &body body)
   "Like WHEN, except bind the result of the test to IT (via LET) for the scope
 of the body."
--- /project/anaphora/cvsroot/src/packages.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/packages.lisp	2006/02/18 12:46:07	1.2
@@ -11,6 +11,7 @@
    #:aand
    #:sor
    #:awhen
+   #:aprog1
    #:acase
    #:aecase
    #:accase
--- /project/anaphora/cvsroot/src/tests.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/tests.lisp	2006/02/18 12:46:07	1.2
@@ -318,6 +318,13 @@
 	   (t :yes))
   :yes)
 
+;; Test COND with multiple forms in the implicit progn.
+(deftest acond.4
+    (let ((foo))
+      (acond ((+ 2 2) (setf foo 38) (incf foo it) foo)
+	     (t nil)))
+  42)
+
 (deftest scond.1
     (let ((x (list nil))
 	  (y (list t)))
@@ -341,4 +348,8 @@
 		(setf it tmp)))))
   "/tmp/")
 
-
+(deftest aprog.1
+    (aprog1 :yes
+      (unless (eql it :yes) (error "Broken."))
+      :no)
+  :yes)