mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-07-06 03:08:31 +00:00
Add LISP interpreter
This commit is contained in:
Justine Tunney
parent
4f98ad1054
commit
d31bebdd2d
84 changed files with 9081 additions and 0 deletions
99
test/tool/plinko/algebra_test.lisp
Normal file
99
test/tool/plinko/algebra_test.lisp
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
#| plinko - a really fast lisp tarpit
|
||||
| Copyright 2022 Justine Alexandra Roberts Tunney
|
||||
|
|
||||
| Permission to use, copy, modify, and/or distribute this software for
|
||||
| any purpose with or without fee is hereby granted, provided that the
|
||||
| above copyright notice and this permission notice appear in all copies.
|
||||
|
|
||||
| THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
||||
| WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
||||
| WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
||||
| AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
|
||||
| DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
|
||||
| PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
|
||||
| TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
| PERFORMANCE OF THIS SOFTWARE.
|
||||
|#
|
||||
|
||||
(TEST '(A B C) (SUBST '(A B C) NIL))
|
||||
(TEST '(X B C) (SUBST '(A B C) '((A . X))))
|
||||
(TEST '(X B Z) (SUBST '(A B C) '((A . X) (C . Z))))
|
||||
(TEST '((X) B Z) (SUBST '((A) B C) '((A . X) (C . Z))))
|
||||
|
||||
(TEST '(ADD B C) (RIGHTEN '(ADD C B)))
|
||||
(TEST '(ADD C (ADD A B)) (RIGHTEN '(ADD C (ADD A B))))
|
||||
(TEST '(ADD C (* A B)) (RIGHTEN '(ADD (* A B) C)))
|
||||
(TEST '(ADD C (ADD A B)) (RIGHTEN '(ADD (ADD A B) C)))
|
||||
(TEST '(ADD A (ADD B (ADD C D))) (RIGHTEN '(ADD (ADD (ADD D C) B) A)))
|
||||
|
||||
(TEST 'DOG (SIMPTREE 'DOG '((* ((* A 0) 0)))))
|
||||
(TEST '(NOT X) (SIMPTREE '(NOT X) '((* ((* A 0) 0)))))
|
||||
(TEST '0 (SIMPTREE '(* Z 0) '((* ((* A 0) 0)))))
|
||||
(TEST '0 (SIMPTREE '(* (* Z 0) (* Z 0))
|
||||
'((* ((* A 0) 0)
|
||||
((* A 0) 0)))))
|
||||
|
||||
(TEST '(A) (PERMCOMM 'A))
|
||||
(TEST '((SUB A B)) (PERMCOMM '(SUB A B)))
|
||||
(TEST '((ADD B A) (ADD A B)) (PERMCOMM '(ADD A B)))
|
||||
(TEST '((ADD C (* A B)) (ADD (* A B) C) (ADD C (* B A)) (ADD (* B A) C)) (PERMCOMM '(ADD (* A B) C)))
|
||||
|
||||
(TEST '0 (SIMPLIFY '(AND P (NOT P))))
|
||||
(TEST '0 (SIMPLIFY '(NOT (OR P (NOT P)))))
|
||||
(TEST 'A (SIMPLIFY '(* (SQRT A) (SQRT A))))
|
||||
(TEST 'A (SIMPLIFY '(SQRT (POW 4 (LOGN A 2)))))
|
||||
(TEST '(* (ABS A) (POW 2 (DIV 1 2))) (SIMPLIFY '(HYPOT A A)))
|
||||
(TEST '1 (SIMPLIFY '(POW (SQR A) 0)))
|
||||
(TEST '(POW A (* B C)) (SIMPLIFY '(POW (POW A B) C)))
|
||||
(TEST '(POW A (ADD B C)) (SIMPLIFY '(* (POW A B) (POW A C))))
|
||||
(TEST 'B (SIMPLIFY '(LOGN (POW A B) A)))
|
||||
(TEST '(DIV (LOG (DIV A B)) (LOG C)) (SIMPLIFY '(SUB (LOGN A C) (LOGN B C))))
|
||||
;; (TEST '(DIV (* P (LOG X)) (LOG A)) (SIMPLIFY '(LOGN (POW X P) A))) ;; LITTLE WEIRD
|
||||
(TEST '(* B C) (SIMPLIFY '(LOGN (POW (POW A B) C) A)))
|
||||
(TEST 'A (SIMPLIFY '(DIV A 1)))
|
||||
(TEST '0 (SIMPLIFY '(DIV 0 A)))
|
||||
(TEST ':DBZERO (SIMPLIFY '(DIV A 0)))
|
||||
(TEST ':DBZERO (SIMPLIFY '(LOGN A 1)))
|
||||
(TEST '(DIV A B) (SIMPLIFY '(DIV (SUB 0 A) (SUB 0 B))))
|
||||
(TEST '1 (SIMPLIFY '(DIV A A)))
|
||||
(TEST '(DIV B C) (SIMPLIFY '(DIV (* A B) (* A C))))
|
||||
(TEST '(DIV A C) (SIMPLIFY '(* (DIV A B) (DIV B C))))
|
||||
(TEST '(DIV C B) (SIMPLIFY '(* (DIV A B) (DIV C A))))
|
||||
(TEST 'B (SIMPLIFY '(* (DIV B A) A)))
|
||||
(TEST '(DIV (ADD A C) B) (SIMPLIFY '(ADD (DIV A B) (DIV C B))))
|
||||
(TEST '(DIV (SUB A C) B) (SIMPLIFY '(SUB (DIV A B) (DIV C B))))
|
||||
;; (TEST '(DIV (* A D) (* B C)) (SIMPLIFY '(DIV (DIV A B) (DIV C D))))
|
||||
(TEST '(DIV 1 A) (SIMPLIFY '(* (POW A (SUB B 1)) (POW A (SUB 0 B)))))
|
||||
(TEST '(* C (POW A 2)) (SIMPLIFY '(* (ABS A) (* (ABS A) C))))
|
||||
(TEST '(OR B (NOT A)) (SIMPLIFY '(SUB (ADD (SUB 0 A) (AND A B)) 1)))
|
||||
(TEST '(NOT (XOR A B)) (SIMPLIFY '(SUB (ADD (SUB (SUB 0 A) B) (* 2 (AND A B))) 1)))
|
||||
(TEST '(ADD Z (SUB X Y)) (SIMPLIFY '(ADD (OR (SUB (AND X (NOT Y)) (AND (NOT X) Y)) Z) (AND (SUB (AND X (NOT Y)) (AND (NOT X) Y)) Z))))
|
||||
(TEST '(* (ADD A B) (SUB A B)) (SIMPLIFY '(SUB (SQR A) (SQR B))))
|
||||
(TEST '(* (ADD A B) (SUB A B)) (SIMPLIFY '(SUB (SUB (* A (ADD B A)) (* A B)) (POW B 2))))
|
||||
(TEST '(ADD X Y) (SIMPLIFY '(ADD (XOR X Y) (* (AND X Y) 2))))
|
||||
|
||||
(TEST (DERIV '(* X 1) 'X) '(ADD (* X 0) (* 1 1)))
|
||||
(TEST (DERIV '(* X Y) 'X) '(ADD (* X 0) (* 1 Y)))
|
||||
(TEST (DERIV '(* (* X Y) (ADD X 3)) 'X) '(ADD (* (* X Y) (ADD 1 0)) (* (ADD (* X 0) (* 1 Y)) (ADD X 3))))
|
||||
(TEST '(ADD (* (POW X 2) (* (LOG X) 0)) (* 2 (* (POW X (SUB 2 1)) 1))) (DERIV '(POW X 2) 'X))
|
||||
|
||||
(TEST '0 (DERIVATIVE '(* X 0) 'X))
|
||||
(TEST '1 (DERIVATIVE '(* X 1) 'X))
|
||||
(TEST 'Y (DERIVATIVE '(* X Y) 'X))
|
||||
(TEST '(* 2 X) (DERIVATIVE '(* X X) 'X))
|
||||
(TEST '(* 4 (POW X 3)) (DERIVATIVE '(* (* (* X X) X) X) 'X))
|
||||
(TEST '(* Y (ADD 3 (* 2 X))) (DERIVATIVE '(* (* X Y) (ADD X 3)) 'X))
|
||||
(TEST '(* 3 (POW X 2)) (DERIVATIVE '(POW X 3) 'X))
|
||||
(TEST '(* 4 (POW X 3)) (DERIVATIVE '(POW (* X X) 2) 'X))
|
||||
(TEST '(* Y (* 3 (POW X 2))) (DERIVATIVE '(* (* (* X Y) X) X) 'X))
|
||||
(TEST '(DIV 1 X) (DERIVATIVE '(LOG X) 'X))
|
||||
(TEST '(DIV Y X) (DERIVATIVE '(LOG (POW X Y)) 'X))
|
||||
(TEST '(COS X) (DERIVATIVE '(SIN X) 'X))
|
||||
(TEST '(* Y (COS (* X Y))) (DERIVATIVE '(SIN (* X Y)) 'X))
|
||||
(TEST '(SUB 0 (SIN X)) (DERIVATIVE '(COS X) 'X))
|
||||
(TEST '(SUB 0 (* Y (SIN (* X Y)))) (DERIVATIVE '(COS (* X Y)) 'X))
|
||||
(TEST '(DIV 1 (* 2 (POW X (DIV 1 2)))) (DERIVATIVE '(SQRT X) 'X))
|
||||
(TEST '(* Y (DIV X (ABS X))) (DERIVATIVE '(* Y (ABS X)) 'X))
|
||||
(TEST '1 (DERIVATIVE '(SUB X Y) 'X))
|
||||
(TEST '(SUB 0 1) (DERIVATIVE '(SUB X Y) 'Y))
|
||||
(TEST '(* Y (POW X (SUB Y 1))) (DERIVATIVE '(POW X Y) 'X))
|
||||
222
test/tool/plinko/library_test.lisp
Normal file
222
test/tool/plinko/library_test.lisp
Normal file
|
|
@ -0,0 +1,222 @@
|
|||
#| plinko - a really fast lisp tarpit
|
||||
| Copyright 2022 Justine Alexandra Roberts Tunney
|
||||
|
|
||||
| Permission to use, copy, modify, and/or distribute this software for
|
||||
| any purpose with or without fee is hereby granted, provided that the
|
||||
| above copyright notice and this permission notice appear in all copies.
|
||||
|
|
||||
| THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
||||
| WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
||||
| WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
||||
| AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
|
||||
| DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
|
||||
| PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
|
||||
| TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
||||
| PERFORMANCE OF THIS SOFTWARE.
|
||||
|#
|
||||
|
||||
(test nil (cmp 'a 'a))
|
||||
(test '(nil) (cmp 'a 'b))
|
||||
(test t (cmp 'b 'a))
|
||||
(test '(nil) (cmp 'a 'aa))
|
||||
(test t (cmp 'aa 'a))
|
||||
(test '(nil) (cmp 'a '(a)))
|
||||
(test t (cmp '(a) 'a))
|
||||
(test nil (cmp '(a) '(a)))
|
||||
(test '(nil) (cmp '(a) '(a b)))
|
||||
(test nil (cmp '(a a) '(a a)))
|
||||
(test '(nil) (cmp '(a a) '(a aa)))
|
||||
(test '(nil) (cmp '(a a) '((a) a)))
|
||||
(test '(nil) (cmp '(a a) '(a a b)))
|
||||
(test 'hello ((macro (x) (cons (quote quote) (cons x))) hello))
|
||||
(test 'hello ((closure (macro (x) (cons (quote quote) (cons x)))) hello))
|
||||
(test '(quoth hello) ((macro (x) (cons (quote quote) (cons (cons (quote quoth) (cons x))))) hello))
|
||||
(test (quote (macro (x) (cons (quote quote) (cons x)))) (car (cdr (macro (x) (cons (quote quote) (cons x))))))
|
||||
|
||||
(test 'b ((closure (lambda () a) (a . b))))
|
||||
(test 'b (eval 'a '((a . b))))
|
||||
|
||||
(test nil (reverse))
|
||||
(test '(c b a) (reverse '(a b c)))
|
||||
|
||||
(test '(a b c)
|
||||
(akeys '((a x)
|
||||
(b y)
|
||||
(c z))))
|
||||
|
||||
(test '(x y z)
|
||||
(avals '((a x)
|
||||
(b y)
|
||||
(c z))))
|
||||
|
||||
(test t (and))
|
||||
(test nil (and nil))
|
||||
(test t (and t))
|
||||
(test nil (and nil nil))
|
||||
(test nil (and t nil))
|
||||
(test nil (and nil t))
|
||||
(test t (and t t))
|
||||
(test 'a (and 'a))
|
||||
(test 'b (and 'a 'b))
|
||||
(test 'c (and 'a 'b 'c))
|
||||
|
||||
(test nil (or))
|
||||
(test nil (or nil))
|
||||
(test t (or t))
|
||||
(test nil (or nil nil))
|
||||
(test t (or t nil))
|
||||
(test t (or nil t))
|
||||
(test t (or t t))
|
||||
(test 'a (or 'a))
|
||||
(test 'a (or 'a 'b))
|
||||
(test 'a (or 'a 'b 'c))
|
||||
|
||||
(test t (not))
|
||||
(test t (not nil))
|
||||
(test nil (not t))
|
||||
(test '(eq x) (expand '(not x)))
|
||||
|
||||
(test '(abc . def)
|
||||
(let ((x 'abc)
|
||||
(y 'def))
|
||||
(cons x y)))
|
||||
|
||||
(test '((lambda (x y)
|
||||
(cons x y))
|
||||
'abc
|
||||
'def)
|
||||
(expand '(let ((x 'abc)
|
||||
(y 'def))
|
||||
(cons x y))))
|
||||
|
||||
(test '(abc def (abc . def))
|
||||
(let* ((x 'abc)
|
||||
(y 'def)
|
||||
(z (cons x y)))
|
||||
(cons x (cons y (cons z)))))
|
||||
|
||||
(test '((lambda (x)
|
||||
((lambda (y)
|
||||
((lambda (z)
|
||||
(list x y z))
|
||||
(cons x y)))
|
||||
'def))
|
||||
'abc)
|
||||
(expand '(let* ((x 'abc)
|
||||
(y 'def)
|
||||
(z (cons x y)))
|
||||
(list x y z))))
|
||||
|
||||
(test nil (last nil))
|
||||
(test 'a (last '(a)))
|
||||
(test 'b (last '(a b)))
|
||||
(test '(c) (last '(a b (c))))
|
||||
|
||||
(test nil (copy nil))
|
||||
(test t (copy t))
|
||||
(test '(a b) (copy '(a b)))
|
||||
(test '(a . b) (copy '(a . b)))
|
||||
|
||||
(test nil (assoc 'a ()))
|
||||
(test nil (assoc 'd '((a b) (c d))))
|
||||
(test '(a b) (assoc 'a '((a b) (c d))))
|
||||
(test '(c d) (assoc 'c '((a b) (c d))))
|
||||
(test '((foo bar) d) (assoc '(foo bar) '((a b) ((foo bar) d))))
|
||||
|
||||
(test '(a) (addset 'a))
|
||||
(test '(a) (addset 'a '(a)))
|
||||
(test '(b a) (addset 'b '(a)))
|
||||
(test '(a b) (addset 'b '(a b)))
|
||||
|
||||
(test '(a) (peel 'a))
|
||||
(test '(a) (peel 'a '(a)))
|
||||
(test '(b a) (peel 'b '(a)))
|
||||
(test '(b a b) (peel 'b '(a b)))
|
||||
|
||||
(test nil (reverse (reverse-mapcar cons nil)))
|
||||
(test '((a) (b) (c)) (reverse (reverse-mapcar cons '(a b c))))
|
||||
(test '(a b a) (reverse (reverse-mapcar car '((a . x) (b . y) (a . z)))))
|
||||
(test '(a b a c) (reverse (reverse-mapcar car '((a . x) (b . y) (a . z) (c . z)))))
|
||||
(test '((a . a) (b . b) (a . a)) (reverse (reverse-mapcar (lambda (x) (cons x x)) '(a b a))))
|
||||
|
||||
(test nil (mapcar cons nil))
|
||||
(test '((a) (b) (c)) (mapcar cons '(a b c)))
|
||||
(test '(a b a) (mapcar car '((a . x) (b . y) (a . z))))
|
||||
(test '(a b a c) (mapcar car '((a . x) (b . y) (a . z) (c . z))))
|
||||
(test '((a . a) (b . b) (a . a)) (mapcar (lambda (x) (cons x x)) '(a b a)))
|
||||
|
||||
(test nil (mapset cons nil))
|
||||
(test '((a) (b) (c)) (mapset cons '(a b c)))
|
||||
(test '(a b) (mapset car '((a . x) (b . y) (a . z))))
|
||||
(test '((a . a) (b . b)) (mapset (lambda (x) (cons x x)) '(a b a)))
|
||||
|
||||
(test 'a (reduce list '(a)))
|
||||
(test '(((a b) c) d) (reduce list '(a b c d)))
|
||||
|
||||
(test '(a b c d) (append '(a b) '(c d)))
|
||||
|
||||
(test t (all ()))
|
||||
(test nil (all '(a b nil d)))
|
||||
(test 'd (all '(a b c d)))
|
||||
|
||||
(test nil (any ()))
|
||||
(test 'a (any '(a b nil d)))
|
||||
(test 'b (any '(nil b c d)))
|
||||
(test nil (any '(nil nil)))
|
||||
|
||||
(test '((a . b) (c . d)) (pairwise '(a b c d)))
|
||||
(test '((a . a) (b . b) (c . c)) (dolist (x '(a b c)) (cons x x)))
|
||||
(test '((a . a) (b . b) (c . c)) (reverse (reverse-dolist (x '(a b c)) (cons x x))))
|
||||
(test '((a . a) (c . c)) (reverse (reverse-dolist (x '(a a c) peel) (cons x x))))
|
||||
|
||||
(test '((abs ((abs k) k))
|
||||
(log ((log 1) 0))
|
||||
(add ((add 1 2) 3)
|
||||
((add 1 3) 4)
|
||||
((add 1 4) 5))
|
||||
(sub ((sub 1 1) 0)
|
||||
((sub 2 1) 1)
|
||||
((sub 3 1) 2)))
|
||||
(GroupBy (lambda (x) (caar x))
|
||||
'(((abs k) k)
|
||||
((log 1) 0)
|
||||
((add 1 2) 3)
|
||||
((add 1 3) 4)
|
||||
((add 1 4) 5)
|
||||
((sub 1 1) 0)
|
||||
((sub 2 1) 1)
|
||||
((sub 3 1) 2))))
|
||||
|
||||
(progn
|
||||
(cond ((eq 'b (car (cdr '(a b c d))))) ((error '(cadr failed))))
|
||||
(cond ((eq 'c (car (cdr (cdr '(a b c d)))))) ((error '(caddr failed))))
|
||||
(cond ((eq 'c (car (cdr (car '(((a . b) . (c . d)))))))) ((error '(cadar failed))))
|
||||
(cond ((eq 'a (car (car '((a . b) . (c . d)))))) ((error '(caar failed))))
|
||||
(cond ((eq 'b (cdr (car '((a . b) . (c . d)))))) ((error '(cdar failed))))
|
||||
(cond ((eq 'c (car (cdr '((a . b) . (c . d)))))) ((error '(cadr failed))))
|
||||
(cond ((eq 'd (cdr (cdr '((a . b) . (c . d)))))) ((error '(cddr failed))))
|
||||
(cond ((eq 'a ((lambda ((x )) x) (cons 'a 'b)))) ((error '(lambda car failed))))
|
||||
(cond ((eq 'b ((lambda ((nil . x)) x) (cons 'a 'b)))) ((error '(lambda cdr failed))))
|
||||
(ignore))
|
||||
|
||||
(progn
|
||||
(cond ((eq (quote a)
|
||||
((lambda (f)
|
||||
(f f (quote ((a) b c))))
|
||||
(lambda (f a)
|
||||
(cond ((atom a) a)
|
||||
((f f (car a))))))))
|
||||
((error (quote (test failed))
|
||||
(quote (find first atom)))))
|
||||
(ignore))
|
||||
|
||||
(progn
|
||||
(cond ((equal (cons 'a 'b)
|
||||
(((lambda (f)
|
||||
(f (cons 'a 'b)))
|
||||
(lambda (x)
|
||||
(lambda ()
|
||||
x))))))
|
||||
((error '(enclosed memory failed to propogate upward))))
|
||||
(ignore))
|
||||
|
||||
118
test/tool/plinko/plinko_test.c
Normal file
118
test/tool/plinko/plinko_test.c
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
|
||||
│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8 :vi│
|
||||
╞══════════════════════════════════════════════════════════════════════════════╡
|
||||
│ Copyright 2022 Justine Alexandra Roberts Tunney │
|
||||
│ │
|
||||
│ Permission to use, copy, modify, and/or distribute this software for │
|
||||
│ any purpose with or without fee is hereby granted, provided that the │
|
||||
│ above copyright notice and this permission notice appear in all copies. │
|
||||
│ │
|
||||
│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL │
|
||||
│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED │
|
||||
│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE │
|
||||
│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL │
|
||||
│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR │
|
||||
│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER │
|
||||
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
|
||||
│ PERFORMANCE OF THIS SOFTWARE. │
|
||||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "libc/calls/calls.h"
|
||||
#include "libc/calls/sigbits.h"
|
||||
#include "libc/calls/struct/sigaction.h"
|
||||
#include "libc/errno.h"
|
||||
#include "libc/macros.internal.h"
|
||||
#include "libc/mem/io.h"
|
||||
#include "libc/mem/mem.h"
|
||||
#include "libc/runtime/runtime.h"
|
||||
#include "libc/sysv/consts/o.h"
|
||||
#include "libc/sysv/consts/sig.h"
|
||||
#include "libc/testlib/testlib.h"
|
||||
|
||||
STATIC_YOINK("zip_uri_support");
|
||||
STATIC_YOINK("plinko.com");
|
||||
STATIC_YOINK("library.lisp");
|
||||
STATIC_YOINK("library_test.lisp");
|
||||
STATIC_YOINK("binarytrees.lisp");
|
||||
STATIC_YOINK("algebra.lisp");
|
||||
STATIC_YOINK("algebra_test.lisp");
|
||||
STATIC_YOINK("infix.lisp");
|
||||
STATIC_YOINK("ok.lisp");
|
||||
|
||||
static const char *const kSauces[] = {
|
||||
"/zip/library.lisp", //
|
||||
"/zip/library_test.lisp", //
|
||||
"/zip/binarytrees.lisp", //
|
||||
"/zip/algebra.lisp", //
|
||||
"/zip/algebra_test.lisp", //
|
||||
"/zip/infix.lisp", //
|
||||
"/zip/ok.lisp", //
|
||||
};
|
||||
|
||||
char testlib_enable_tmp_setup_teardown_once;
|
||||
|
||||
void SetUpOnce(void) {
|
||||
int fdin, fdout;
|
||||
ASSERT_NE(-1, mkdir("bin", 0755));
|
||||
ASSERT_NE(-1, (fdin = open("/zip/plinko.com", O_RDONLY)));
|
||||
ASSERT_NE(-1, (fdout = creat("bin/plinko.com", 0755)));
|
||||
ASSERT_NE(-1, _copyfd(fdin, fdout, -1));
|
||||
EXPECT_EQ(0, close(fdout));
|
||||
EXPECT_EQ(0, close(fdin));
|
||||
}
|
||||
|
||||
TEST(plinko, worksOrPrintsNiceError) {
|
||||
ssize_t rc;
|
||||
char buf[16], drain[64];
|
||||
sigset_t chldmask, savemask;
|
||||
int i, pid, fdin, wstatus, pfds[2][2];
|
||||
struct sigaction ignore, saveint, savequit, savepipe;
|
||||
bzero(buf, sizeof(buf));
|
||||
ignore.sa_flags = 0;
|
||||
ignore.sa_handler = SIG_IGN;
|
||||
EXPECT_EQ(0, sigemptyset(&ignore.sa_mask));
|
||||
EXPECT_EQ(0, sigaction(SIGINT, &ignore, &saveint));
|
||||
EXPECT_EQ(0, sigaction(SIGQUIT, &ignore, &savequit));
|
||||
EXPECT_EQ(0, sigaction(SIGPIPE, &ignore, &savepipe));
|
||||
EXPECT_EQ(0, sigemptyset(&chldmask));
|
||||
EXPECT_EQ(0, sigaddset(&chldmask, SIGCHLD));
|
||||
EXPECT_EQ(0, sigprocmask(SIG_BLOCK, &chldmask, &savemask));
|
||||
ASSERT_NE(-1, pipe2(pfds[0], O_CLOEXEC));
|
||||
ASSERT_NE(-1, pipe2(pfds[1], O_CLOEXEC));
|
||||
ASSERT_NE(-1, (pid = vfork()));
|
||||
if (!pid) {
|
||||
close(0), dup(pfds[0][0]);
|
||||
close(1), dup(pfds[1][1]);
|
||||
close(2), dup(pfds[1][1]);
|
||||
sigaction(SIGINT, &saveint, 0);
|
||||
sigaction(SIGQUIT, &savequit, 0);
|
||||
sigaction(SIGQUIT, &savepipe, 0);
|
||||
sigprocmask(SIG_SETMASK, &savemask, 0);
|
||||
execve("bin/plinko.com", (char *const[]){"bin/plinko.com", 0},
|
||||
(char *const[]){0});
|
||||
_exit(127);
|
||||
}
|
||||
EXPECT_NE(-1, close(pfds[0][0]));
|
||||
EXPECT_NE(-1, close(pfds[1][1]));
|
||||
for (i = 0; i < ARRAYLEN(kSauces); ++i) {
|
||||
EXPECT_NE(-1, (fdin = open(kSauces[i], O_RDONLY)));
|
||||
rc = _copyfd(fdin, pfds[0][1], -1);
|
||||
if (rc == -1) EXPECT_EQ(EPIPE, errno);
|
||||
EXPECT_NE(-1, close(fdin));
|
||||
}
|
||||
EXPECT_NE(-1, close(pfds[0][1]));
|
||||
EXPECT_NE(-1, read(pfds[1][0], buf, sizeof(buf) - 1));
|
||||
while (read(pfds[1][0], drain, sizeof(drain)) > 0) donothing;
|
||||
EXPECT_NE(-1, close(pfds[1][0]));
|
||||
EXPECT_NE(-1, waitpid(pid, &wstatus, 0));
|
||||
EXPECT_TRUE(WIFEXITED(wstatus));
|
||||
if (!startswith(buf, "error: ")) {
|
||||
EXPECT_STREQ("OKCOMPUTER\n", buf);
|
||||
EXPECT_EQ(0, WEXITSTATUS(wstatus));
|
||||
} else {
|
||||
EXPECT_EQ(1, WEXITSTATUS(wstatus));
|
||||
}
|
||||
EXPECT_EQ(0, sigaction(SIGINT, &saveint, 0));
|
||||
EXPECT_EQ(0, sigaction(SIGQUIT, &savequit, 0));
|
||||
EXPECT_EQ(0, sigaction(SIGPIPE, &savepipe, 0));
|
||||
EXPECT_EQ(0, sigprocmask(SIG_SETMASK, &savemask, 0));
|
||||
}
|
||||
91
test/tool/plinko/test.mk
Normal file
91
test/tool/plinko/test.mk
Normal file
|
|
@ -0,0 +1,91 @@
|
|||
#-*-mode:makefile-gmake;indent-tabs-mode:t;tab-width:8;coding:utf-8-*-┐
|
||||
#───vi: set et ft=make ts=8 tw=8 fenc=utf-8 :vi───────────────────────┘
|
||||
|
||||
PKGS += TEST_TOOL_PLINKO
|
||||
|
||||
TEST_TOOL_PLINKO = $(TOOL_PLINKO_A_DEPS) $(TOOL_PLINKO_A)
|
||||
TEST_TOOL_PLINKO_A = o/$(MODE)/test/tool/plinko/plinkolib.a
|
||||
TEST_TOOL_PLINKO_FILES := $(wildcard test/tool/plinko/*)
|
||||
TEST_TOOL_PLINKO_SRCS = $(filter %.c,$(TEST_TOOL_PLINKO_FILES))
|
||||
TEST_TOOL_PLINKO_SRCS_TEST = $(filter %_test.c,$(TEST_TOOL_PLINKO_SRCS))
|
||||
TEST_TOOL_PLINKO_HDRS = $(filter %.h,$(TEST_TOOL_PLINKO_FILES))
|
||||
TEST_TOOL_PLINKO_COMS = $(TEST_TOOL_PLINKO_OBJS:%.o=%.com)
|
||||
|
||||
TEST_TOOL_PLINKO_OBJS = \
|
||||
$(TEST_TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.o) \
|
||||
o/$(MODE)/tool/plinko/plinko.com.zip.o \
|
||||
o/$(MODE)/tool/plinko/lib/library.lisp.zip.o \
|
||||
o/$(MODE)/tool/plinko/lib/binarytrees.lisp.zip.o \
|
||||
o/$(MODE)/tool/plinko/lib/algebra.lisp.zip.o \
|
||||
o/$(MODE)/tool/plinko/lib/infix.lisp.zip.o \
|
||||
o/$(MODE)/tool/plinko/lib/ok.lisp.zip.o \
|
||||
o/$(MODE)/test/tool/plinko/library_test.lisp.zip.o \
|
||||
o/$(MODE)/test/tool/plinko/algebra_test.lisp.zip.o
|
||||
|
||||
TEST_TOOL_PLINKO_COMS = \
|
||||
$(TEST_TOOL_PLINKO_SRCS:%.c=o/$(MODE)/%.com)
|
||||
|
||||
TEST_TOOL_PLINKO_BINS = \
|
||||
$(TEST_TOOL_PLINKO_COMS) \
|
||||
$(TEST_TOOL_PLINKO_COMS:%=%.dbg)
|
||||
|
||||
TEST_TOOL_PLINKO_TESTS = \
|
||||
$(TEST_TOOL_PLINKO_SRCS_TEST:%.c=o/$(MODE)/%.com.ok)
|
||||
|
||||
TEST_TOOL_PLINKO_CHECKS = \
|
||||
$(TEST_TOOL_PLINKO_HDRS:%=o/$(MODE)/%.ok) \
|
||||
$(TEST_TOOL_PLINKO_SRCS_TEST:%.c=o/$(MODE)/%.com.runs)
|
||||
|
||||
TEST_TOOL_PLINKO_DIRECTDEPS = \
|
||||
LIBC_CALLS \
|
||||
LIBC_FMT \
|
||||
LIBC_INTRIN \
|
||||
LIBC_LOG \
|
||||
LIBC_MEM \
|
||||
LIBC_NEXGEN32E \
|
||||
LIBC_RUNTIME \
|
||||
LIBC_STDIO \
|
||||
LIBC_STR \
|
||||
LIBC_STUBS \
|
||||
LIBC_SYSV \
|
||||
LIBC_TESTLIB \
|
||||
LIBC_UNICODE \
|
||||
LIBC_X \
|
||||
LIBC_ZIPOS \
|
||||
THIRD_PARTY_COMPILER_RT \
|
||||
THIRD_PARTY_XED
|
||||
|
||||
TEST_TOOL_PLINKO_DEPS := \
|
||||
$(call uniq,$(foreach x,$(TEST_TOOL_PLINKO_DIRECTDEPS),$($(x))))
|
||||
|
||||
$(TEST_TOOL_PLINKO_A): \
|
||||
test/tool/plinko/ \
|
||||
$(TEST_TOOL_PLINKO_A).pkg \
|
||||
$(TEST_TOOL_PLINKO_OBJS)
|
||||
|
||||
$(TEST_TOOL_PLINKO_A).pkg: \
|
||||
$(TEST_TOOL_PLINKO_OBJS) \
|
||||
$(foreach x,$(TEST_TOOL_PLINKO_DIRECTDEPS),$($(x)_A).pkg)
|
||||
|
||||
o/$(MODE)/test/tool/plinko/%.com.dbg: \
|
||||
$(TEST_TOOL_PLINKO_DEPS) \
|
||||
$(TEST_TOOL_PLINKO_A) \
|
||||
o/$(MODE)/test/tool/plinko/%.o \
|
||||
$(TEST_TOOL_PLINKO_A).pkg \
|
||||
$(LIBC_TESTMAIN) \
|
||||
$(CRT) \
|
||||
$(APE)
|
||||
@$(APELINK)
|
||||
|
||||
o/$(MODE)/test/tool/plinko/plinko_test.com.runs: \
|
||||
QUOTA = -M100g
|
||||
|
||||
o/$(MODE)/test/tool/plinko/algebra_test.lisp.zip.o \
|
||||
o/$(MODE)/test/tool/plinko/library_test.lisp.zip.o: \
|
||||
ZIPOBJ_FLAGS += \
|
||||
-B
|
||||
|
||||
.PHONY: o/$(MODE)/test/tool/plinko
|
||||
o/$(MODE)/test/tool/plinko: \
|
||||
$(TEST_TOOL_PLINKO_BINS) \
|
||||
$(TEST_TOOL_PLINKO_CHECKS)
|
||||
|
|
@ -4,5 +4,6 @@
|
|||
.PHONY: o/$(MODE)/test/tool
|
||||
o/$(MODE)/test/tool: \
|
||||
o/$(MODE)/test/tool/build \
|
||||
o/$(MODE)/test/tool/plinko \
|
||||
o/$(MODE)/test/tool/net \
|
||||
o/$(MODE)/test/tool/viz
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue