Upversioned to 0.3 as much refactoring has changed API

2023-03-31 12:37:29 +01:00 · 2023-03-31 12:37:29 +01:00 · 3c92427285
commit 3c92427285
parent 03ed76f34d
20 changed files with 953 additions and 489 deletions
--- a/test/beowulf/bootstrap_test.clj
+++ b/test/beowulf/bootstrap_test.clj
@ -1,8 +1,8 @@
 (ns beowulf.bootstrap-test
  (:require [clojure.test :refer [deftest testing is]]
-            [beowulf.cons-cell :refer [CAR CDR make-cons-cell T F]]
-            [beowulf.bootstrap :refer [APPEND ASSOC ATOM ATOM? CAAAAR CADR
-                                       CADDR CADDDR EQ EQUAL MEMBER 
+            [beowulf.cons-cell :refer [make-cons-cell T F]]
+            [beowulf.host :refer [ASSOC ATOM ATOM? CAR CAAAAR CADR
+                                       CADDR CADDDR CDR EQ EQUAL 
                                       PAIRLIS SUBLIS SUBST]]
            [beowulf.oblist :refer [NIL]]
            [beowulf.read :refer [gsp]]))
@ -165,44 +165,6 @@
                     (gsp "((A . B) . C)")))]
      (is (= actual expected)))))

-(deftest append-tests
-  (testing "append"
-    (let [expected "(A B C . D)"
-          actual (print-str
-                   (APPEND
-                     (gsp "(A B)")
-                     (gsp "(C . D)")))]
-      (is (= actual expected)))
-    (let [expected "(A B C D E)"
-          actual (print-str
-                   (APPEND
-                     (gsp "(A B)")
-                     (gsp "(C D E)")))]
-      (is (= actual expected)))))
-
-(deftest member-tests
-  (testing "member"
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "ALBERT")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-      (is (= actual expected)))
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "BELINDA")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))
-    (let [expected 'T
-          actual (MEMBER
-                   (gsp "ELFREDA")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))
-    (let [expected 'F
-          actual (MEMBER
-                   (gsp "BERTRAM")
-                   (gsp "(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED)"))]
-       (is (= actual expected)))))
-
 (deftest pairlis-tests
  (testing "pairlis"
    (let [expected "((A . U) (B . V) (C . W) (D . X) (E . Y))"
--- a/test/beowulf/host_test.clj
+++ b/test/beowulf/host_test.clj
@ -1,7 +1,7 @@
 (ns beowulf.host-test
  (:require [clojure.test :refer [deftest is testing]]
-            [beowulf.cons-cell :refer [CDR F make-beowulf-list T]] 
-            [beowulf.host :refer [DIFFERENCE NUMBERP PLUS RPLACA RPLACD TIMES]]
+            [beowulf.cons-cell :refer [F make-beowulf-list T]] 
+            [beowulf.host :refer [CDR DIFFERENCE NUMBERP PLUS RPLACA RPLACD TIMES]]
            [beowulf.oblist :refer [NIL]]
            [beowulf.read :refer [gsp]]))

--- a/test/beowulf/lisp_test.clj
+++ b/test/beowulf/lisp_test.clj
@ -4,29 +4,147 @@
            [beowulf.bootstrap :refer [EVAL]]
            [beowulf.cons-cell :refer [make-beowulf-list]]
            [beowulf.io :refer [SYSIN]]
+            ;; [beowulf.oblist :refer [NIL]]
            [beowulf.read :refer [READ]]))

-;; (use-fixtures :once (fn [f]
-;;                        (try (SYSIN "resources/lisp1.5.lsp")
-;;                        (f)
-;;                             (catch Throwable any
-;;                               (throw (ex-info "Failed to load Lisp sysout"
-;;                                               {:phase test
-;;                                                :function 'SYSIN
-;;                                                :file "resources/lisp1.5.lsp"}))))))
+(defn- reps
+  "'Read eval print string', or 'read eval print single'.
+   Reads and evaluates one input string, and returns the
+   output string."
+  [input]
+  (with-out-str (print (EVAL (READ input)))))

-;; (deftest "COPY test"
-;;   ;; (testing "copy NIL"
-;;   ;;   (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
-;;   ;;   (let [expected "NIL"
-;;   ;;         actual (with-out-str (println (EVAL (READ "(COPY NIL)"))))]
-;;   ;;     (is (= actual expected))))
-;;   (testing "copy straight list"
-;;     (println "in-test: " (SYSIN "resources/lisp1.5.lsp"))
-;;     (let [expected (make-beowulf-list '(A B C))
-;;           actual (with-out-str (print (EVAL (READ "(COPY '(A B C))"))))]
-;;       (is (= actual expected))))
-;;   (testing "copy assoc list"
-;;     (let [expected "((A . 1) (B . 2) (C . 3))"
-;;           actual (with-out-str (println (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))))]
-;;       (is (= actual expected)))))
+(use-fixtures :once (fn [f]
+                      (try (when (SYSIN "resources/lisp1.5.lsp")
+                             (f))
+                           (catch Throwable any
+                             (throw (ex-info "Failed to load Lisp sysout"
+                                             {:phase test
+                                              :function 'SYSIN
+                                              :file "resources/lisp1.5.lsp"}
+                                             any))))))
+
+  (deftest APPEND-tests
+    (testing "append - dot-terminated lists"
+      (let [expected "(A B C . D)"
+            actual (reps "(APPEND '(A B) (CONS 'C 'D))")]
+        (is (= actual expected)))
+     (let [expected "(A B C . D)"
+           actual (reps "(APPEND (CONS 'A (CONS 'B NIL)) (CONS 'C 'D))")]
+       (is (= actual expected)))
+      ;; this is failing: https://github.com/simon-brooke/beowulf/issues/5
+      (let [expected "(A B C . D)"
+            actual (reps "(APPEND '(A B) '(C . D))")]
+        (is (= actual expected))))
+    (testing "append - straight lists" 
+      (let [expected "(A B C D E)"
+            actual (reps "(APPEND '(A B) '(C D E))")]
+        (is (= actual expected)))))
+
+(deftest COPY-tests
+  (testing "copy NIL"
+    (let [expected "NIL"
+          actual (with-out-str (print (EVAL (READ "(COPY NIL)"))))]
+      (is (= actual expected))))
+  (testing "copy straight list"
+    (let [expected (make-beowulf-list '(A B C))
+          actual (EVAL (READ "(COPY '(A B C))"))]
+      (is (= actual expected))))
+  (testing "copy assoc list created in READ"
+    ;; this is failing. Problem in READ?
+    ;; see https://github.com/simon-brooke/beowulf/issues/5
+    (let [expected (READ "((A . 1) (B . 2) (C . 3))")
+          actual (EVAL (READ "(COPY '((A . 1) (B . 2) (C . 3)))"))]
+      (is (= actual expected))))
+  (testing "copy assoc list created with PAIR"
+    (let [expected (READ "((A . 1) (B . 2) (C . 3))")
+          actual (EVAL (READ "(COPY (PAIR '(A B C) '(1 2 3)))"))]
+      (is (= actual expected)))))
+
+(deftest DIVIDE-tests
+  (testing "rational divide"
+    (let [expected "(4 0)"
+          input "(DIVIDE 8 2)"
+          actual (reps input)]
+      (is (= actual expected))))
+  (testing "irrational divide"
+    (let [expected "(3.142857 1)"
+          input "(DIVIDE 22 7)"
+          actual (reps input)]
+      (is (= actual expected))))
+  (testing "divide by zero"
+    (let [input "(DIVIDE 22 0)"]
+      (is (thrown-with-msg? ArithmeticException
+                            #"Divide by zero"
+                            (reps input)))))
+  
+  ;; TODO: need to write tests for GET but I don't really
+  ;; understand what the correct behaviour is.
+
+  (deftest INTERSECTION-tests
+    (testing "non-intersecting"
+      (let [expected "NIL"
+            input "(INTERSECTION '(A B C) '(D E F))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "intersection with NIL"
+      (let [expected "NIL"
+            input "(INTERSECTION '(A B C) NIL)"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "intersection with NIL (2)"
+      (let [expected "NIL"
+            input "(INTERSECTION NIL '(A B C))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "sequential intersection"
+      (let [expected "(C D)"
+            input "(INTERSECTION '(A B C D) '(C D E F))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "non-sequential intersection"
+      (let [expected "(C D)"
+            input "(INTERSECTION '(A B C D) '(F D E C))"
+            actual (reps input)]
+        (is (= actual expected)))))
+  
+  (deftest LENGTH-tests
+    (testing "length of NIL"
+      (let [expected "0"
+            input "(LENGTH NIL)"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of simple list"
+      (let [expected "3"
+            input "(LENGTH '(1 2 3))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of dot-terminated list"
+      (let [expected "3"
+            input "(LENGTH '(1 2 3 . 4))"
+            actual (reps input)]
+        (is (= actual expected))))
+    (testing "length of assoc list"
+      (let [expected "3"
+            input "(LENGTH (PAIR '(A B C) '(1 2 3)))"
+            actual (reps input)]
+        (is (= actual expected))))))
+       
+     
+(deftest MEMBER-tests
+  (testing "member"
+    (let [expected "T"
+          actual (reps "(MEMBER 'ALBERT '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "T"
+          actual (reps "(MEMBER 'BELINDA '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "T"
+          actual (reps "(MEMBER 'ELFREDA '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))
+    (let [expected "F"
+          actual (reps "(MEMBER 'BERTRAM '(ALBERT BELINDA CHARLIE DORIS ELFREDA FRED))")]
+      (is (= actual expected)))))
+
+       
+