simon/beowulf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Close #6: Done

Browse source
This commit is contained in:
Simon Brooke 2023-04-11 12:11:28 +01:00
parent 8b99c62ac3
commit 26e8c42ba4
17 changed files with 1321 additions and 1105 deletions
Download patch file Download diff file Expand all files Collapse all files

207
test/beowulf/core_test.clj
View file

@ -1,8 +1,9 @@
(ns beowulf.core-test
(:require [clojure.java.io :refer [reader]]
[clojure.string :refer [split]]
[clojure.test :refer [deftest is testing]]
[beowulf.core :refer [-main repl stop-word]]))
(:require [beowulf.core :refer [-main repl stop-word]]
[beowulf.oblist :refer [*options*]]
[clojure.java.io :refer [reader]]
[clojure.string :refer [split starts-with?]]
[clojure.test :refer [deftest is testing]]))
;; (deftest a-test
;; (testing "FIXME, I fail."
@ -20,45 +21,43 @@
(deftest repl-tests
(testing "quit functionality"
(with-open [r (reader (string->stream stop-word))]
(binding [*in* r]
(binding [clojure.core/*in* r
*options* (assoc *options* :testing true)]
(is (thrown-with-msg? Exception #"\nFærwell!" (repl "")))))
(let [expected nil
actual (with-open [r (reader (string->stream stop-word))]
(binding [*in* r]
(-main)))]
(-main "--testing")))]
(is (= actual expected)))))
;; TODO: not working because STOP is not being recognised, but I haven't
;; worked out why not yet. It *did* work.
;; The new read-chars interface is really messing with this. Need to sort out!
;; OK, binding `:testing` doesn't work because `*options*` gets rebound in main.
;; Need to be able to pass in a testing flag as argument to -main
(deftest flag-tests
(testing "No flags"
(testing "Only testing flag"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-result #".*\(3 \. 4\)"
expected-prompt "Sprecan:: "
expected-signoff "Færwell!"
;; anticipated output (note blank lines):
; Hider wilcuman. Béowulf is mín nama.
; Sprecan 'STOP' tó laéfan
; Sprecan:: > (3 . 4)
; Sprecan::
; Færwell!
;; Hider wilcuman. Béowulf is mín nama.
;; Sprecan 'STOP' tó laéfan
;; Sprecan:: > (3 . 4)
;; Sprecan::
;; Færwell!
[_ greeting _ _ quit-message _ result prompt signoff]
(with-open [r (reader (string->stream (str "cons[3; 4]\n" stop-word)))]
(binding [*in* r]
(split (with-out-str (-main)) #"\n")))]
(split (with-out-str (-main "--testing")) #"\n")))]
(is (= greeting expected-greeting))
; (is (= error expected-error))
(is (re-matches expected-result result))
(is (= quit-message expected-quit-message))
(is (= prompt expected-prompt))
(is (= signoff expected-signoff))
))
(is (= signoff expected-signoff))))
(testing "unknown flag"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
@ -69,115 +68,63 @@
[_ greeting _ error quit-message _ result prompt signoff]
(with-open [r (reader (string->stream (str "cons[5; 6]\n" stop-word)))]
(binding [*in* r]
(split (with-out-str (-main "--unknown")) #"\n")))]
(split (with-out-str (-main "--unknown" "--testing")) #"\n")))]
(is (= greeting expected-greeting))
(is (re-matches expected-error error))
(is (re-matches expected-result result))
(is (= quit-message expected-quit-message))
(is (= prompt expected-prompt))
(is (= signoff expected-signoff))
))
; (testing "help"
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-h1 " -h, --help"
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
; expected-result #".*\(A \. B\)"
; expected-prompt "Sprecan:: "
; expected-signoff "Færwell!"
; [_ greeting _ h1 _ _ _ _ quit-message _ result prompt signoff]
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--help")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (= h1 expected-h1))
; (is (re-matches expected-result result))
; (is (= quit-message expected-quit-message))
; (is (= prompt expected-prompt))
; (is (= signoff expected-signoff))
; ))
; (testing "prompt"
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
; expected-error ""
; expected-result #".*\(A \. B\).*"
; expected-prompt "? "
; expected-signoff "Færwell!"
; [_ greeting _ error quit-message _ result prompt signoff]
; (with-open [r (reader (string->stream (str stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--prompt" "?")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (= error expected-error))
; (is (re-matches expected-result result ))
; (is (= quit-message expected-quit-message))
; (is (= prompt expected-prompt))
; (is (= signoff expected-signoff))
; ))
; (testing "read - file not found"
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
; expected-error #"Failed to validate.*"
; expected-result #".*\(A \. B\)"
; expected-prompt "Sprecan:: "
; expected-signoff "Færwell!"
; [_ greeting _ error quit-message _ result prompt signoff]
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--read" "froboz")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (re-matches expected-error error))
; (is (re-matches expected-result result))
; (is (= quit-message expected-quit-message))
; (is (= prompt expected-prompt))
; (is (= signoff expected-signoff))
; ))
; (testing "read - file found"
; ;; TODO: there's no feedback from this because the initfile
; ;; is not yet read. This will change
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
; expected-error ""
; expected-result #".*\(A \. B\)"
; expected-prompt "Sprecan:: "
; expected-signoff "Færwell!"
; [_ greeting error quit-message _ _ result prompt signoff]
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--read" "README.md")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (= error expected-error))
; (is (re-matches expected-result result))
; (is (= quit-message expected-quit-message))
; (is (= prompt expected-prompt))
; (is (= signoff expected-signoff))
; ))
; (testing "strict"
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
; expected-error ""
; expected-result #".*Cannot parse meta expressions in strict mode.*"
; expected-prompt "Sprecan:: "
; expected-signoff "Færwell!"
; [_ greeting _ error quit-message _ result prompt signoff]
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--strict")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (= error expected-error))
; (is (re-matches expected-result result ))
; (is (= quit-message expected-quit-message))
; (is (= prompt expected-prompt))
; (is (= signoff expected-signoff))
; ))
; ; (testing "trace"
; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
; expected-error ""
; expected-trace #".*traced-eval.*"
; [_ greeting _ error _ _ trace & _]
; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
; (binding [*in* r]
; (split (with-out-str (-main "--trace")) #"\n")))]
; (is (= greeting expected-greeting))
; (is (= error expected-error))
; (is (re-matches expected-trace trace))
)
(is (= signoff expected-signoff))))
;; ;; TODO: not working because STOP is not being recognised, but I haven't
;; ;; worked out why not yet. It *did* work.
;; Hider wilcuman. Béowulf is mín nama.
;; -f FILEPATH, --file-path FILEPATH Set the path to the directory for reading and writing Lisp files.
;; -h, --help
;; -p PROMPT, --prompt PROMPT Sprecan:: Set the REPL prompt to PROMPT
;; -r SYSOUTFILE, --read SYSOUTFILE lisp1.5.lsp Read Lisp system from file SYSOUTFILE
;; -s, --strict Strictly interpret the Lisp 1.5 language, without extensions.
;; -t, --time Time evaluations.
;; -x, --testing Disable the jline reader - useful when piping input.
;; Sprecan 'STOP' tó laéfan
;; Sprecan::
(testing "help"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-h1 " -h, --help"
expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: "
expected-signoff "Færwell!"
[_ greeting _ _ h1 _ _ _ _ _ quit-message _ result prompt signoff]
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r]
(split (with-out-str (-main "--help" "--testing")) #"\n")))]
(is (= greeting expected-greeting))
(is (= h1 expected-h1))
(is (re-matches expected-result result))
(is (= quit-message expected-quit-message))
(is (starts-with? prompt expected-prompt))
(is (= signoff expected-signoff))))
(testing "prompt"
(let [expected-prompt "? "
[_ _ _ _ _ _ prompt _]
(with-open [r (reader (string->stream stop-word))]
(binding [*in* r]
(split (with-out-str (-main "--prompt" "?" "--testing")) #"\n")))]
(is (= prompt expected-prompt))))
(testing "read - file not found"
(let [expected-error #"Failed to validate.*"
[_ _ _ error _ _ _ _ _]
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r]
(split (with-out-str (-main "--testing" "--read" "froboz")) #"\n")))]
(is (re-matches expected-error error))))
(testing "strict"
(let [expected-result #".*Cannot parse meta expressions in strict mode.*"
[_ _ _ _ _ _ result _ _]
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r]
(split (with-out-str (-main "--strict" "--testing")) #"\n")))]
(is (re-matches expected-result result )))))

23
test/beowulf/host_test.clj
View file

@ -1,9 +1,21 @@
(ns beowulf.host-test
(:require [clojure.test :refer [deftest is testing]]
[beowulf.cons-cell :refer [F make-beowulf-list T]]
[beowulf.host :refer [CDR DIFFERENCE NUMBERP PLUS RPLACA RPLACD TIMES]]
(:require [beowulf.cons-cell :refer [F make-beowulf-list T]]
[beowulf.host :refer [CDR DIFFERENCE GENSYM GET NUMBERP PLUS PUT
RPLACA RPLACD TIMES]]
[beowulf.io :refer [SYSIN]]
[beowulf.oblist :refer [NIL]]
[beowulf.read :refer [gsp]]))
[beowulf.read :refer [gsp]]
[clojure.test :refer [deftest is testing use-fixtures]]))
(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 destructive-change-test
(testing "RPLACA"
@ -64,7 +76,8 @@
(let [expected 6
actual (TIMES 2 3)]
(is (= actual expected))))
(testing DIFFERENCE
(testing "DIFFERENCE"
(let [expected -1
actual (DIFFERENCE 1 2)]
(is (= actual expected)))))

50
test/beowulf/lisp_test.clj
View file

@ -1,11 +1,11 @@
(ns beowulf.lisp-test
"The idea here is to test actual Lisp functions"
(:require [clojure.test :refer [deftest testing is use-fixtures]]
[beowulf.bootstrap :refer [EVAL]]
(:require [beowulf.bootstrap :refer [EVAL]]
[beowulf.cons-cell :refer [make-beowulf-list]]
[beowulf.io :refer [SYSIN]]
;; [beowulf.oblist :refer [NIL]]
[beowulf.read :refer [READ]]))
[beowulf.io :refer [SYSIN]] ;; [beowulf.oblist :refer [NIL]]
[beowulf.oblist :refer [NIL]]
[beowulf.read :refer [READ]]
[clojure.test :refer [deftest is testing use-fixtures]]))
(defn- reps
"'Read eval print string', or 'read eval print single'.
@ -165,4 +165,42 @@
(SETQ X (ADD1 X))
(COND ((EQ X 5) (RETURN X))
(T (GO START))))")]
(is (= actual expected)))))
(is (= actual expected)))))
(deftest put-get-tests
(let [symbol 'TESTSYMBOL
p1 'TESTPROPONE
p2 'TESTPROPTWO]
(testing "GET - property should be missing"
(let [expected "NIL"
actual (reps "(GET 'TESTSYMBOL 'TESTPROPONE)")]
(is (= actual expected))))
(testing "PUT and GET: value of new property; change value of property"
(let [prop (reps "(GENSYM)")
val1 (reps "(GENSYM)")
val2 (reps "(GENSYM)")
expected1 val1
actual1 (when (reps (str "(PUT '" symbol " '" prop " '" val1 ")"))
(reps (str "(GET '" symbol " '" prop ")")))
expected2 val2
actual2 (when (reps (str "(PUT '" symbol " '" prop " '" val2 ")"))
(reps (str "(GET '" symbol " '" prop ")")))]
(is (not= val1 val2))
(is (= actual1 expected1) "The value set can be retrieved.")
(is (= actual2 expected2) "The value is changed.")))
(testing "PUT and GET: different properties have independent values"
(let [val1 (reps "(GENSYM)")
val2 (reps "(GENSYM)")
expected1 val1
actual1 (when (reps (str "(PUT '" symbol " '" p1 " '" val1 ")"))
(reps (str "(GET '" symbol " '" p1 ")")))
expected2 val2
actual2 (when (reps (str "(PUT '" symbol " '" p2 " '" val2 ")"))
(reps (str "(GET '" symbol " '" p2 ")")))
expected3 val1
actual3 (reps (str "(GET '" symbol " '" p1 ")"))]
(is (not= val1 val2))
(is (= actual1 expected1) "The value set can be retrieved.")
(is (= actual2 expected2) "Values are independent.")
(is (= actual3 expected3) "Setting a second property does not obliterate the first.")))))