joy-in-the-morning/tests/test-base.joy

(* test-base.joy -- tests for base.joy
   Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
  
   Joy is free software; you can redistribute it and/or modify it under
   the terms of the GNU General Public License as published by the Free
   Software Foundation; either version 3 of the License, or (at your
   option) any later version.
  
   Joy is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.
  
   You should have received a copy of the GNU General Public License
   along with Joy.  If not, see <http://www.gnu.org/licenses/>.
*)

"base" include
"inicheck" include

DEFINE
  test-swons == "swons" [[3] 2 swons car] satisfies [2 =] ? ;
  test-unswons == "unswons" [[2 3] unswons] satisfies [2 =] ? ;

  test-car == "car" [[1 2] car] satisfies [1 =] ? ;
  test-cdr == "cdr" [[1 2] cdr car] satisfies [2 =] ? ;
  test-cadr == "cadr" [[1 2] cadr] satisfies [2 =] ? ;

  test-first ==
    "first" [[1 2 3] first] satisfies [1 =] ? ;
  test-second ==
    "second" [[1 2 3] second] satisfies [2 =] ? ;
  test-third ==
    "third" [[1 2 3] third] satisfies [3 =] ? ;

  test-booleans ==
    "true" [true] satisfies [1 0 choice 1 =] ?
    "false" [false] satisfies [1 0 choice 0 =] ? ;

  test-leaf ==
    "numeric leaf" [2 leaf] satisfies [true =] ?
    "char leaf"    ['b leaf] satisfies [true =] ?
    "string leaf"  ["foo" leaf] satisfies [false =] ?
    "list leaf"    [[1 2] leaf] satisfies [false =] ? ;
  test-null ==
    "numeric null(0)"  [0 null]   satisfies [true =] ?
    "numeric non-null" [1 null]   satisfies [false =] ?
    "null list"        [[] null]  satisfies [true =] ?
    "non-null list"    [[1] null] satisfies [false =] ? ;
  test-nulld ==
    "numeric nulld"     [0 1 nulld] satisfies [pop true =] ?
    "numeric non-nulld" [1 0 nulld] satisfies [pop false =] ?
    "list nulld"        [[] [1] nulld] satisfies [pop true =] ?
    "list non-nulld"    [[1] [] nulld] satisfies [pop false =] ? ;

  test-newstack ==
    "newstack" [newstack] satisfies [stack null] ? ;

  test-i ==
    "i id" [1 [] i] satisfies [1 =] ?
    "i atom" [[1] i] satisfies [1 =] ?
    "i pop" [1 2 [pop] i] satisfies [1 =] ?
    "i +" [1 2 [+] i] satisfies [3 =] ?
    "i2 id" [1 2 [] [] i2] satisfies [2 =] ?
    "i2 +" [1 2 [3 +] [2 +] i2] satisfies [=] ? ;

  test-dip ==
    "dip id" [1 2 [] dip] satisfies [pop 1 =] ?
    "dip atom" [2 [1] dip] satisfies [pop 1 =] ?
    "dip pop" [1 2 3 [pop] dip] satisfies [3 =] ?
    "dip pop 2" [1 2 3 [pop] dip] satisfies [pop 1 =] ? ;

  test-b ==
    "b +" [1 2 3 [+] [+] b] satisfies [6 =] ?
    "b" [4 [2 +] [3 -] b] satisfies [3 =] ? ;

  test-cleave ==
    "cleave" [2 [1 +] [4 +] cleave] satisfies [[3 =] [6 =] i2 and] ? ;

  test-branch ==
    "branch true" [true [1] [0] branch] satisfies [1 =] ?
    "branch false" [false [1] [0] branch] satisfies [0 =] ?
    "ifte true" [1 [0 >] [1] [0] ifte] satisfies [1 =] ?
    "ifte false" [0 [0 >] [1] [0] ifte] satisfies [0 =] ?
    "ifte restore" [2 [pop true] [2 +] [] ifte] satisfies [4 =] ? ;

  test-logic ==
    "not true"  [true not]  satisfies [false =] ?
    "not false" [false not]satisfies [true =] ?
    "or tt"  [true true]   satisfies [or] ?
    "or tf"  [true false]  satisfies [or] ?
    "or ft"  [false true]  satisfies [or] ?
    "or ff"  [false false] satisfies [or not] ?
    "and tt" [true true]   satisfies [and] ?
    "and tf" [true false]  satisfies [and not] ?
    "and ft" [false true]  satisfies [and not] ?
    "and ff" [false false] satisfies [and not] ?
    "xor tt" [true true]   satisfies [xor not] ?
    "xor tf" [true false]  satisfies [xor] ?
    "xor ft" [false true]  satisfies [xor] ?
    "xor ff" [false false] satisfies [xor not] ? ;

  test-pop ==
    "pop2"   [1 2 3 pop2] satisfies [1 =] ?
    "popop"  [1 2 3 pop2] satisfies [1 =] ?
    "popd"   [1 2 3 popd] satisfies [3 =] ?
    "popd 2" [1 2 3 popd] satisfies [pop 1 =] ? ;

  test-dup ==
    "dup2"   [2 3 dup2] satisfies [[2 =] dip 3 = and] ?
    "dupd"   [2 3 dupd] satisfies [[2 =] dip 3 = and] ? ;

  test-roll ==
    "rollup"   [1 2 3 rollup] satisfies [2 = [1 =] dip and
                                         [3 =] dip and] ?
    "rolldown" [1 2 3 rolldown] satisfies [1 = [3 =] dip and
                                           [2 =] dip and] ?
    "rotate"   [1 2 3 rotate] satisfies [1 = [2 =] dip and
                                         [3 =] dip and] ? ;

  test-app ==
    "app2" [1 3 [1 +] app2] satisfies [4 = [2 =] dip and] ?
    "app3" [1 3 5 [2 >] app3] satisfies [and [true =]
                                             [false =] i2] ? ;

  test-maxima ==
    ">="  [2 3 >= 3 3 >= 4 3 >=] satisfies [and swap not and] ?
    "<="  [2 3 <= 3 3 <= 4 3 <=] satisfies [not and and] ?
    "!="  [2 3 != 3 3 !=]        satisfies [not and] ?
    "max" [2 3 max -2 3 max]     satisfies [[3 =] app2 and] ? ;

  test-arithmetic ==
    "*" [3 7 * 0 5 *] satisfies [[21 =] [null] i2 and] ?
    "divmod" [11 3 divmod] satisfies [[3 =] [2 =] i2 and] ?
    "/" [21 5 / 25 25 /] satisfies [[4 =] [1 =] i2 and] ?
    "%" [21 2 % 37 5 %] satisfies [[1 =] [2 =] i2 and] ?
    "exp"  [2 3 exp 3 0 exp] satisfies [[8 =] [1 =] i2 and] ?
    ;

  test-linrec ==
    (* We test * and divmod here because they are currently
       implemented in joy itself using linear recursion. *)
    "fact" [0 fact 4 fact] satisfies [[1 =] [24 =] i2 and] ?
    "sum-up-to" [6 sum-up-to] satisfies [21 =] ? ;

  test-aggregates ==
    "step" [[1 2 3] [] step]
           satisfies [[2 =] [3 =] i2 and [1 =] dip and] ?
    "step +" [[1 3] [5 +] step] satisfies [[6 =] [8 =] i2 and] ?
    "reverse" [[1 2] reverse]
              satisfies [[[1 =] [2 =] i2 and] infra car] ?
    "fold +" [[1 4 5] 0 [+] fold] satisfies [10 =] ?
    "fold swons" [[1 4 5] [] [swons] fold]
                 satisfies [unstack 5 = swap 4 = and [1 =] dip and] ?
    "fold or" [[false true false] false [or] fold]
              satisfies [true =] ?
    "fold and" [[true true false] true [and] fold]
               satisfies [false =] ?
    "sum" [[1 2 8 9] sum] satisfies [20 =] ?
    "product" [[1 2 8 9] product] satisfies [144 =] ?
    "size" [[] size [1 4 8 9] size] satisfies [[0 =] [4 =] i2 and] ?
    "map id" [[1 2] [] map]
             satisfies [[[2 =] [1 =] i2 and] infra car] ?
    "map +" [[1 2] [10 +] map]
            satisfies [[[12 =] [11 =] i2 and] infra car] ?
    "map >" [[3 7] [4 >] map]
            satisfies [[[true =] [false =] i2 and] infra car] ?
    "list-tail" [[1 2 3] [1 list-tail car] [2 list-tail car] cleave]
           satisfies [[2 =] [3 =] i2 and] ?
    "list-head" [[1 2 3] [2 list-head i] [1 list-head i] cleave]
           satisfies [[2 =] [1 =] i2 and] ?
    "at"   [[1 2 3 4] [2 at] [1 at] cleave]
           satisfies [[3 =] [2 =] i2 and] ?
    "of"   [[1 2 3 4] [2 swap of] [1 swap of] cleave]
           satisfies [[3 =] [2 =] i2 and] ?
    ;

  run-base-tests ==
    test-swons
    test-unswons
    test-car
    test-cdr
    test-cadr
    test-first
    test-second
    test-third
    test-booleans
    test-leaf
    test-null
    test-nulld
    test-newstack
    test-i
    test-dip
    test-b
    test-cleave
    test-branch
    test-logic
    test-pop
    test-dup
    test-roll
    test-maxima
    test-arithmetic
    test-linrec
    test-aggregates ;
END

run-base-tests