lean2/src/emacs/test/lean-info-test.el
2014-10-29 17:09:08 -07:00

382 lines
15 KiB
EmacsLisp

;; Copyright (c) 2014 Microsoft Corporation. All rights reserved.
;; Released under Apache 2.0 license as described in the file LICENSE.
;;
;; Author: Soonho Kong
;;
(require 'ert)
(require 'lean-info)
(ert-deftest lean-test-info-type ()
"Test lean-info-type"
(should (lean-info-type-p 'TYPE))
(should (lean-info-type-p "-- TYPE|121|2"))
(should (lean-info-type-p '("-- TYPE|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
(should (equal (lean-info-type-parse-header "-- TYPE|121|2")
'(121 2)))
(should (equal (lean-info-type-parse '("-- TYPE|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))"))
'(TYPE
(121 2)
("not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"))))
(should (equal
(lean-info-type-pos
(lean-info-type-parse '("-- TYPE|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
'(121 2))))
(ert-deftest lean-test-info-overload ()
"Test lean-info-overload"
(should (lean-info-overload-p 'OVERLOAD))
(should (lean-info-overload-p "-- OVERLOAD|121|2"))
(should (lean-info-overload-p '("-- OVERLOAD|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
(should (equal (lean-info-overload-parse-header "-- OVERLOAD|121|2")
'(121 2)))
(should
(equal
(lean-info-overload-parse
'("-- OVERLOAD|121|2"
"not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq one (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq two (succ m'))"
"→ decidable (eq zero (succ m'))"))
'(OVERLOAD (121 2)
(("not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")
("not (eq one (succ m'))" "→ decidable (eq zero (succ m'))")
("not (eq two (succ m'))" "→ decidable (eq zero (succ m'))")))))
(should (equal
(lean-info-overload-pos
(lean-info-overload-parse
'("-- OVERLOAD|121|2"
"not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq one (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq two (succ m'))"
"→ decidable (eq zero (succ m'))")))
'(121 2)))
(should (equal (lean-info-overload-names (lean-info-overload-parse
'("-- OVERLOAD|121|2"
"not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq one (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq two (succ m'))"
"→ decidable (eq zero (succ m'))")))
'("not (eq zero (succ m'))\n→ decidable (eq zero (succ m'))"
"not (eq one (succ m'))\n→ decidable (eq zero (succ m'))"
"not (eq two (succ m'))\n→ decidable (eq zero (succ m'))"))))
(ert-deftest lean-test-info-synth ()
"Test lean-info-synth"
;; -- Test
(should (lean-info-synth-p 'SYNTH))
(should (lean-info-synth-p "-- SYNTH|121|2"))
(should (lean-info-synth-p '("-- SYNTH|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
(should (equal (lean-info-synth-parse-header "-- SYNTH|121|2")
'(121 2)))
(should (equal (lean-info-synth-parse '("-- SYNTH|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))"))
'(SYNTH
(121 2)
("not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"))))
(should (equal
(lean-info-synth-pos
(lean-info-synth-parse '("-- SYNTH|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
'(121 2))))
(ert-deftest lean-test-info-coercion ()
"Test lean-info-coercion"
;; -- Test
(should (lean-info-coercion-p 'COERCION))
(should (lean-info-coercion-p "-- COERCION|121|2"))
(should (lean-info-coercion-p '("-- COERCION|417|15"
"of_nat m"
"--"
"int")))
(should (equal (lean-info-coercion-parse-header "-- COERCION|121|2")
'(121 2)))
(should (equal (lean-info-coercion-parse '("-- COERCION|417|15"
"of_nat"
"--"
"int"))
'(COERCION
(417 15)
("of_nat")
("int"))))
(should (equal
(lean-info-coercion-pos
(lean-info-coercion-parse '("-- COERCION|417|15"
"of_nat")))
'(417 15))))
(ert-deftest lean-test-info-extra ()
"Test lean-info-extra"
;; -- Test
(should (lean-info-extra-p 'EXTRA))
(should (lean-info-extra-p "-- EXTRA_TYPE|121|2"))
(should (lean-info-extra-p '("-- EXTRA_TYPE|417|15"
"rec_on b ff tt"
"--"
"bool")))
(should (equal (lean-info-extra-parse-header "-- EXTRA_TYPE|121|2")
'(121 2)))
(should (equal (lean-info-extra-parse '("-- EXTRA_TYPE|417|15"
"rec_on b ff tt"
"--"
"bool"))
'(EXTRA
(417 15)
("rec_on b ff tt")
("bool"))))
(should (equal
(lean-info-extra-pos
(lean-info-extra-parse '("-- EXTRA_TYPE|417|15"
"of_nat")))
'(417 15))))
(ert-deftest lean-test-info-identifier ()
"Test lean-info-identifier"
;; -- Test
(should (lean-info-identifier-p 'IDENTIFIER))
(should (lean-info-identifier-p "-- IDENTIFIER|121|2"))
(should (lean-info-identifier-p '("-- IDENTIFIER|121|2" "foo.f")))
(should (equal (lean-info-identifier-parse-header "-- IDENTIFIER|121|2")
'(121 2)))
(should (equal (lean-info-identifier-parse '("-- IDENTIFIER|121|2" "foo.f"))
'(IDENTIFIER
(121 2)
("foo.f"))))
(should (equal
(lean-info-identifier-pos
(lean-info-identifier-parse '("-- IDENTIFIER|121|2" "foo.f")))
'(121 2))))
(ert-deftest lean-test-info-symbol ()
"Test lean-info-symbol"
;; -- Test
(should (lean-info-symbol-p 'SYMBOL))
(should (lean-info-symbol-p "-- SYMBOL|121|2"))
(should (lean-info-symbol-p (lean-info-symbol-parse '("-- SYMBOL|121|2" ""))))
(should (equal (lean-info-symbol-parse-header "-- SYMBOL|121|2")
'(121 2)))
(should (lean-info-symbol-p '("-- SYMBOL|121|2" "")))
(should (equal (lean-info-symbol-parse '("-- SYMBOL|121|2" ""))
'(SYMBOL
(121 2)
(""))))
(should (equal
(lean-info-symbol-pos
(lean-info-symbol-parse '("-- SYMBOL|121|2" "")))
'(121 2))))
(ert-deftest lean-test-info-proofstate ()
"Test lean-info-proofstate"
(should (lean-info-proofstate-p 'PROOF_STATE))
(should (lean-info-proofstate-p "-- PROOF_STATE|121|2"))
(should (lean-info-proofstate-p '("-- PROOF_STATE|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
(should (equal (lean-info-proofstate-parse-header "-- PROOF_STATE|121|2")
'(121 2)))
(should
(equal
(lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c"))
'(PROOF_STATE (6 17)
(("a : Prop," "b : Prop," "c : Prop," "H_1 : a," "H_2 : b," "H_3 : c" "⊢ a")
("a : Prop," "b : Prop," "c : Prop," "H_1 : a," "H_2 : b," "H_3 : c" "⊢ and b c")))))
(should (equal
(lean-info-proofstate-pos
(lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c")))
'(6 17)))
(should (equal (lean-info-proofstate-states (lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c")))
'(("a : Prop," "b : Prop," "c : Prop," "H_1 : a," "H_2 : b," "H_3 : c" "⊢ a")
("a : Prop," "b : Prop," "c : Prop," "H_1 : a," "H_2 : b," "H_3 : c" "⊢ and b c"))))
(should (equal (lean-info-proofstate-extract-conclusion
'("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ b ∧ c"
"..."))
'("⊢ b ∧ c" "...")))
(should (equal (lean-info-proofstate-extract-premises
'("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ b ∧ c"
"..."))
'("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c")))
(should (equal (lean-info-proofstate-states-str
(lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c"))
'show-all)
(string-join '("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
""
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c") "\n")))
(should (equal (lean-info-proofstate-states-str
(lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c"))
'show-first)
(string-join '("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a") "\n")))
(should (equal (lean-info-proofstate-states-str
(lean-info-proofstate-parse
'("-- PROOF_STATE|6|17"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
"--"
"a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ and b c"))
'show-first-and-other-conclusions)
(string-join '("a : Prop,"
"b : Prop,"
"c : Prop,"
"H_1 : a,"
"H_2 : b,"
"H_3 : c"
"⊢ a"
""
"⊢ and b c") "\n"))))
(ert-deftest lean-test-info-pos ()
"Test lean-info-pos"
(should (equal
(lean-info-pos
(lean-info-type-parse '("-- TYPE|121|2" "not (eq zero (succ m'))" "→ decidable (eq zero (succ m'))")))
'(121 2)))
(should (equal
(lean-info-pos
(lean-info-overload-parse
'("-- OVERLOAD|121|2"
"not (eq zero (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq one (succ m'))"
"→ decidable (eq zero (succ m'))"
"--"
"not (eq two (succ m'))"
"→ decidable (eq zero (succ m'))")))
'(121 2))))