joy-in-the-morning/tests/inicheck.joy

(* inicheck.joy -- primitive unit test combinators.
   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/>.
*)

(* Commentary:

   Test routines that make use of only Joy primitives, so that the
   standard library routines may be tested.

   Code: *)

DEFINE
  (* private *)
  newline == '\n putch ;
  puts == putchars newline ;
  primitive-check ==
    putchars " " putchars
    ["ok" puts] ["fail" puts]
    choice infra ;

  (* Use these combinators in the following way:

     "foo" [P] satisfies [P'] ? .

     P is executed, immediately followed by a predicate P', which
     should leave true or false on the top of the stack to indicate
     success or failure of the test.  If succesful, "foo ok" is
     printed to stdout, otherwise "foo fail". *)
  satisfies == swap putchars [] swap infra ;
  ? == infra uncons pop
       [" ok" puts] [" fail" puts]
       choice [] swap infra pop ;
END

(* Before exporting these test routines, do what sanity checking we
   can do on our primitives. *)
[] [true] uncons pop "choice" primitive-check
[] 3 3 = "=" primitive-check
[] 1 3 + 4 = "+" primitive-check
[] 4 2 - 2 = "=" primitive-check
[] 2 4 < "<" primitive-check
[] 4 2 > ">" primitive-check
[] 2 dup + 4 = "dup" primitive-check
[] 2 4 pop 2 = "pop" primitive-check
[] [3 1] dup [+] infra uncons pop 4 = "dup list" primitive-check
[] [true]  uncons pop logical "logical" primitive-check
[] [false] uncons pop logical "logical false" primitive-check
[] 'b char "char" primitive-check
[] 2 integer "integer" primitive-check
[] "foo" string "string" primitive-check
[] ['b 2] string [false] uncons pop = "list!string" primitive-check
[] 2 string [false] uncons pop = "num!string" primitive-check
[] [2] list "list" primitive-check