hy/tests/native_tests/contrib/multi.hy

128 lines
3.5 KiB
Hy
Raw Normal View History

2013-12-30 14:32:36 +01:00
;; Copyright (c) 2014 Morten Linderud <mcfoxax@gmail.com>
;; Copyright (c) 2016 Tuukka Turto <tuukka.turto@oktaeder.net>
2013-12-30 14:32:36 +01:00
;; Permission is hereby granted, free of charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.
(require [hy.contrib.multi [defmulti defmethod default-method defn]])
2013-12-30 14:32:36 +01:00
(defn test-different-signatures []
"NATIVE: Test multimethods with different signatures"
(defmulti fun [&rest args]
(len args))
(defmethod fun 0 []
"Hello!")
(defmethod fun 1 [a]
a)
(defmethod fun 2 [a b]
"a b")
(defmethod fun 3 [a b c]
"a b c")
2013-12-30 14:32:36 +01:00
(assert (= (fun) "Hello!"))
(assert (= (fun "a") "a"))
(assert (= (fun "a" "b") "a b"))
(assert (= (fun "a" "b" "c") "a b c")))
(defn test-basic-dispatch []
"NATIVE: Test basic dispatch"
(defmulti area [shape]
(:type shape))
(defmethod area "square" [square]
(* (:width square)
(:height square)))
(defmethod area "circle" [circle]
(* (** (:radius circle) 2)
3.14))
(default-method area [shape]
0)
2013-12-30 14:32:36 +01:00
(assert (< 0.784 (area {:type "circle" :radius 0.5}) 0.786))
(assert (= (area {:type "square" :width 2 :height 2})) 4)
(assert (= (area {:type "non-euclid rhomboid"}) 0)))
2013-12-30 14:32:36 +01:00
(defn test-docs []
"NATIVE: Test if docs are properly handled"
(defmulti fun [a b]
2013-12-30 14:32:36 +01:00
"docs"
a)
(defmethod fun "foo" [a b]
"foo was called")
(defmethod fun "bar" [a b]
"bar was called")
2013-12-30 14:32:36 +01:00
(assert (= fun.--doc-- "docs")))
(defn test-kwargs-handling []
"NATIVE: Test handling of kwargs with multimethods"
(defmulti fun [&kwargs kwargs]
(get kwargs "type"))
(defmethod fun "foo" [&kwargs kwargs]
"foo was called")
(defmethod fun "bar" [&kwargs kwargs]
"bar was called")
(assert (= (fun :type "foo" :extra "extra") "foo was called")))
(defn test-basic-multi []
"NATIVE: Test a basic arity overloaded defn"
(defn fun
([] "Hello!")
([a] a)
([a b] "a b")
([a b c] "a b c"))
(assert (= (fun) "Hello!"))
(assert (= (fun "a") "a"))
(assert (= (fun "a" "b") "a b"))
(assert (= (fun "a" "b" "c") "a b c")))
(defn test-kw-args []
"NATIVE: Test if kwargs are handled correctly for arity overloading"
(defn fun
([a] a)
([&optional [a "nop"] [b "p"]] (+ a b)))
(assert (= (fun 1) 1))
(assert (= (apply fun [] {"a" "t"}) "t"))
(assert (= (apply fun ["hello "] {"b" "world"}) "hello world"))
(assert (= (apply fun [] {"a" "hello " "b" "world"}) "hello world")))
(defn test-docs []
"NATIVE: Test if docs are properly handled for arity overloading"
(defn fun
"docs"
([a] (print a))
([a b] (print b)))
(assert (= fun.--doc-- "docs")))