Vim window logic, slimv

sbcl/.quicklisp/dists/quicklisp/software/anaphora-20191007-git/tests.lisp

@@ -0,0 +1,427 @@
+;;;; Anaphora: The Anaphoric Macro Package from Hell
+;;;;
+;;;; This been placed in Public Domain by the author,
+;;;; Nikodemus Siivola <nikodemus@random-state.net>
+
+(defpackage :anaphora-test
+  (:use :cl :anaphora :rt))
+
+(in-package :anaphora-test)
+
+(deftest alet.1
+    (alet (1+ 1)
+      (1+ it))
+  3)
+
+(deftest alet.2
+    (alet (1+ 1)
+      it
+      (1+ it))
+  3)
+
+(deftest slet.1
+    (let ((x (list 1 2 3)))
+      (slet (car x)
+	(incf it) (values it x)))
+  2 (2 2 3))
+
+(deftest aand.1
+    (aand (+ 1 1)
+	  (+ 1 it))
+  3)
+
+(deftest aand.2
+    (aand 1 t (values it 2))
+  1 2)
+
+(deftest aand.3
+    (let ((x 1))
+      (aand (incf x) t t (values t it)))
+  t 2)
+
+(deftest aand.4
+    (aand 1 (values t it))
+  t 1)
+
+#+(or)
+;;; bug or a feature? forms like this expand to
+;;;
+;;; (let ((it (values ...))) (and it ...))
+;;;
+(deftest aand.5
+    (aand (values nil t) it)
+  nil t)
+
+(deftest sor.1
+    (let ((x (list nil)))
+      (sor (car x)
+	   (setf it t))
+      x)
+  (t))
+
+(deftest aif.1
+    (aif (+ 1 1)
+	 (+ 1 it)
+	 :never)
+  3)
+
+(deftest aif.2
+    (let ((x 0))
+      (aif (incf x)
+	   it
+	   :never))
+  1)
+
+(deftest aif.3
+    (let ((x 0))
+      (aif (eval `(and ,(incf x) nil))
+	   :never
+	   (list it x)))
+  (nil 1))
+
+(deftest sif.1
+    (let ((x (list nil)))
+      (sif (car x)
+	   (setf it :oops)
+	   (setf it :yes!))
+      (car x))
+  :yes!)
+
+(deftest sif.2
+    (let ((x (list t)))
+      (sif (car x)
+	   (setf it :yes!)
+	   (setf it :oops))
+      (car x))
+  :yes!)
+
+(deftest sif.3
+    (sif (list 1 2 3)
+	 (sif (car it)
+	      (setf it 'a)
+	      :foo))
+  a)
+
+(deftest sif.4
+    (progn
+      (defclass sif.4 ()
+	((a :initform (list :sif))))
+      (with-slots (a)
+	  (make-instance 'sif.4)
+	(sif a
+	     (sif (car it)
+		  it))))
+  :sif)
+
+(deftest asif.1
+    (let ((x (list 0)))
+      (asif (incf (car x))
+	    it
+	    (list :oops it)))
+  1)
+
+(deftest asif.2
+    (let ((x (list nil)))
+      (asif (car x)
+	    (setf x :oops)
+	    (setf it :yes!))
+      x)
+  (:yes!))
+
+(deftest awhen.1
+    (let ((x 0))
+      (awhen (incf x)
+	(+ 1 it)))
+  2)
+
+(deftest awhen.2
+    (let ((x 0))
+      (or (awhen (not (incf x))
+	    t)
+	  x))
+  1)
+
+(deftest swhen.1
+    (let ((x 0))
+      (swhen x
+	(setf it :ok))
+      x)
+  :ok)
+
+(deftest swhen.2
+    (let ((x nil))
+      (swhen x
+	(setf it :oops))
+      x)
+  nil)
+
+(deftest sunless.1
+    (let ((x nil))
+      (sunless x
+	(setf it :ok))
+      x)
+  :ok)
+
+(deftest sunless.2
+    (let ((x t))
+      (sunless x
+	(setf it :oops))
+      x)
+  t)
+
+(deftest acase.1
+    (let ((x 0))
+      (acase (incf x)
+	(0 :no)
+	(1 (list :yes it))
+	(2 :nono)))
+  (:yes 1))
+
+(deftest scase.1
+    (let ((x (list 3)))
+      (scase (car x)
+	(0 (setf it :no))
+	(3 (setf it :yes!))
+	(t (setf it :nono)))
+      x)
+  (:yes!))
+
+(deftest aecase.1
+    (let ((x (list :x)))
+      (aecase (car x)
+	(:y :no)
+        (:x (list it :yes))))
+  (:x :yes))
+
+(deftest aecase.2
+    (nth-value 0 (ignore-errors
+		   (let ((x (list :x)))
+		     (secase (car x)
+			     (:y :no)))
+		   :oops))
+  nil)
+
+(deftest secase.1
+    (let ((x (list :x)))
+      (secase (car x)
+	      (:y (setf it :no))
+	      (:x (setf it :yes)))
+      x)
+  (:yes))
+
+(deftest secase.2
+    (nth-value 0 (ignore-errors
+		   (let ((x (list :x)))
+		     (secase (car x)
+			     (:y (setf it :no)))
+		     :oops)))
+  nil)
+
+(deftest accase.1
+    (let ((x (list :x)))
+      (accase (car x)
+	      (:y :no)
+	      (:x (list it :yes))))
+  (:x :yes))
+
+(deftest accase.2
+    (let ((x (list :x)))
+      (handler-bind ((type-error (lambda (e) (store-value :z e))))
+	(accase (car x)
+		(:y (setf x :no))
+		(:z (setf x :yes))))
+      x)
+  :yes)
+
+(deftest accase.3
+    (let ((x (list :x)))
+      (accase (car x)
+	      (:x (setf it :foo)))
+      x)
+  (:x))
+
+(deftest sccase.1
+    (let ((x (list :x)))
+      (sccase (car x)
+	      (:y (setf it :no))
+	      (:x (setf it :yes)))
+      x)
+  (:yes))
+
+(deftest sccase.2
+    (let ((x (list :x)))
+      (handler-bind ((type-error (lambda (e) (store-value :z e))))
+	(sccase (car x)
+		(:y (setf it :no))
+		(:z (setf it :yes))))
+      x)
+  (:yes))
+
+(deftest atypecase.1
+    (atypecase 1.0
+       (integer (+ 2 it))
+       (float (1- it)))
+  0.0)
+
+(deftest atypecase.2
+    (atypecase "Foo"
+       (fixnum :no)
+       (hash-table :nono))
+  nil)
+
+(deftest stypecase.1
+    (let ((x (list 'foo)))
+      (stypecase (car x)
+	 (vector (setf it :no))
+	 (symbol (setf it :yes)))
+      x)
+  (:yes))
+
+(deftest stypecase.2
+    (let ((x (list :bar)))
+      (stypecase (car x)
+	 (fixnum (setf it :no)))
+      x)
+  (:bar))
+
+(deftest aetypecase.1
+    (aetypecase 1.0
+       (fixnum (* 2 it))
+       (float (+ 2.0 it))
+       (symbol :oops))
+  3.0)
+
+(deftest aetypecase.2
+    (nth-value 0 (ignore-errors
+		   (aetypecase 1.0
+		       (symbol :oops))))
+  nil)
+
+(deftest setypecase.1
+    (let ((x (list "Foo")))
+      (setypecase (car x)
+	  (symbol (setf it :no))
+	  (string (setf it "OK"))
+	  (integer (setf it :noon)))
+      x)
+  ("OK"))
+
+(deftest setypecase.2
+    (nth-value 0 (ignore-errors
+		   (setypecase 'foo
+		       (string :nono))))
+  nil)
+
+(deftest actypecase.1
+    (actypecase :foo
+       (string (list :string it))
+       (keyword (list :keyword it))
+       (symbol (list :symbol it)))
+  (:keyword :foo))
+
+(deftest actypecase.2
+    (handler-bind ((type-error (lambda (e) (store-value "OK" e))))
+      (actypecase 0
+	 (string it)))
+  "OK")
+
+(deftest sctypecase.1
+    (let ((x (list 0)))
+      (sctypecase (car x)
+	 (symbol (setf it 'symbol))
+	 (bit (setf it 'bit)))
+      x)
+  (bit))
+
+(deftest sctypecase.2
+    (handler-bind ((type-error (lambda (e) (store-value "OK" e))))
+      (let ((x (list 0)))
+	(sctypecase (car x)
+	  (string (setf it :ok)))
+	x))
+  (:ok))
+
+(deftest acond.1
+    (acond (:foo))
+  :foo)
+
+(deftest acond.2
+    (acond ((null 1) (list :no it))
+	   ((+ 1 2) (list :yes it))
+	   (t :nono))
+  (:yes 3))
+
+(deftest acond.3
+    (acond ((= 1 2) :no)
+	   (nil :nono)
+	   (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)))
+      (scond ((car x) (setf it :nono))
+	     ((car y) (setf it :yes)))
+      (values x y))
+  (nil)
+  (:yes))
+
+(deftest scond.2
+    (scond ((= 1 2) :no!))
+  nil)
+
+(deftest aprog.1
+    (aprog1 :yes
+        (unless (eql it :yes) (error "Broken."))
+      :no)
+  :yes)
+
+(deftest aif.sif.1
+    (sif 1 (aif it it))
+  1)
+
+(deftest aif.sif.2
+    (aif 1 (sif it it))
+  1)
+
+(deftest aif.sif.3
+    (aif (list 1 2 3)
+        (sif (car it)
+             (setf it 'a)
+             :foo))
+  a)
+
+(deftest alet.slet.1
+    (slet 42 (alet 43 (slet it it)))
+  43)
+
+
+(defun elt-like (index seq)
+  (elt seq index))
+
+(define-setf-expander elt-like (index seq)
+  (let ((index-var (gensym "index"))
+	(seq-var (gensym "seq"))
+	(store (gensym "store")))
+    (values (list index-var seq-var)
+	    (list index seq)
+	    (list store)
+	    `(if (listp ,seq-var)
+		 (setf (nth ,index-var ,seq-var) ,store)
+		 (setf (aref ,seq-var ,index-var) ,store))
+	    `(if (listp ,seq-var)
+		 (nth ,index-var ,seq-var)
+		 (aref ,seq-var ,index-var)))))
+
+(deftest symbolic.setf-expansion.1
+    (let ((cell (list nil)))
+      (sor (elt-like 0 cell) (setf it 1))
+      (equal cell '(1)))
+  t)