mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Merge pull request #747 from hellerve/veit/better-dynamic-tests
Better dynamic tests
This commit is contained in:
commit
78f85d73c1
@ -47,9 +47,6 @@
|
||||
(load "Binary.carp")
|
||||
(load "Control.carp")
|
||||
|
||||
(if (not (dynamic-or (= "windows" (os)) (= "mingw32" (os))))
|
||||
(do
|
||||
(system-include "sys/wait.h")
|
||||
(system-include "unistd.h"))
|
||||
())
|
||||
|
||||
(not-on-windows
|
||||
(system-include "sys/wait.h")
|
||||
(system-include "unistd.h"))
|
||||
|
@ -1,5 +1,11 @@
|
||||
;; Defining the meta data macros early so that they can be used by all the other code.
|
||||
|
||||
(defmacro and [x y]
|
||||
(list 'if x y false))
|
||||
|
||||
(defmacro or [x y]
|
||||
(list 'if x true y))
|
||||
|
||||
(meta-set! doc "doc" "Set documentation for a binding.")
|
||||
(defmacro doc [name string]
|
||||
(eval (list 'meta-set! name "doc" string)))
|
||||
@ -170,7 +176,7 @@
|
||||
;; commands expand to (command <name>), fns expand to a non-list.
|
||||
;;
|
||||
;; TODO: Support passing anonymous functions.
|
||||
(if (not (dynamic-or (list? f) (list? g)))
|
||||
(if (not (or (list? f) (list? g)))
|
||||
(macro-error "compose can only compose named dynamic functions. To
|
||||
compose anonymous functions, such as curried functions,
|
||||
see comp.")
|
||||
@ -183,12 +189,6 @@
|
||||
;; symbols such as '(p r a c)
|
||||
(list f-name (list 'eval (list 'apply g-name (list 'quote arguments))))))))
|
||||
|
||||
(defndynamic dynamic-or [x y]
|
||||
(if x true y))
|
||||
|
||||
(defndynamic dynamic-and [x y]
|
||||
(if x y false))
|
||||
|
||||
(doc curry
|
||||
"Returns a curried function accepting a single argument, that applies f to x
|
||||
and then to the following argument.
|
||||
@ -251,7 +251,7 @@
|
||||
(defndynamic unreduce-internal [f x lim acc counter]
|
||||
;; Currently only works with anonymous functions and named functions.
|
||||
;; does not work with commands.
|
||||
(if (not (dynamic-or (array? acc) (list? acc)))
|
||||
(if (not (or (array? acc) (list? acc)))
|
||||
(macro-error
|
||||
"Unreduce requires a dynamic data structure to collect results, such as
|
||||
(list) or (array).")
|
||||
@ -366,9 +366,35 @@
|
||||
acc
|
||||
(map-internal f (cdr xs) (cons-last (f (car xs)) acc))))
|
||||
|
||||
(doc any?
|
||||
"checks whether any of the elements in `xs` conforms to the predicate
|
||||
function `f`.
|
||||
|
||||
Example:
|
||||
|
||||
```
|
||||
(any? (fn [x] (= 'a x)) '(a b c)) ; => true
|
||||
(any? (fn [x] (= 'a x)) '(e f g)) ; => false
|
||||
```")
|
||||
(defndynamic any? [f xs]
|
||||
(reduce (fn [acc x] (or acc (f x))) false xs))
|
||||
|
||||
(doc any?
|
||||
"checks whether all of the elements in `xs` conform to the predicate
|
||||
function `f`.
|
||||
|
||||
Example:
|
||||
|
||||
```
|
||||
(all? (fn [x] (< 1 x)) '(2 3 4)) ; => true
|
||||
(all? (fn [x] (< 1 x)) '(-1 0 1)) ; => false
|
||||
```")
|
||||
(defndynamic all? [f xs]
|
||||
(reduce (fn [acc x] (and acc (f x))) true xs))
|
||||
|
||||
(hidden zip-internal)
|
||||
(defndynamic zip-internal [f forms acc]
|
||||
(if (reduce dynamic-or false (map-internal empty? forms (list)))
|
||||
(if (any? empty? forms)
|
||||
acc
|
||||
(zip-internal
|
||||
f
|
||||
@ -533,12 +559,12 @@
|
||||
()))
|
||||
|
||||
(defmacro windows-only [:rest forms]
|
||||
(if (dynamic-or (= "windows" (os)) (= "mingw32" (os)))
|
||||
(if (or (= "windows" (os)) (= "mingw32" (os)))
|
||||
(eval (cons (quote do) forms))
|
||||
()))
|
||||
|
||||
(defmacro not-on-windows [:rest forms]
|
||||
(if (not (dynamic-or (= "windows" (os)) (= "mingw32" (os))))
|
||||
(if (not (or (= "windows" (os)) (= "mingw32" (os))))
|
||||
(eval (cons (quote do) forms))
|
||||
()))
|
||||
|
||||
@ -597,12 +623,6 @@
|
||||
(defmacro case [name :rest forms]
|
||||
(case-internal name forms))
|
||||
|
||||
(defmacro and [x y]
|
||||
(list 'if x y false))
|
||||
|
||||
(defmacro or [x y]
|
||||
(list 'if x true y))
|
||||
|
||||
(defndynamic build-vararg [func forms]
|
||||
(if (= (length forms) 0)
|
||||
(macro-error "vararg macro needs at least one argument")
|
||||
|
@ -366,6 +366,53 @@
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#all?">
|
||||
<h3 id="all?">
|
||||
all?
|
||||
</h3>
|
||||
</a>
|
||||
<div class="description">
|
||||
dynamic
|
||||
</div>
|
||||
<p class="sig">
|
||||
Dynamic
|
||||
</p>
|
||||
<pre class="args">
|
||||
(all? f xs)
|
||||
</pre>
|
||||
<p class="doc">
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#any?">
|
||||
<h3 id="any?">
|
||||
any?
|
||||
</h3>
|
||||
</a>
|
||||
<div class="description">
|
||||
dynamic
|
||||
</div>
|
||||
<p class="sig">
|
||||
Dynamic
|
||||
</p>
|
||||
<pre class="args">
|
||||
(any? f xs)
|
||||
</pre>
|
||||
<p class="doc">
|
||||
<p>checks whether all of the elements in <code>xs</code> conform to the predicate
|
||||
function <code>f</code>.</p>
|
||||
<pre><code>Example:
|
||||
|
||||
```
|
||||
(all? (fn [x] (< 1 x)) '(2 3 4)) ; => true
|
||||
(all? (fn [x] (< 1 x)) '(-1 0 1)) ; => false
|
||||
```
|
||||
</code></pre>
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#append">
|
||||
<h3 id="append">
|
||||
@ -1493,44 +1540,6 @@ and then to the following argument.</p>
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#dynamic-and">
|
||||
<h3 id="dynamic-and">
|
||||
dynamic-and
|
||||
</h3>
|
||||
</a>
|
||||
<div class="description">
|
||||
dynamic
|
||||
</div>
|
||||
<p class="sig">
|
||||
Dynamic
|
||||
</p>
|
||||
<pre class="args">
|
||||
(dynamic-and x y)
|
||||
</pre>
|
||||
<p class="doc">
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#dynamic-or">
|
||||
<h3 id="dynamic-or">
|
||||
dynamic-or
|
||||
</h3>
|
||||
</a>
|
||||
<div class="description">
|
||||
dynamic
|
||||
</div>
|
||||
<p class="sig">
|
||||
Dynamic
|
||||
</p>
|
||||
<pre class="args">
|
||||
(dynamic-or x y)
|
||||
</pre>
|
||||
<p class="doc">
|
||||
|
||||
</p>
|
||||
</div>
|
||||
<div class="binder">
|
||||
<a class="anchor" href="#e">
|
||||
<h3 id="e">
|
||||
|
@ -3,7 +3,7 @@
|
||||
|
||||
(defndynamic _make-exe-path [pth]
|
||||
(let [out (Project.get-config "output-directory")
|
||||
sep (if (dynamic-or (= (os) "windows") (= (os) "mingw32")) "\\" "/")
|
||||
sep (if (or (= (os) "windows") (= (os) "mingw32")) "\\" "/")
|
||||
lst (Dynamic.String.suffix out (- (String.length out) 1))]
|
||||
(Dynamic.String.concat (array out (if (= lst sep) "" sep) pth))))
|
||||
|
||||
|
@ -34,8 +34,8 @@
|
||||
1 true
|
||||
false))
|
||||
|
||||
(defmacro test-and [a b] (dynamic-and a b))
|
||||
(defmacro test-or [a b] (dynamic-or a b))
|
||||
(defmacro test-and [a b] (and a b))
|
||||
(defmacro test-or [a b] (or a b))
|
||||
(defmacro test-not [a] (not a))
|
||||
(defmacro test-< [a b] (< a b))
|
||||
(defmacro test-> [a b] (> a b))
|
||||
@ -60,12 +60,12 @@
|
||||
|
||||
(defmacro test-map []
|
||||
(let [mapped (Dynamic.map length '((a) (b c) (d e f)))]
|
||||
(dynamic-and (dynamic-and (= 1 (Dynamic.car mapped)) (= 2 (Dynamic.cadr mapped))) (= 3
|
||||
(Dynamic.caddr mapped)))))
|
||||
(and* (= 1 (Dynamic.car mapped)) (= 2 (Dynamic.cadr mapped))
|
||||
(= 3 (Dynamic.caddr mapped)))))
|
||||
|
||||
(defmacro test-zip []
|
||||
(let [zipped (Dynamic.zip array '('a 'd) '('c 'o) '('e 'g))]
|
||||
(dynamic-and (= 'ace (Symbol.concat (eval (Dynamic.car zipped))))
|
||||
(and (= 'ace (Symbol.concat (eval (Dynamic.car zipped))))
|
||||
(= 'dog (Symbol.concat (eval (Dynamic.cadr zipped)))))))
|
||||
|
||||
(defmacro test-curry []
|
||||
@ -81,32 +81,27 @@
|
||||
(= 10 (Dynamic.reduce + 0 '(1 2 3 4))))
|
||||
|
||||
(defmacro test-unreduce []
|
||||
(Dynamic.reduce dynamic-and true
|
||||
(Dynamic.map 'eval
|
||||
(Dynamic.zip = '(1 2 3 4) (Dynamic.unreduce (curry + 1) 0 4 (list))))))
|
||||
(Dynamic.all? eval
|
||||
(Dynamic.zip = '(1 2 3 4) (Dynamic.unreduce (curry + 1) 0 4 (list)))))
|
||||
|
||||
(defmacro test-filter []
|
||||
(Dynamic.reduce dynamic-and true
|
||||
(Dynamic.map 'eval
|
||||
(Dynamic.zip = '('a 'a 'a 'a)
|
||||
(Dynamic.map Dynamic.quoted
|
||||
(Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b)))))))
|
||||
(Dynamic.all? (fn [x] (= 'a x))
|
||||
(Dynamic.filter (fn [x] (= 'a x)) '(a b a b a b a b))))
|
||||
|
||||
(defmacro test-empty []
|
||||
;; We can't compare '[] and '[] for some reason.
|
||||
;; But '() and '() are comparable
|
||||
(dynamic-and (= '() (Dynamic.empty '(1 2 3 4)))
|
||||
(empty? (Dynamic.empty '[1 2 3 4]))))
|
||||
(and (= '() (Dynamic.empty '(1 2 3 4)))
|
||||
(empty? (Dynamic.empty '[1 2 3 4]))))
|
||||
|
||||
(defmacro test-reverse []
|
||||
(Dynamic.reduce dynamic-and true
|
||||
(Dynamic.map 'eval
|
||||
(Dynamic.zip = '(4 3 2 1) (Dynamic.reverse '(1 2 3 4))))))
|
||||
(Dynamic.all? eval
|
||||
(Dynamic.zip = '(4 3 2 1) (Dynamic.reverse '(1 2 3 4)))))
|
||||
|
||||
(defmacro test-take []
|
||||
(let [result (Dynamic.take 2 '(1 2 3 4))]
|
||||
(dynamic-and (= 1 (car result ))
|
||||
(= '() (cddr result)))))
|
||||
(and (= 1 (car result ))
|
||||
(= '() (cddr result)))))
|
||||
|
||||
(deftest test
|
||||
(assert-true test
|
||||
|
Loading…
Reference in New Issue
Block a user