# Copyright (c) 2017 Calvin Rose # # 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. (print "\nRunning Suite 1 Tests...\n") (var num-tests-passed 0) (var num-tests-run 0) (def assert (fn [x e] (:= num-tests-run (+ 1 num-tests-run)) (if x (do (print " \e[32m✔\e[0m " e) (:= num-tests-passed (+ 1 num-tests-passed)) x) (do (print " \e[31m✘\e[0m " e) x)))) (if (not= 400.0 (sqrt 160000)) (error "sqrt(160000)=400")) (if (not= (real 400) (sqrt 160000)) (error "sqrt(160000)=400")) (def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het [1 2 3 4 5]}) (assert (= (get test-struct 'def) 1) "struct get") (assert (= (get test-struct 'bork) 2) "struct get") (assert (= (get test-struct 'sam) 3) "struct get") (assert (= (get test-struct 'a) 'b) "struct get") (assert (= :array (type (get test-struct 'het))) "struct get") (defn myfun [x] (var a 10) (:= a (do (def y x) (if x 8 9)))) (assert (= (myfun true) 8) "check do form regression") (assert (= (myfun false) 9) "check do form regression") (print "\n" num-tests-passed " of " num-tests-run " tests passed\n") (if (not= num-tests-passed num-tests-run) (exit 1))