# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1457523187 0
# Node ID a6a6f6361af360f8796cceb19ad2a4eb6e0d8f1b
# Parent  d08be78928164703a81ac4396074a6de4a28da0b
Test the occurs check

diff -r d08be7892816 -r a6a6f6361af3 package-test.lisp
--- a/package-test.lisp	Tue Mar 08 15:27:47 2016 +0000
+++ b/package-test.lisp	Wed Mar 09 11:33:07 2016 +0000
@@ -6,6 +6,5 @@
   (:use #:cl #:5am
         #:bones.utils
         #:bones.paip)
-  (:import-from #:bones.paip)
   ; kill me
   (:shadowing-import-from #:5am #:fail))
diff -r d08be7892816 -r a6a6f6361af3 package.lisp
--- a/package.lisp	Tue Mar 08 15:27:47 2016 +0000
+++ b/package.lisp	Wed Mar 09 11:33:07 2016 +0000
@@ -5,5 +5,6 @@
 (defpackage #:bones.paip
   (:use #:cl #:defstar #:bones.utils)
   (:export #:unify
-           #:fail #:no-bindings))
+           #:fail #:no-bindings
+           #:*check-occurs*))
 
diff -r d08be7892816 -r a6a6f6361af3 test/paip.lisp
--- a/test/paip.lisp	Tue Mar 08 15:27:47 2016 +0000
+++ b/test/paip.lisp	Wed Mar 09 11:33:07 2016 +0000
@@ -3,6 +3,7 @@
 (def-suite :bones.paip)
 (in-suite :bones.paip)
 
+;;;; Utils
 (defun alist-equal (x y)
   (set-equal x y :test #'equal))
 
@@ -15,6 +16,8 @@
 (defmacro not-unifies (x y)
   `(is (eql bones.paip:fail (unify ',x ',y))))
 
+
+;;;; Unification
 (test constant-unification
   (unifies 1 1 no-bindings)
   (unifies foo foo no-bindings)
@@ -44,7 +47,15 @@
            (10 + (1 + 2))
            ((:x . 10)
             (:y . 1)
-            (:z . 2)))
-  )
+            (:z . 2))))
 
-
+(test occurs-unification
+  (not-unifies :x (f :x))
+  (not-unifies :x (f (:x 1)))
+  (not-unifies :x (:x :x))
+  (not-unifies :x (:x :y))
+  (let ((*check-occurs* nil))
+    (unifies :x (f :x)     ((:x . (f :x))))
+    (unifies :x (f (:x 1)) ((:x . (f (:x 1)))))
+    (unifies :x (:x :x)    ((:x . (:x :x))))
+    (unifies :x (:x :y)    ((:x . (:x :y))))))