mirror of
https://github.com/carp-lang/Carp.git
synced 2024-11-05 04:44:12 +03:00
503 lines
13 KiB
Plaintext
503 lines
13 KiB
Plaintext
(load "Test.carp")
|
|
|
|
(use Array)
|
|
(use IO)
|
|
(use Int)
|
|
(use Float)
|
|
(use Double)
|
|
(use Array)
|
|
(use System)
|
|
(use Char)
|
|
(use Test)
|
|
|
|
(Debug.sanitize-addresses)
|
|
|
|
(defn assert-no-leak [state f descr]
|
|
(do
|
|
(Debug.reset-memory-balance!)
|
|
(f)
|
|
(assert-equal state 0l (Debug.memory-balance) descr)))
|
|
|
|
(defn scope-1 []
|
|
(let [s @""]
|
|
()))
|
|
|
|
(defn scope-2 []
|
|
(let [s @""]
|
|
(print &s)))
|
|
|
|
(defn scope-3 []
|
|
(let [s @""]
|
|
(do (print "")
|
|
())))
|
|
|
|
(defn f []
|
|
@"")
|
|
|
|
(defn call-1 []
|
|
(let [s (f)]
|
|
()))
|
|
|
|
(defn g [s]
|
|
())
|
|
|
|
(defn call-2 []
|
|
(let [s (g @"")]
|
|
()))
|
|
|
|
(defn id [x]
|
|
x)
|
|
|
|
(defn call-3 []
|
|
(let [s (id (f))]
|
|
()))
|
|
|
|
(defn de-ref [x]
|
|
@x)
|
|
|
|
(defn call-4 []
|
|
(let [s (de-ref "")]
|
|
()))
|
|
|
|
(deftype A [s String])
|
|
|
|
(defn struct-1 []
|
|
(let [a (A.init @"")]
|
|
()))
|
|
|
|
(deftype B [a A])
|
|
|
|
(defn struct-2 []
|
|
(let [a (A.init @"")
|
|
b (B.init a)]
|
|
()))
|
|
|
|
(defn struct-3 []
|
|
(let [a (A.init @"")
|
|
b (B.init a)
|
|
c (B.set-a b (A.init @""))]
|
|
()))
|
|
|
|
(defn h [a]
|
|
(A.set-s a @""))
|
|
|
|
(defn struct-4 []
|
|
(let [a (A.init @"")
|
|
b (B.init a)
|
|
c (B.update-a b &h)]
|
|
()))
|
|
|
|
(defn struct-5 []
|
|
(let [a (A.init @"")
|
|
b (B.init a)
|
|
c (B.a &b)
|
|
d (A.s c)]
|
|
()))
|
|
|
|
(defn setting-1 []
|
|
(let [s @""]
|
|
(do (set! s @"")
|
|
())))
|
|
|
|
(defn setting-2 []
|
|
(let [s @""]
|
|
(do (set! s s)
|
|
())))
|
|
|
|
(defn setting-3 []
|
|
(let [s @""]
|
|
(do (set! s @&s)
|
|
())))
|
|
|
|
(defn setting-4 []
|
|
(let [s @""
|
|
t @""
|
|
r &s]
|
|
(do (set! r &t) ;; Here the set variable is a ref.
|
|
())))
|
|
|
|
(defn set-me [s]
|
|
(do (for [i 0 10]
|
|
(set! s @"other"))
|
|
s))
|
|
|
|
(defn setting-5 []
|
|
(let [s @""]
|
|
(assert (= @"other" (set-me s)))))
|
|
|
|
(def g1 @"Hello")
|
|
|
|
(defn global-1 []
|
|
(set! g1 @"Bye"))
|
|
|
|
|
|
(def g2 @"Hello")
|
|
|
|
(defn-do global-2 []
|
|
(set! g2 @"How are you?")
|
|
(set! g2 @"Bye"))
|
|
|
|
|
|
;; Free the argument 's' in the branch where it's not deleted manually.
|
|
(defn branch-with-arg [b s]
|
|
(if b
|
|
(String.delete s)
|
|
()))
|
|
|
|
(defn if-1 []
|
|
(branch-with-arg true @""))
|
|
|
|
(defn if-2 []
|
|
(branch-with-arg false @""))
|
|
|
|
|
|
;; The branch that creates a new value must also delete it.
|
|
(defn do-nothing-with-ref [r]
|
|
(let [_ (the (Ref a) r)]
|
|
()))
|
|
|
|
(defn create-in-branch [b]
|
|
(if b
|
|
()
|
|
(do-nothing-with-ref &@"")))
|
|
|
|
(defn if-3 []
|
|
(create-in-branch true))
|
|
|
|
(defn if-4 []
|
|
(create-in-branch false))
|
|
|
|
|
|
;; Free the variable 's' in the branch where it's not deleted manually.
|
|
(defn branch-in-let [b]
|
|
(let [pre-existing @""]
|
|
(if b
|
|
()
|
|
(String.delete pre-existing))))
|
|
|
|
(defn if-5 []
|
|
(branch-in-let true))
|
|
|
|
(defn if-6 []
|
|
(branch-in-let false))
|
|
|
|
(defn string-substring []
|
|
(let [s1 @"abcde"
|
|
s2 (String.substring &s1 0 3)]
|
|
(assert (= "abc" &s2))))
|
|
|
|
(defn array-aset []
|
|
(let [xs [@"a" @"b" @"c"]]
|
|
(do (aset! &xs 0 @"q")
|
|
(assert (= &[@"q" @"b" @"c"] &xs)))))
|
|
|
|
(defn append-ref [a b]
|
|
(StringCopy.append a @b))
|
|
|
|
(defn array-reduce []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
result (Array.reduce &append-ref @"" &xs)]
|
|
(assert (= @"abc" result))))
|
|
|
|
(defn array-endo-filter []
|
|
(let [xs [@"a" @"b" @"c" @"b" @"a" @"c"]
|
|
result (Array.endo-filter &(fn [x] (= x "b")) xs)]
|
|
(assert (= &[@"b" @"b"] &result))))
|
|
|
|
(defn array-copy-filter []
|
|
(let [xs [@"a" @"b" @"c" @"a" @"c"]
|
|
result (Array.copy-filter &(fn [x] (= x "b")) &xs)]
|
|
(assert (= &[@"b"] &result))))
|
|
|
|
(defn array-first []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
result (Array.unsafe-first &xs)]
|
|
(assert (= @"a" result))))
|
|
|
|
(defn array-last []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
result (Array.unsafe-last &xs)]
|
|
(assert (= @"c" result))))
|
|
|
|
(defn array-eq-1 []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
ys [@"x" @"y" @"z"]]
|
|
(assert (not (= &xs &ys)))))
|
|
|
|
(defn array-eq-2 []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
ys [@"a" @"b" @"c"]]
|
|
(assert (= &xs &ys))))
|
|
|
|
(defn array-maximum []
|
|
(let [xs [1 7 2 9 3 8 4 6 5]]
|
|
(assert (= &(Maybe.Just 9) &(maximum &xs)))))
|
|
|
|
(defn array-minimum []
|
|
(let [xs [8 4 6 5 1 7 2 9 3]]
|
|
(assert (= &(Maybe.Just 1) &(minimum &xs)))))
|
|
|
|
(defn array-sum []
|
|
(let [xs [10 20 30 40 50]]
|
|
(assert (= 150 (sum &xs)))))
|
|
|
|
(defn array-subarray []
|
|
(let [xs [@"a" @"b" @"c" @"d" @"e"]]
|
|
(assert (= &[@"c" @"d"] &(Array.subarray &xs 2 4)))))
|
|
|
|
(defn array-reverse-1 []
|
|
(let [xs [@"a" @"b" @"c" @"d" @"e"]]
|
|
(assert (= &[@"e" @"d" @"c" @"b" @"a"]
|
|
&(Array.reverse xs)))))
|
|
|
|
(defn array-index-of []
|
|
(let [xs [@"a" @"b" @"c" @"d" @"e"]]
|
|
(assert (= &(Maybe.Just 2) &(Array.index-of &xs "c")))))
|
|
|
|
(defn array-element-count []
|
|
(let [xs [@"a" @"b" @"a" @"a" @"b"]]
|
|
(assert (= 3 (Array.element-count &xs "a")))))
|
|
|
|
(defn first-letter [s]
|
|
(String.substring s 0 1))
|
|
|
|
(defn array-aupdate []
|
|
(let [xs [@"abc" @"xyz"]
|
|
ys (Array.aupdate xs 1 &first-letter)]
|
|
(assert (= &[@"abc" @"x"] &ys))))
|
|
|
|
(defn array-aupdate! []
|
|
(let [xs [@"abc" @"xyz"]]
|
|
(do
|
|
(Array.aupdate! &xs 1 &first-letter)
|
|
(assert (= &[@"abc" @"x"] &xs)))))
|
|
|
|
(defn array-swap []
|
|
(let [xs [@"a" @"b" @"c"]
|
|
ys (Array.swap xs 0 2)]
|
|
(assert (= &[@"c" @"b" @"a"] &ys))))
|
|
|
|
(defn array-swap! []
|
|
(let [xs [@"a" @"b" @"c"]]
|
|
(do
|
|
(Array.swap! &xs 0 2)
|
|
(assert (= &[@"c" @"b" @"a"] &xs)))))
|
|
|
|
(defn array-range []
|
|
(let [xs (Array.range 0 5 1)]
|
|
(assert (= &[0 1 2 3 4 5] &xs))))
|
|
|
|
;; TODO! Failing to compile this...
|
|
;; (defmodule ArrayCompareExtension
|
|
;; (defn < [a b]
|
|
;; (Int.< (Array.length a)
|
|
;; (Array.length b)))
|
|
;; (defn > [a b]
|
|
;; (Int.> (Array.length a)
|
|
;; (Array.length b))))
|
|
;; (defn array-sort-1 []
|
|
;; (let [xs [[0 0] [0 0 0] [0 0 0 0] [0]]
|
|
;; ys (Array.sort xs)]
|
|
;; (assert (= &[[0] [0 0] [0 0 0] [0 0 0 0]] &ys))))
|
|
|
|
(defn array-sort-2 []
|
|
(let [xs [5 2 4 3 1]
|
|
ys (Array.sort xs)]
|
|
(assert (= &[1 2 3 4 5] &ys))))
|
|
|
|
(defn f [] @"Hello")
|
|
|
|
(defn array-repeat []
|
|
(let [xs (Array.repeat 4 &f)]
|
|
(assert (= &[@"Hello" @"Hello" @"Hello" @"Hello"] &xs))))
|
|
|
|
(defn array-replicate []
|
|
(let [xs (Array.replicate 4 "Hello")]
|
|
(assert (= &[@"Hello" @"Hello" @"Hello" @"Hello"] &xs))))
|
|
|
|
(defn array-copy-map-1 []
|
|
(let [xs [@"a" @"bb" @"ccc"]
|
|
ys (Array.copy-map &String.length &xs)]
|
|
(assert (= &[1 2 3] &ys))))
|
|
|
|
(defn str-ref [r]
|
|
(Int.str @r))
|
|
|
|
(defn array-copy-map-2 []
|
|
(let [xs [1 2 3 4]
|
|
ys (Array.copy-map &str-ref &xs)]
|
|
(assert (= &[@"1" @"2" @"3" @"4"] &ys))))
|
|
|
|
(defn string-append-leak-test []
|
|
(let [a "abcdef"
|
|
b "ghijklmnopqrstuvwxyz"]
|
|
(let [result (String.append a b)]
|
|
(assert (StringCopy.= result @"abcdefghijklmnopqrstuvwxyz")))))
|
|
|
|
(defn stringcopy-append-leak-test []
|
|
(let [a "abcdef"
|
|
b "ghijklmnopqrstuvwxyz"]
|
|
(let [result (StringCopy.append @a @b)]
|
|
(assert (StringCopy.= result @"abcdefghijklmnopqrstuvwxyz")))))
|
|
|
|
(defn lambda-1 []
|
|
(let [s @"X"
|
|
f (fn [] @&s)] ;; each call needs to produce a new copy of the string
|
|
(do
|
|
(assert (= @"X" (f)))
|
|
(assert (= @"X" (f)))
|
|
(assert (= @"X" (f))))))
|
|
|
|
(defn lambda-2 []
|
|
(let [xs [10 20 30]
|
|
f (fn [ys] (Array.concat &[@&xs ys]))]
|
|
(assert (= &[10 20 30 40 50] &(f [40 50])))))
|
|
|
|
(defn lambda-3 []
|
|
(let-do [stuff [100 200 300]
|
|
f (fn [n] (copy (nth &stuff n)))]
|
|
(assert (= 100 (f 0)))
|
|
(assert (= 200 (f 1)))
|
|
(assert (= 300 (f 2)))))
|
|
|
|
(defn lambda-4 []
|
|
(let-do [stuff [@"A" @"B" @"C"]]
|
|
(assert (= &[@"X" @"X" @"X"] &(copy-map &(fn [c] @"X") &stuff)))))
|
|
|
|
(defn lambda-5 []
|
|
(let-do [stuff [@"A" @"B" @"C"]]
|
|
(assert (= &[@"X" @"X" @"X"] &(endo-map &(fn [c] @"X") stuff)))))
|
|
|
|
(deftype StrangeThings
|
|
(Piff [String String])
|
|
(Puff [String String]))
|
|
|
|
(defn sumtype-1 []
|
|
(let [thing (StrangeThings.Piff @"A" @"B")]
|
|
(assert
|
|
(= @"B"
|
|
(match thing
|
|
(StrangeThings.Piff a b) b
|
|
(StrangeThings.Puff c d) d)))))
|
|
|
|
(defn sumtype-2 []
|
|
(let [thing (StrangeThings.Puff @"A" @"B")]
|
|
(assert
|
|
(= @"A"
|
|
(match thing
|
|
(StrangeThings.Piff a b) b
|
|
(StrangeThings.Puff a b) a)))))
|
|
|
|
(defn sumtype-3 []
|
|
(let [thing (StrangeThings.Piff @"A" @"B")
|
|
another-thing @"blah"]
|
|
(assert
|
|
(= @"A"
|
|
(match thing
|
|
(StrangeThings.Piff a b) a
|
|
(StrangeThings.Puff c d) another-thing)))))
|
|
|
|
(defn sumtype-4 []
|
|
(let [m (Maybe.Just @"Yo")]
|
|
(assert
|
|
(= @"Yo"
|
|
(match m
|
|
(Maybe.Just x) x
|
|
(Maybe.Nothing) @"Nope")))))
|
|
|
|
(defn sumtype-5 []
|
|
(let [m (Maybe.Nothing)]
|
|
(assert
|
|
(= @"Nope"
|
|
(match m
|
|
(Maybe.Just x) x
|
|
(Maybe.Nothing) @"Nope")))))
|
|
|
|
(deftype Name
|
|
(Simple [String String])
|
|
(Fancy [String String String]))
|
|
|
|
(defn sumtype-6 []
|
|
(let [m (Name.Simple @"Mrs" @"Robinson")]
|
|
(assert
|
|
(= 1
|
|
(match m
|
|
(Name.Simple _ _) 1
|
|
(Name.Fancy _ _ _) 2)))))
|
|
|
|
(defn sumtype-7 []
|
|
(let [m (Name.Fancy @"Mr" @"von" @"Plutt")]
|
|
(assert
|
|
(= 1
|
|
(match m
|
|
_ 1)))))
|
|
|
|
(deftest test
|
|
(assert-no-leak test scope-1 "scope-1 does not leak")
|
|
(assert-no-leak test scope-2 "scope-2 does not leak")
|
|
(assert-no-leak test scope-3 "scope-3 does not leak")
|
|
(assert-no-leak test call-1 "call-1 does not leak")
|
|
(assert-no-leak test call-2 "call-2 does not leak")
|
|
(assert-no-leak test call-3 "call-2 does not leak")
|
|
(assert-no-leak test call-4 "call-2 does not leak")
|
|
(assert-no-leak test struct-1 "struct-1 does not leak")
|
|
(assert-no-leak test struct-2 "struct-2 does not leak")
|
|
(assert-no-leak test struct-3 "struct-3 does not leak")
|
|
(assert-no-leak test struct-4 "struct-4 does not leak")
|
|
(assert-no-leak test struct-5 "struct-5 does not leak")
|
|
(assert-no-leak test setting-1 "setting-1 does not leak")
|
|
(assert-no-leak test setting-2 "setting-2 does not leak")
|
|
(assert-no-leak test setting-3 "setting-3 does not leak")
|
|
(assert-no-leak test setting-4 "setting-4 does not leak")
|
|
(assert-no-leak test setting-5 "setting-5 does not leak")
|
|
(assert-no-leak test global-1 "global-1 does not leak")
|
|
(assert-no-leak test global-2 "global-2 does not leak")
|
|
(assert-no-leak test if-1 "if-1 does not leak")
|
|
(assert-no-leak test if-2 "if-2 does not leak")
|
|
(assert-no-leak test if-3 "if-3 does not leak")
|
|
(assert-no-leak test if-4 "if-4 does not leak")
|
|
(assert-no-leak test if-5 "if-5 does not leak")
|
|
(assert-no-leak test if-6 "if-6 does not leak")
|
|
(assert-no-leak test string-substring "string-substring does not leak")
|
|
(assert-no-leak test array-aset "array-aset does not leak")
|
|
(assert-no-leak test array-reduce "array-reduce does not leak")
|
|
(assert-no-leak test array-endo-filter "array-endo-filter does not leak")
|
|
(assert-no-leak test array-copy-filter "array-copy-filter does not leak")
|
|
(assert-no-leak test array-first "array-first does not leak")
|
|
(assert-no-leak test array-last "array-last does not leak")
|
|
(assert-no-leak test array-eq-1 "array-eq-1 does not leak")
|
|
(assert-no-leak test array-eq-2 "array-eq-2 does not leak")
|
|
(assert-no-leak test array-maximum "array-maximum does not leak")
|
|
(assert-no-leak test array-minimum "array-minimum does not leak")
|
|
(assert-no-leak test array-sum "array-sum does not leak")
|
|
(assert-no-leak test array-subarray "array-subarray does not leak")
|
|
(assert-no-leak test array-reverse-1 "array-reverse-2 does not leak")
|
|
(assert-no-leak test array-index-of "array-index-of does not leak")
|
|
(assert-no-leak test array-element-count "array-element-count does not leak")
|
|
(assert-no-leak test array-aupdate "array-aupdate does not leak")
|
|
(assert-no-leak test array-aupdate! "array-aupdate! does not leak")
|
|
(assert-no-leak test array-swap "array-swap does not leak")
|
|
(assert-no-leak test array-swap! "array-swap! does not leak")
|
|
(assert-no-leak test array-range "array-range does not leak")
|
|
;; PROBLEMATIC (assert-no-leak test array-sort-1 "array-sort-1 does not leak")
|
|
(assert-no-leak test array-sort-2 "array-sort-2 does not leak")
|
|
(assert-no-leak test array-repeat "array-repeat does not leak")
|
|
(assert-no-leak test array-replicate "array-replicate does not leak")
|
|
(assert-no-leak test array-copy-map-1 "array-copy-map-1 does not leak")
|
|
(assert-no-leak test array-copy-map-2 "array-copy-map-2 does not leak")
|
|
(assert-no-leak test string-append-leak-test "String.append does not leak")
|
|
(assert-no-leak test stringcopy-append-leak-test "StringCopy.append does not leak")
|
|
(assert-no-leak test lambda-1 "lambda-1 does not leak")
|
|
(assert-no-leak test lambda-2 "lambda-2 does not leak")
|
|
(assert-no-leak test lambda-3 "lambda-3 does not leak")
|
|
(assert-no-leak test lambda-4 "lambda-4 does not leak")
|
|
(assert-no-leak test lambda-5 "lambda-5 does not leak")
|
|
(assert-no-leak test sumtype-1 "sumtype-1 does not leak")
|
|
(assert-no-leak test sumtype-2 "sumtype-2 does not leak")
|
|
(assert-no-leak test sumtype-3 "sumtype-3 does not leak")
|
|
(assert-no-leak test sumtype-4 "sumtype-4 does not leak")
|
|
(assert-no-leak test sumtype-5 "sumtype-5 does not leak")
|
|
(assert-no-leak test sumtype-6 "sumtype-6 does not leak")
|
|
(assert-no-leak test sumtype-7 "sumtype-7 does not leak")
|
|
)
|