diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/procedure/common.lux | 510 |
1 files changed, 255 insertions, 255 deletions
diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux index 9ebcf6880..dd099829c 100644 --- a/new-luxc/test/test/luxc/analyser/procedure/common.lux +++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux @@ -39,268 +39,268 @@ [check-failure+ false true] ) -(test: "Lux procedures" +(context: "Lux procedures" [[primT primC] gen-primitive [antiT antiC] (|> gen-primitive (r;filter (|>. product;left (Type/= primT) not)))] ($_ seq - (assert "Can test for reference equality." - (check-success+ "lux is" (list primC primC) Bool)) - (assert "Reference equality must be done with elements of the same type." - (check-failure+ "lux is" (list primC antiC) Bool)) - (assert "Can 'try' risky IO computations." - (check-success+ "lux try" - (list (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) - (type (Either Text primT)))) + (test "Can test for reference equality." + (check-success+ "lux is" (list primC primC) Bool)) + (test "Reference equality must be done with elements of the same type." + (check-failure+ "lux is" (list primC antiC) Bool)) + (test "Can 'try' risky IO computations." + (check-success+ "lux try" + (list (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) + (type (Either Text primT)))) )) -(test: "Bit procedures" +(context: "Bit procedures" [subjectC (|> r;nat (:: @ map code;nat)) signedC (|> r;int (:: @ map code;int)) paramC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can count the number of 1 bits in a bit pattern." - (check-success+ "bit count" (list subjectC) Nat)) - (assert "Can perform bit 'and'." - (check-success+ "bit and" (list subjectC paramC) Nat)) - (assert "Can perform bit 'or'." - (check-success+ "bit or" (list subjectC paramC) Nat)) - (assert "Can perform bit 'xor'." - (check-success+ "bit xor" (list subjectC paramC) Nat)) - (assert "Can shift bit pattern to the left." - (check-success+ "bit shift-left" (list subjectC paramC) Nat)) - (assert "Can shift bit pattern to the right." - (check-success+ "bit unsigned-shift-right" (list subjectC paramC) Nat)) - (assert "Can shift signed bit pattern to the right." - (check-success+ "bit shift-right" (list signedC paramC) Int)) + (test "Can count the number of 1 bits in a bit pattern." + (check-success+ "bit count" (list subjectC) Nat)) + (test "Can perform bit 'and'." + (check-success+ "bit and" (list subjectC paramC) Nat)) + (test "Can perform bit 'or'." + (check-success+ "bit or" (list subjectC paramC) Nat)) + (test "Can perform bit 'xor'." + (check-success+ "bit xor" (list subjectC paramC) Nat)) + (test "Can shift bit pattern to the left." + (check-success+ "bit shift-left" (list subjectC paramC) Nat)) + (test "Can shift bit pattern to the right." + (check-success+ "bit unsigned-shift-right" (list subjectC paramC) Nat)) + (test "Can shift signed bit pattern to the right." + (check-success+ "bit shift-right" (list signedC paramC) Int)) )) -(test: "Nat procedures" +(context: "Nat procedures" [subjectC (|> r;nat (:: @ map code;nat)) paramC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can add natural numbers." - (check-success+ "nat +" (list subjectC paramC) Nat)) - (assert "Can subtract natural numbers." - (check-success+ "nat -" (list subjectC paramC) Nat)) - (assert "Can multiply natural numbers." - (check-success+ "nat *" (list subjectC paramC) Nat)) - (assert "Can divide natural numbers." - (check-success+ "nat /" (list subjectC paramC) Nat)) - (assert "Can calculate remainder of natural numbers." - (check-success+ "nat %" (list subjectC paramC) Nat)) - (assert "Can test equality of natural numbers." - (check-success+ "nat =" (list subjectC paramC) Bool)) - (assert "Can compare natural numbers." - (check-success+ "nat <" (list subjectC paramC) Bool)) - (assert "Can obtain minimum natural number." - (check-success+ "nat min" (list) Nat)) - (assert "Can obtain maximum natural number." - (check-success+ "nat max" (list) Nat)) - (assert "Can convert natural number to integer." - (check-success+ "nat to-int" (list subjectC) Int)) - (assert "Can convert natural number to text." - (check-success+ "nat to-text" (list subjectC) Text)) + (test "Can add natural numbers." + (check-success+ "nat +" (list subjectC paramC) Nat)) + (test "Can subtract natural numbers." + (check-success+ "nat -" (list subjectC paramC) Nat)) + (test "Can multiply natural numbers." + (check-success+ "nat *" (list subjectC paramC) Nat)) + (test "Can divide natural numbers." + (check-success+ "nat /" (list subjectC paramC) Nat)) + (test "Can calculate remainder of natural numbers." + (check-success+ "nat %" (list subjectC paramC) Nat)) + (test "Can test equality of natural numbers." + (check-success+ "nat =" (list subjectC paramC) Bool)) + (test "Can compare natural numbers." + (check-success+ "nat <" (list subjectC paramC) Bool)) + (test "Can obtain minimum natural number." + (check-success+ "nat min" (list) Nat)) + (test "Can obtain maximum natural number." + (check-success+ "nat max" (list) Nat)) + (test "Can convert natural number to integer." + (check-success+ "nat to-int" (list subjectC) Int)) + (test "Can convert natural number to text." + (check-success+ "nat to-text" (list subjectC) Text)) )) -(test: "Int procedures" +(context: "Int procedures" [subjectC (|> r;int (:: @ map code;int)) paramC (|> r;int (:: @ map code;int))] ($_ seq - (assert "Can add integers." - (check-success+ "int +" (list subjectC paramC) Int)) - (assert "Can subtract integers." - (check-success+ "int -" (list subjectC paramC) Int)) - (assert "Can multiply integers." - (check-success+ "int *" (list subjectC paramC) Int)) - (assert "Can divide integers." - (check-success+ "int /" (list subjectC paramC) Int)) - (assert "Can calculate remainder of integers." - (check-success+ "int %" (list subjectC paramC) Int)) - (assert "Can test equality of integers." - (check-success+ "int =" (list subjectC paramC) Bool)) - (assert "Can compare integers." - (check-success+ "int <" (list subjectC paramC) Bool)) - (assert "Can obtain minimum integer." - (check-success+ "int min" (list) Int)) - (assert "Can obtain maximum integer." - (check-success+ "int max" (list) Int)) - (assert "Can convert integer to natural number." - (check-success+ "int to-nat" (list subjectC) Nat)) - (assert "Can convert integer to real number." - (check-success+ "int to-real" (list subjectC) Real)) + (test "Can add integers." + (check-success+ "int +" (list subjectC paramC) Int)) + (test "Can subtract integers." + (check-success+ "int -" (list subjectC paramC) Int)) + (test "Can multiply integers." + (check-success+ "int *" (list subjectC paramC) Int)) + (test "Can divide integers." + (check-success+ "int /" (list subjectC paramC) Int)) + (test "Can calculate remainder of integers." + (check-success+ "int %" (list subjectC paramC) Int)) + (test "Can test equality of integers." + (check-success+ "int =" (list subjectC paramC) Bool)) + (test "Can compare integers." + (check-success+ "int <" (list subjectC paramC) Bool)) + (test "Can obtain minimum integer." + (check-success+ "int min" (list) Int)) + (test "Can obtain maximum integer." + (check-success+ "int max" (list) Int)) + (test "Can convert integer to natural number." + (check-success+ "int to-nat" (list subjectC) Nat)) + (test "Can convert integer to real number." + (check-success+ "int to-real" (list subjectC) Real)) )) -(test: "Deg procedures" +(context: "Deg procedures" [subjectC (|> r;deg (:: @ map code;deg)) paramC (|> r;deg (:: @ map code;deg)) natC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can add degrees." - (check-success+ "deg +" (list subjectC paramC) Deg)) - (assert "Can subtract degrees." - (check-success+ "deg -" (list subjectC paramC) Deg)) - (assert "Can multiply degrees." - (check-success+ "deg *" (list subjectC paramC) Deg)) - (assert "Can divide degrees." - (check-success+ "deg /" (list subjectC paramC) Deg)) - (assert "Can calculate remainder of degrees." - (check-success+ "deg %" (list subjectC paramC) Deg)) - (assert "Can test equality of degrees." - (check-success+ "deg =" (list subjectC paramC) Bool)) - (assert "Can compare degrees." - (check-success+ "deg <" (list subjectC paramC) Bool)) - (assert "Can obtain minimum degree." - (check-success+ "deg min" (list) Deg)) - (assert "Can obtain maximum degree." - (check-success+ "deg max" (list) Deg)) - (assert "Can convert degree to real number." - (check-success+ "deg to-real" (list subjectC) Real)) - (assert "Can scale degree." - (check-success+ "deg scale" (list subjectC natC) Deg)) - (assert "Can calculate the reciprocal of a natural number." - (check-success+ "deg reciprocal" (list natC) Deg)) + (test "Can add degrees." + (check-success+ "deg +" (list subjectC paramC) Deg)) + (test "Can subtract degrees." + (check-success+ "deg -" (list subjectC paramC) Deg)) + (test "Can multiply degrees." + (check-success+ "deg *" (list subjectC paramC) Deg)) + (test "Can divide degrees." + (check-success+ "deg /" (list subjectC paramC) Deg)) + (test "Can calculate remainder of degrees." + (check-success+ "deg %" (list subjectC paramC) Deg)) + (test "Can test equality of degrees." + (check-success+ "deg =" (list subjectC paramC) Bool)) + (test "Can compare degrees." + (check-success+ "deg <" (list subjectC paramC) Bool)) + (test "Can obtain minimum degree." + (check-success+ "deg min" (list) Deg)) + (test "Can obtain maximum degree." + (check-success+ "deg max" (list) Deg)) + (test "Can convert degree to real number." + (check-success+ "deg to-real" (list subjectC) Real)) + (test "Can scale degree." + (check-success+ "deg scale" (list subjectC natC) Deg)) + (test "Can calculate the reciprocal of a natural number." + (check-success+ "deg reciprocal" (list natC) Deg)) )) -(test: "Real procedures" +(context: "Real procedures" [subjectC (|> r;real (:: @ map code;real)) paramC (|> r;real (:: @ map code;real)) encodedC (|> (r;text +5) (:: @ map code;text))] ($_ seq - (assert "Can add real numbers." - (check-success+ "real +" (list subjectC paramC) Real)) - (assert "Can subtract real numbers." - (check-success+ "real -" (list subjectC paramC) Real)) - (assert "Can multiply real numbers." - (check-success+ "real *" (list subjectC paramC) Real)) - (assert "Can divide real numbers." - (check-success+ "real /" (list subjectC paramC) Real)) - (assert "Can calculate remainder of real numbers." - (check-success+ "real %" (list subjectC paramC) Real)) - (assert "Can test equality of real numbers." - (check-success+ "real =" (list subjectC paramC) Bool)) - (assert "Can compare real numbers." - (check-success+ "real <" (list subjectC paramC) Bool)) - (assert "Can obtain minimum real number." - (check-success+ "real min" (list) Real)) - (assert "Can obtain maximum real number." - (check-success+ "real max" (list) Real)) - (assert "Can obtain smallest real number." - (check-success+ "real smallest" (list) Real)) - (assert "Can obtain not-a-number." - (check-success+ "real not-a-number" (list) Real)) - (assert "Can obtain positive infinity." - (check-success+ "real positive-infinity" (list) Real)) - (assert "Can obtain negative infinity." - (check-success+ "real negative-infinity" (list) Real)) - (assert "Can convert real number to integer." - (check-success+ "real to-int" (list subjectC) Int)) - (assert "Can convert real number to degree." - (check-success+ "real to-deg" (list subjectC) Deg)) - (assert "Can convert real number to text." - (check-success+ "real to-text" (list subjectC) Text)) - (assert "Can convert text to real number." - (check-success+ "real from-text" (list encodedC) (type (Maybe Real)))) + (test "Can add real numbers." + (check-success+ "real +" (list subjectC paramC) Real)) + (test "Can subtract real numbers." + (check-success+ "real -" (list subjectC paramC) Real)) + (test "Can multiply real numbers." + (check-success+ "real *" (list subjectC paramC) Real)) + (test "Can divide real numbers." + (check-success+ "real /" (list subjectC paramC) Real)) + (test "Can calculate remainder of real numbers." + (check-success+ "real %" (list subjectC paramC) Real)) + (test "Can test equality of real numbers." + (check-success+ "real =" (list subjectC paramC) Bool)) + (test "Can compare real numbers." + (check-success+ "real <" (list subjectC paramC) Bool)) + (test "Can obtain minimum real number." + (check-success+ "real min" (list) Real)) + (test "Can obtain maximum real number." + (check-success+ "real max" (list) Real)) + (test "Can obtain smallest real number." + (check-success+ "real smallest" (list) Real)) + (test "Can obtain not-a-number." + (check-success+ "real not-a-number" (list) Real)) + (test "Can obtain positive infinity." + (check-success+ "real positive-infinity" (list) Real)) + (test "Can obtain negative infinity." + (check-success+ "real negative-infinity" (list) Real)) + (test "Can convert real number to integer." + (check-success+ "real to-int" (list subjectC) Int)) + (test "Can convert real number to degree." + (check-success+ "real to-deg" (list subjectC) Deg)) + (test "Can convert real number to text." + (check-success+ "real to-text" (list subjectC) Text)) + (test "Can convert text to real number." + (check-success+ "real from-text" (list encodedC) (type (Maybe Real)))) )) -(test: "Text procedures" +(context: "Text procedures" [subjectC (|> (r;text +5) (:: @ map code;text)) paramC (|> (r;text +5) (:: @ map code;text)) replacementC (|> (r;text +5) (:: @ map code;text)) fromC (|> r;nat (:: @ map code;nat)) toC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can test text equality." - (check-success+ "text =" (list subjectC paramC) Bool)) - (assert "Compare texts in lexicographical order." - (check-success+ "text <" (list subjectC paramC) Bool)) - (assert "Can prepend one text to another." - (check-success+ "text prepend" (list subjectC paramC) Text)) - (assert "Can find the index of a piece of text inside a larger one that (may) contain it." - (check-success+ "text index" (list subjectC paramC fromC) (type (Maybe Nat)))) - (assert "Can query the size/length of a text." - (check-success+ "text size" (list subjectC) Nat)) - (assert "Can calculate a hash code for text." - (check-success+ "text hash" (list subjectC) Nat)) - (assert "Can replace a text inside of a larger one (once)." - (check-success+ "text replace-once" (list subjectC paramC replacementC) Text)) - (assert "Can replace a text inside of a larger one (all times)." - (check-success+ "text replace-all" (list subjectC paramC replacementC) Text)) - (assert "Can obtain the character code of a text at a given index." - (check-success+ "text char" (list subjectC fromC) Nat)) - (assert "Can clip a piece of text between 2 indices." - (check-success+ "text clip" (list subjectC fromC toC) Text)) + (test "Can test text equality." + (check-success+ "text =" (list subjectC paramC) Bool)) + (test "Compare texts in lexicographical order." + (check-success+ "text <" (list subjectC paramC) Bool)) + (test "Can prepend one text to another." + (check-success+ "text prepend" (list subjectC paramC) Text)) + (test "Can find the index of a piece of text inside a larger one that (may) contain it." + (check-success+ "text index" (list subjectC paramC fromC) (type (Maybe Nat)))) + (test "Can query the size/length of a text." + (check-success+ "text size" (list subjectC) Nat)) + (test "Can calculate a hash code for text." + (check-success+ "text hash" (list subjectC) Nat)) + (test "Can replace a text inside of a larger one (once)." + (check-success+ "text replace-once" (list subjectC paramC replacementC) Text)) + (test "Can replace a text inside of a larger one (all times)." + (check-success+ "text replace-all" (list subjectC paramC replacementC) Text)) + (test "Can obtain the character code of a text at a given index." + (check-success+ "text char" (list subjectC fromC) Nat)) + (test "Can clip a piece of text between 2 indices." + (check-success+ "text clip" (list subjectC fromC toC) Text)) )) -(test: "Array procedures" +(context: "Array procedures" [[elemT elemC] gen-primitive sizeC (|> r;nat (:: @ map code;nat)) idxC (|> r;nat (:: @ map code;nat)) var-name (r;text +5) #let [arrayT (type (array;Array elemT))]] ($_ seq - (assert "Can create arrays." - (check-success+ "array new" (list sizeC) arrayT)) - (assert "Can get a value inside an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] - (&;with-expected-type elemT - (@;analyse-procedure analyse "array get" - (list idxC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (test "Can create arrays." + (check-success+ "array new" (list sizeC) arrayT)) + (test "Can get a value inside an array." + (|> (&env;with-scope "" + (&env;with-local [var-name arrayT] + (&;with-expected-type elemT + (@;analyse-procedure analyse "array get" + (list idxC + (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) - (assert "Can put a value inside an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] - (&;with-expected-type arrayT - (@;analyse-procedure analyse "array put" - (list idxC - elemC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (#R;Error _) + false))) + (test "Can put a value inside an array." + (|> (&env;with-scope "" + (&env;with-local [var-name arrayT] + (&;with-expected-type arrayT + (@;analyse-procedure analyse "array put" + (list idxC + elemC + (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) - (assert "Can remove a value from an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] - (&;with-expected-type arrayT - (@;analyse-procedure analyse "array remove" - (list idxC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (#R;Error _) + false))) + (test "Can remove a value from an array." + (|> (&env;with-scope "" + (&env;with-local [var-name arrayT] + (&;with-expected-type arrayT + (@;analyse-procedure analyse "array remove" + (list idxC + (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) - (assert "Can query the size of an array." - (|> (&env;with-scope "" - (&env;with-local [var-name arrayT] - (&;with-expected-type Nat - (@;analyse-procedure analyse "array size" - (list (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (#R;Error _) + false))) + (test "Can query the size of an array." + (|> (&env;with-scope "" + (&env;with-local [var-name arrayT] + (&;with-expected-type Nat + (@;analyse-procedure analyse "array size" + (list (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) + (#R;Error _) + false))) )) -(test: "Math procedures" +(context: "Math procedures" [subjectC (|> r;real (:: @ map code;real)) paramC (|> r;real (:: @ map code;real))] (with-expansions [<unary> (do-template [<proc> <desc>] - [(assert (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC) Real))] + [(test (format "Can calculate " <desc> ".") + (check-success+ <proc> (list subjectC) Real))] ["math cos" "cosine"] ["math sin" "sine"] @@ -319,8 +319,8 @@ ["math floor" "floor"] ["math round" "rounding"]) <binary> (do-template [<proc> <desc>] - [(assert (format "Can calculate " <desc> ".") - (check-success+ <proc> (list subjectC paramC) Real))] + [(test (format "Can calculate " <desc> ".") + (check-success+ <proc> (list subjectC paramC) Real))] ["math atan2" "inverse/arc tangent (with 2 arguments)"] ["math pow" "power"])] @@ -328,70 +328,70 @@ <unary> <binary>))) -(test: "Atom procedures" +(context: "Atom procedures" [[elemT elemC] gen-primitive sizeC (|> r;nat (:: @ map code;nat)) idxC (|> r;nat (:: @ map code;nat)) var-name (r;text +5) #let [atomT (type (atom;Atom elemT))]] ($_ seq - (assert "Can create atomic reference." - (check-success+ "atom new" (list elemC) atomT)) - (assert "Can read the value of an atomic reference." - (|> (&env;with-scope "" - (&env;with-local [var-name atomT] - (&;with-expected-type elemT - (@;analyse-procedure analyse "atom read" - (list (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (test "Can create atomic reference." + (check-success+ "atom new" (list elemC) atomT)) + (test "Can read the value of an atomic reference." + (|> (&env;with-scope "" + (&env;with-local [var-name atomT] + (&;with-expected-type elemT + (@;analyse-procedure analyse "atom read" + (list (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) - (assert "Can swap the value of an atomic reference." - (|> (&env;with-scope "" - (&env;with-local [var-name atomT] - (&;with-expected-type Bool - (@;analyse-procedure analyse "atom compare-and-swap" - (list elemC - elemC - (code;symbol ["" var-name])))))) - (macro;run (init-compiler [])) - (case> (#R;Success _) - true + (#R;Error _) + false))) + (test "Can swap the value of an atomic reference." + (|> (&env;with-scope "" + (&env;with-local [var-name atomT] + (&;with-expected-type Bool + (@;analyse-procedure analyse "atom compare-and-swap" + (list elemC + elemC + (code;symbol ["" var-name])))))) + (macro;run (init-compiler [])) + (case> (#R;Success _) + true - (#R;Error _) - false))) + (#R;Error _) + false))) )) -(test: "Process procedures" +(context: "Process procedures" [[primT primC] gen-primitive timeC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can query the level of concurrency." - (check-success+ "process concurrency-level" (list) Nat)) - (assert "Can run an IO computation concurrently." - (check-success+ "process future" - (list (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) - Unit)) - (assert "Can schedule an IO computation to run concurrently at some future time." - (check-success+ "process schedule" - (list timeC - (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) - Unit)) + (test "Can query the level of concurrency." + (check-success+ "process concurrency-level" (list) Nat)) + (test "Can run an IO computation concurrently." + (check-success+ "process future" + (list (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) + Unit)) + (test "Can schedule an IO computation to run concurrently at some future time." + (check-success+ "process schedule" + (list timeC + (` ((~' _lux_function) (~' _) (~' _) (~ primC)))) + Unit)) )) -(test: "IO procedures" +(context: "IO procedures" [logC (|> (r;text +5) (:: @ map code;text)) exitC (|> r;nat (:: @ map code;nat))] ($_ seq - (assert "Can log messages to standard output." - (check-success+ "io log" (list logC) Unit)) - (assert "Can log messages to standard output." - (check-success+ "io error" (list logC) Bottom)) - (assert "Can log messages to standard output." - (check-success+ "io exit" (list exitC) Bottom)) - (assert "Can query the current time (as milliseconds since epoch)." - (check-success+ "io current-time" (list) Int)) + (test "Can log messages to standard output." + (check-success+ "io log" (list logC) Unit)) + (test "Can log messages to standard output." + (check-success+ "io error" (list logC) Bottom)) + (test "Can log messages to standard output." + (check-success+ "io exit" (list exitC) Bottom)) + (test "Can query the current time (as milliseconds since epoch)." + (check-success+ "io current-time" (list) Int)) )) |