russell@unturf.com
6b832d5154
Portal saves the full machine state — env chain, compiled procedures, continuations, frame stack — to a JSON file. Another interpreter instance loads it and resumes execution from the exact instruction. Demo: start a primality test on machine A, checkpoint mid-computation, resume on machine B. 1000000007 prime check: machine B picks up from i=30000 and finishes in 6% of the original time. Implementation: - PortalSerializer: graph-aware with identity tracking for shared env references. Handles cycles (closures referencing their own env). - portal-checkpoint!: triggers mid-execution save from within VM loop. Hooks into TAIL_CALL (loop back-edge) for compiled code. - --portal-resume CLI flag: load .portal file and resume continuation. - portal-save / portal-resume Scheme builtins. 571 tests green (7 new portal tests: unit + integration + functional).
3210 lines
111 KiB
Python
3210 lines
111 KiB
Python
#!/usr/bin/env python3
|
|
"""
|
|
tests.py — unit, integration, and functional tests for uncommonlisp.
|
|
|
|
Run: python3 tests.py [-v]
|
|
"""
|
|
import sys, io, unittest, math, textwrap
|
|
sys.setrecursionlimit(200) # intentionally low — proves TCO works
|
|
|
|
# ── import the interpreter ────────────────────────────────────────────────────
|
|
from uncommonlisp import (
|
|
Symbol, S, NIL, Pair, Proc, Macro, VOID, EOF, LispErr,
|
|
show, _tokenize, _tokenize_lines, read_all, _L, _P, _truthy, _formals, _equal,
|
|
Env, _qq, leval, _call, make_global_env, PRELUDE,
|
|
CompiledProc, CodeObj, FullCont, _deep_copy_env,
|
|
_serialize_operand, _deserialize_operand, _serialize_code, _deserialize_code,
|
|
save_compiled, load_compiled, bc_compile_proc, MutableString,
|
|
portal_save, portal_resume, _cont_resume, _ContInvoked,
|
|
OP_CONST, OP_RETURN,
|
|
)
|
|
from fractions import Fraction
|
|
|
|
# ── helpers ───────────────────────────────────────────────────────────────────
|
|
|
|
def fresh():
|
|
"""Return a new global env with prelude loaded."""
|
|
g = make_global_env()
|
|
for e in read_all(PRELUDE):
|
|
leval(e, g)
|
|
return g
|
|
|
|
def run(src, env=None):
|
|
"""Eval all exprs in src; return value of last one."""
|
|
if env is None:
|
|
env = fresh()
|
|
result = VOID
|
|
for e in read_all(src):
|
|
result = leval(e, env)
|
|
return result
|
|
|
|
def runs(src, env=None):
|
|
"""Like run() but return show(result)."""
|
|
return show(run(src, env))
|
|
|
|
def err(src, env=None):
|
|
"""Assert src raises LispErr; return the message."""
|
|
with unittest.TestCase().assertRaises(LispErr) as ctx:
|
|
run(src, env)
|
|
return str(ctx.exception)
|
|
|
|
|
|
###############################################################################
|
|
# Unit tests — individual components
|
|
###############################################################################
|
|
|
|
class TestSymbol(unittest.TestCase):
|
|
def test_interning(self):
|
|
assert S('foo') is S('foo')
|
|
assert S('foo') is not S('bar')
|
|
|
|
def test_is_str(self):
|
|
assert isinstance(S('x'), str)
|
|
|
|
def test_repr(self):
|
|
assert repr(S('hello')) == 'hello'
|
|
|
|
|
|
class TestNil(unittest.TestCase):
|
|
def test_singleton(self):
|
|
from uncommonlisp import _Nil
|
|
assert _Nil() is NIL
|
|
|
|
def test_falsy(self):
|
|
assert not NIL
|
|
|
|
def test_empty_iter(self):
|
|
assert list(NIL) == []
|
|
|
|
def test_len_zero(self):
|
|
assert len(NIL) == 0
|
|
|
|
def test_repr(self):
|
|
assert repr(NIL) == '()'
|
|
|
|
|
|
class TestPair(unittest.TestCase):
|
|
def test_basic(self):
|
|
p = Pair(1, Pair(2, NIL))
|
|
assert p.car == 1
|
|
assert p.cdr.car == 2
|
|
|
|
def test_iter_proper(self):
|
|
p = _P([1, 2, 3])
|
|
assert list(p) == [1, 2, 3]
|
|
|
|
def test_iter_improper_raises(self):
|
|
p = Pair(1, 2) # dotted pair
|
|
with self.assertRaises(TypeError):
|
|
list(p)
|
|
|
|
def test_len(self):
|
|
assert len(_P([1, 2, 3])) == 3
|
|
|
|
def test_repr_proper(self):
|
|
assert repr(_P([1, 2])) == '(1 2)'
|
|
|
|
def test_repr_dotted(self):
|
|
assert repr(Pair(1, 2)) == '(1 . 2)'
|
|
|
|
def test_repr_nested(self):
|
|
assert repr(_P([_P([1, 2]), 3])) == '((1 2) 3)'
|
|
|
|
|
|
class TestShow(unittest.TestCase):
|
|
def test_nil(self): assert show(NIL) == '()'
|
|
def test_void(self): assert show(VOID) == ''
|
|
def test_true(self): assert show(True) == '#t'
|
|
def test_false(self): assert show(False) == '#f'
|
|
def test_int(self): assert show(42) == '42'
|
|
def test_float(self): assert show(3.14) == '3.14'
|
|
def test_inf(self): assert show(math.inf) == '+inf.0'
|
|
def test_neg_inf(self): assert show(-math.inf) == '-inf.0'
|
|
def test_nan(self): assert show(float('nan')) == '+nan.0'
|
|
def test_symbol(self): assert show(S('foo')) == 'foo'
|
|
def test_string_write(self):assert show('hi') == '"hi"'
|
|
def test_string_display(self): assert show('hi', display=True) == 'hi'
|
|
def test_string_escapes(self): assert show('a\nb') == '"a\\nb"'
|
|
def test_vector(self): assert show([1, 2]) == '#(1 2)'
|
|
def test_list(self): assert show(_P([1, 2])) == '(1 2)'
|
|
|
|
|
|
class TestTokenizer(unittest.TestCase):
|
|
def test_atoms(self):
|
|
assert _tokenize('foo bar') == ['foo', 'bar']
|
|
|
|
def test_parens(self):
|
|
assert _tokenize('(a b)') == ['(', 'a', 'b', ')']
|
|
|
|
def test_string(self):
|
|
assert _tokenize('"hello world"') == ['"hello world"']
|
|
|
|
def test_bool(self):
|
|
assert _tokenize('#t #f') == ['#t', '#f']
|
|
|
|
def test_comments_stripped(self):
|
|
assert _tokenize('a ; comment\nb') == ['a', 'b']
|
|
|
|
def test_quote_shorthands(self):
|
|
assert _tokenize("'x") == ["'", 'x']
|
|
assert _tokenize('`x') == ['`', 'x']
|
|
assert _tokenize(',x') == [',', 'x']
|
|
assert _tokenize(',@x') == [',@', 'x']
|
|
|
|
def test_char(self):
|
|
toks = _tokenize(r'#\a #\space #\newline')
|
|
assert toks == [r'#\a', r'#\space', r'#\newline']
|
|
|
|
def test_numbers(self):
|
|
assert _tokenize('1 2.5 -3') == ['1', '2.5', '-3']
|
|
|
|
|
|
class TestParser(unittest.TestCase):
|
|
def _r(self, src):
|
|
exprs = read_all(src)
|
|
assert len(exprs) == 1
|
|
return exprs[0]
|
|
|
|
def test_integer(self):
|
|
assert self._r('42') == 42
|
|
|
|
def test_float(self):
|
|
assert abs(self._r('3.14') - 3.14) < 1e-9
|
|
|
|
def test_symbol(self):
|
|
assert self._r('foo') is S('foo')
|
|
|
|
def test_bool_true(self):
|
|
assert self._r('#t') is True
|
|
|
|
def test_bool_false(self):
|
|
assert self._r('#f') is False
|
|
|
|
def test_string(self):
|
|
assert self._r('"hello"') == 'hello'
|
|
|
|
def test_string_escapes(self):
|
|
assert self._r(r'"a\nb"') == 'a\nb'
|
|
|
|
def test_nil(self):
|
|
assert self._r('()') is NIL
|
|
|
|
def test_list(self):
|
|
x = self._r('(1 2 3)')
|
|
assert list(x) == [1, 2, 3]
|
|
|
|
def test_nested(self):
|
|
x = self._r('(1 (2 3))')
|
|
assert x.car == 1
|
|
assert list(x.cdr.car) == [2, 3]
|
|
|
|
def test_dotted(self):
|
|
x = self._r('(1 . 2)')
|
|
assert x.car == 1
|
|
assert x.cdr == 2
|
|
|
|
def test_quote_shorthand(self):
|
|
x = self._r("'foo")
|
|
assert list(x) == [S('quote'), S('foo')]
|
|
|
|
def test_quasiquote_shorthand(self):
|
|
x = self._r('`foo')
|
|
assert x.car is S('quasiquote')
|
|
|
|
def test_unquote_shorthand(self):
|
|
x = self._r(',foo')
|
|
assert x.car is S('unquote')
|
|
|
|
def test_unquote_splicing(self):
|
|
x = self._r(',@foo')
|
|
assert x.car is S('unquote-splicing')
|
|
|
|
def test_char_space(self):
|
|
assert self._r(r'#\space') == ' '
|
|
|
|
def test_char_newline(self):
|
|
assert self._r(r'#\newline') == '\n'
|
|
|
|
def test_char_letter(self):
|
|
assert self._r(r'#\a') == 'a'
|
|
|
|
def test_inf(self):
|
|
assert self._r('+inf.0') == math.inf
|
|
|
|
def test_neg_inf(self):
|
|
assert self._r('-inf.0') == -math.inf
|
|
|
|
def test_multiple_exprs(self):
|
|
exprs = read_all('1 2 3')
|
|
assert exprs == [1, 2, 3]
|
|
|
|
def test_unclosed_paren_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
read_all('(1 2')
|
|
|
|
def test_unexpected_close_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
read_all(')')
|
|
|
|
def test_vector_literal(self):
|
|
v = self._r('#(1 2 3)')
|
|
assert isinstance(v, list)
|
|
assert v == [1, 2, 3]
|
|
|
|
|
|
class TestHelpers(unittest.TestCase):
|
|
def test_L_nil(self):
|
|
assert _L(NIL) == []
|
|
|
|
def test_L_list(self):
|
|
assert _L(_P([1, 2, 3])) == [1, 2, 3]
|
|
|
|
def test_L_non_list_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
_L(42)
|
|
|
|
def test_P_empty(self):
|
|
assert _P([]) is NIL
|
|
|
|
def test_P_single(self):
|
|
r = _P([1])
|
|
assert r.car == 1
|
|
assert r.cdr is NIL
|
|
|
|
def test_P_multiple(self):
|
|
r = _P([1, 2, 3])
|
|
assert list(r) == [1, 2, 3]
|
|
|
|
def test_truthy_false_is_false(self):
|
|
assert not _truthy(False)
|
|
|
|
def test_truthy_nil_is_true(self):
|
|
# Scheme: only #f is false
|
|
assert _truthy(NIL)
|
|
|
|
def test_truthy_zero_is_true(self):
|
|
assert _truthy(0)
|
|
|
|
def test_truthy_empty_string_is_true(self):
|
|
assert _truthy('')
|
|
|
|
def test_formals_symbol(self):
|
|
ps, rest = _formals(S('args'))
|
|
assert ps == [] and rest is S('args')
|
|
|
|
def test_formals_nil(self):
|
|
ps, rest = _formals(NIL)
|
|
assert ps == [] and rest is None
|
|
|
|
def test_formals_list(self):
|
|
ps, rest = _formals(_P([S('a'), S('b')]))
|
|
assert ps == [S('a'), S('b')] and rest is None
|
|
|
|
def test_formals_dotted(self):
|
|
f = Pair(S('a'), S('rest'))
|
|
ps, rest = _formals(f)
|
|
assert ps == [S('a')] and rest is S('rest')
|
|
|
|
def test_equal_atoms(self):
|
|
assert _equal(1, 1)
|
|
assert not _equal(1, 2)
|
|
|
|
def test_equal_strings(self):
|
|
assert _equal('hi', 'hi')
|
|
|
|
def test_equal_lists(self):
|
|
assert _equal(_P([1, 2]), _P([1, 2]))
|
|
assert not _equal(_P([1, 2]), _P([1, 3]))
|
|
|
|
def test_equal_vectors(self):
|
|
assert _equal([1, 2], [1, 2])
|
|
assert not _equal([1, 2], [1])
|
|
|
|
|
|
class TestEnv(unittest.TestCase):
|
|
def test_define_lookup(self):
|
|
e = Env()
|
|
e.define(S('x'), 42)
|
|
assert e.lookup(S('x')) == 42
|
|
|
|
def test_undefined_raises(self):
|
|
e = Env()
|
|
with self.assertRaises(LispErr):
|
|
e.lookup(S('x'))
|
|
|
|
def test_set(self):
|
|
e = Env()
|
|
e.define(S('x'), 1)
|
|
e.set(S('x'), 2)
|
|
assert e.lookup(S('x')) == 2
|
|
|
|
def test_set_undefined_raises(self):
|
|
e = Env()
|
|
with self.assertRaises(LispErr):
|
|
e.set(S('x'), 1)
|
|
|
|
def test_lexical_scope(self):
|
|
parent = Env()
|
|
parent.define(S('x'), 1)
|
|
child = Env(parent)
|
|
child.define(S('y'), 2)
|
|
assert child.lookup(S('x')) == 1
|
|
assert child.lookup(S('y')) == 2
|
|
|
|
def test_child_shadows_parent(self):
|
|
parent = Env()
|
|
parent.define(S('x'), 1)
|
|
child = Env(parent)
|
|
child.define(S('x'), 99)
|
|
assert child.lookup(S('x')) == 99
|
|
assert parent.lookup(S('x')) == 1
|
|
|
|
def test_child_extend(self):
|
|
e = Env()
|
|
c = e.child([S('a'), S('b')], None, [1, 2])
|
|
assert c.lookup(S('a')) == 1
|
|
assert c.lookup(S('b')) == 2
|
|
|
|
def test_child_rest(self):
|
|
e = Env()
|
|
c = e.child([S('a')], S('rest'), [1, 2, 3])
|
|
assert c.lookup(S('a')) == 1
|
|
assert list(c.lookup(S('rest'))) == [2, 3]
|
|
|
|
def test_child_arity_too_few(self):
|
|
e = Env()
|
|
with self.assertRaises(LispErr):
|
|
e.child([S('a'), S('b')], None, [1])
|
|
|
|
def test_child_arity_too_many(self):
|
|
e = Env()
|
|
with self.assertRaises(LispErr):
|
|
e.child([S('a')], None, [1, 2])
|
|
|
|
|
|
###############################################################################
|
|
# Integration tests — evaluator special forms
|
|
###############################################################################
|
|
|
|
class TestSelfEvaluating(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_integer(self): assert run('42', self.g) == 42
|
|
def test_float(self): assert abs(run('3.14', self.g) - 3.14) < 1e-9
|
|
def test_string(self): assert run('"hello"', self.g) == 'hello'
|
|
def test_bool_true(self): assert run('#t', self.g) is True
|
|
def test_bool_false(self): assert run('#f', self.g) is False
|
|
def test_nil(self): assert run('()', self.g) is NIL
|
|
def test_void(self): assert run('(void)', self.g) is VOID
|
|
|
|
|
|
class TestQuote(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_quote_symbol(self):
|
|
assert run("(quote foo)", self.g) is S('foo')
|
|
|
|
def test_quote_shorthand(self):
|
|
assert run("'foo", self.g) is S('foo')
|
|
|
|
def test_quote_list(self):
|
|
r = run("'(1 2 3)", self.g)
|
|
assert list(r) == [1, 2, 3]
|
|
|
|
def test_quote_nested(self):
|
|
r = run("'(a (b c))", self.g)
|
|
assert r.car is S('a')
|
|
|
|
|
|
class TestDefine(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_simple_value(self):
|
|
run('(define x 42)', self.g)
|
|
assert run('x', self.g) == 42
|
|
|
|
def test_function_shorthand(self):
|
|
run('(define (square x) (* x x))', self.g)
|
|
assert run('(square 5)', self.g) == 25
|
|
|
|
def test_sets_name(self):
|
|
run('(define (f x) x)', self.g)
|
|
p = self.g.lookup(S('f'))
|
|
assert isinstance(p, Proc)
|
|
assert p.name == 'f'
|
|
|
|
def test_define_returns_void(self):
|
|
assert run('(define x 1)', self.g) is VOID
|
|
|
|
def test_redefine(self):
|
|
run('(define x 1)', self.g)
|
|
run('(define x 2)', self.g)
|
|
assert run('x', self.g) == 2
|
|
|
|
|
|
class TestSetBang(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_set(self):
|
|
run('(define x 1)', self.g)
|
|
run('(set! x 99)', self.g)
|
|
assert run('x', self.g) == 99
|
|
|
|
def test_set_undefined_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
run('(set! zzz 1)', self.g)
|
|
|
|
|
|
class TestIf(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_true_branch(self): assert run('(if #t 1 2)', self.g) == 1
|
|
def test_false_branch(self): assert run('(if #f 1 2)', self.g) == 2
|
|
def test_no_else_false(self): assert run('(if #f 1)', self.g) is VOID
|
|
def test_zero_is_true(self): assert run('(if 0 1 2)', self.g) == 1 # Scheme: only #f is false
|
|
def test_nil_is_true(self): assert run("(if '() 1 2)", self.g) == 1
|
|
def test_false_only_false(self):assert run('(if #f 1 2)', self.g) == 2
|
|
|
|
|
|
class TestCond(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_first_match(self):
|
|
assert run('(cond (#t 1) (#t 2))', self.g) == 1
|
|
|
|
def test_second_match(self):
|
|
assert run('(cond (#f 1) (#t 2))', self.g) == 2
|
|
|
|
def test_else(self):
|
|
assert run('(cond (#f 1) (else 99))', self.g) == 99
|
|
|
|
def test_arrow(self):
|
|
assert run('(cond (1 => (lambda (x) (* x 10))))', self.g) == 10
|
|
|
|
def test_no_match(self):
|
|
assert run('(cond (#f 1))', self.g) is VOID
|
|
|
|
|
|
class TestAndOr(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_and_empty(self): assert run('(and)', self.g) is True
|
|
def test_and_true(self): assert run('(and 1 2 3)', self.g) == 3
|
|
def test_and_short_circuit(self):
|
|
run('(define x 0)', self.g)
|
|
run('(and #f (set! x 1))', self.g)
|
|
assert run('x', self.g) == 0
|
|
|
|
def test_or_empty(self): assert run('(or)', self.g) is False
|
|
def test_or_false(self): assert run('(or #f #f)', self.g) is False
|
|
def test_or_first_true(self): assert run('(or 42 99)', self.g) == 42
|
|
def test_or_short_circuit(self):
|
|
run('(define x 0)', self.g)
|
|
run('(or 1 (set! x 1))', self.g)
|
|
assert run('x', self.g) == 0
|
|
|
|
|
|
class TestLambda(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic(self):
|
|
run('(define f (lambda (x) (* x x)))', self.g)
|
|
assert run('(f 5)', self.g) == 25
|
|
|
|
def test_unicode(self):
|
|
run('(define f (λ (x) (* x x)))', self.g)
|
|
assert run('(f 3)', self.g) == 9
|
|
|
|
def test_closure(self):
|
|
run('(define (make-adder n) (lambda (x) (+ x n)))', self.g)
|
|
run('(define add5 (make-adder 5))', self.g)
|
|
assert run('(add5 3)', self.g) == 8
|
|
|
|
def test_variadic(self):
|
|
run('(define (sum . args) (fold-left + 0 args))', self.g)
|
|
assert run('(sum 1 2 3 4)', self.g) == 10
|
|
|
|
def test_dotted_params(self):
|
|
run('(define f (lambda (x . rest) (cons x rest)))', self.g)
|
|
r = run('(f 1 2 3)', self.g)
|
|
assert r.car == 1
|
|
assert list(r.cdr) == [2, 3]
|
|
|
|
def test_nullary(self):
|
|
run('(define (const) 42)', self.g)
|
|
assert run('(const)', self.g) == 42
|
|
|
|
def test_multi_body(self):
|
|
run('(define x 0)', self.g)
|
|
run('(define (f) (set! x 1) (set! x 2) x)', self.g)
|
|
assert run('(f)', self.g) == 2
|
|
assert run('x', self.g) == 2
|
|
|
|
|
|
class TestLet(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic(self):
|
|
assert run('(let ((x 1) (y 2)) (+ x y))', self.g) == 3
|
|
|
|
def test_body_scope(self):
|
|
run('(define x 99)', self.g)
|
|
assert run('(let ((x 1)) x)', self.g) == 1
|
|
assert run('x', self.g) == 99
|
|
|
|
def test_sequential_binds_not_visible(self):
|
|
# in let, bindings can't see each other
|
|
with self.assertRaises(LispErr):
|
|
run('(let ((x 1) (y x)) y)', self.g)
|
|
|
|
def test_let_star(self):
|
|
assert run('(let* ((x 1) (y (+ x 1))) y)', self.g) == 2
|
|
|
|
def test_letrec(self):
|
|
assert run('(letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1))))) (odd? (lambda (n) (if (= n 0) #f (even? (- n 1)))))) (even? 10))', self.g) is True
|
|
|
|
def test_named_let(self):
|
|
assert run('(let loop ((i 0) (acc 0)) (if (> i 5) acc (loop (+ i 1) (+ acc i))))', self.g) == 15
|
|
|
|
|
|
class TestBegin(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_returns_last(self):
|
|
assert run('(begin 1 2 3)', self.g) == 3
|
|
|
|
def test_side_effects(self):
|
|
run('(define x 0)', self.g)
|
|
run('(begin (set! x 1) (set! x 2))', self.g)
|
|
assert run('x', self.g) == 2
|
|
|
|
def test_empty(self):
|
|
assert run('(begin)', self.g) is VOID
|
|
|
|
|
|
class TestWhenUnless(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_when_true(self):
|
|
run('(define x 0)', self.g)
|
|
run('(when #t (set! x 1))', self.g)
|
|
assert run('x', self.g) == 1
|
|
|
|
def test_when_false(self):
|
|
run('(define x 0)', self.g)
|
|
run('(when #f (set! x 1))', self.g)
|
|
assert run('x', self.g) == 0
|
|
|
|
def test_unless_true(self):
|
|
run('(define x 0)', self.g)
|
|
run('(unless #t (set! x 1))', self.g)
|
|
assert run('x', self.g) == 0
|
|
|
|
def test_unless_false(self):
|
|
run('(define x 0)', self.g)
|
|
run('(unless #f (set! x 1))', self.g)
|
|
assert run('x', self.g) == 1
|
|
|
|
|
|
class TestDo(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_sum(self):
|
|
assert run('(do ((i 1 (+ i 1)) (s 0 (+ s i))) ((> i 10) s))', self.g) == 55
|
|
|
|
def test_no_result(self):
|
|
assert run('(do ((i 0 (+ i 1))) ((= i 3)))', self.g) is VOID
|
|
|
|
def test_vector_fill(self):
|
|
run('(define v (make-vector 3 0))', self.g)
|
|
run('(do ((i 0 (+ i 1))) ((= i 3)) (vector-set! v i (* i i)))', self.g)
|
|
assert run('(vector->list v)', self.g).__class__ is Pair
|
|
|
|
|
|
class TestQuasiquote(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic(self):
|
|
r = run('`(1 2 3)', self.g)
|
|
assert list(r) == [1, 2, 3]
|
|
|
|
def test_unquote(self):
|
|
run('(define x 42)', self.g)
|
|
r = run('`(a ,x b)', self.g)
|
|
assert list(r) == [S('a'), 42, S('b')]
|
|
|
|
def test_unquote_splicing(self):
|
|
run('(define xs (quote (1 2 3)))', self.g)
|
|
r = run('`(a ,@xs b)', self.g)
|
|
assert list(r) == [S('a'), 1, 2, 3, S('b')]
|
|
|
|
def test_nested(self):
|
|
r = run('`(a `(b ,(+ 1 2)))', self.g)
|
|
assert r.car is S('a')
|
|
|
|
def test_nested_unquote(self):
|
|
run('(define x 5)', self.g)
|
|
r = run('`(a ,x)', self.g)
|
|
assert list(r) == [S('a'), 5]
|
|
|
|
|
|
class TestApply(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic(self):
|
|
assert run("(apply + '(1 2 3))", self.g) == 6
|
|
|
|
def test_pre_args(self):
|
|
assert run("(apply + 1 2 '(3 4))", self.g) == 10
|
|
|
|
def test_lambda(self):
|
|
assert run("(apply (lambda (x y) (* x y)) '(3 4))", self.g) == 12
|
|
|
|
|
|
class TestCallCC(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_escape(self):
|
|
# escape from deep recursion
|
|
r = run('''
|
|
(call/cc (lambda (k)
|
|
(k 42)
|
|
99))
|
|
''', self.g)
|
|
assert r == 42
|
|
|
|
def test_no_escape(self):
|
|
r = run('(call/cc (lambda (k) (+ 1 2)))', self.g)
|
|
assert r == 3
|
|
|
|
def test_early_return(self):
|
|
r = run('''
|
|
(define (search lst pred)
|
|
(call/cc (lambda (return)
|
|
(for-each (lambda (x) (when (pred x) (return x))) lst)
|
|
#f)))
|
|
(search (quote (1 2 3 4 5)) even?)
|
|
''', self.g)
|
|
assert r == 2
|
|
|
|
|
|
class TestValues(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_single_value(self):
|
|
assert run('(values 42)', self.g) == 42
|
|
|
|
def test_call_with_values(self):
|
|
r = run('(call-with-values (lambda () (values 1 2 3)) +)', self.g)
|
|
assert r == 6
|
|
|
|
|
|
class TestError(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_error_raises(self):
|
|
with self.assertRaises(LispErr) as ctx:
|
|
run('(error "oops")', self.g)
|
|
assert 'oops' in str(ctx.exception)
|
|
|
|
def test_error_with_irritants(self):
|
|
with self.assertRaises(LispErr) as ctx:
|
|
run('(error "bad value" 42)', self.g)
|
|
msg = str(ctx.exception)
|
|
assert 'bad value' in msg and '42' in msg
|
|
|
|
def test_undefined_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
run('undefined-variable', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# Integration tests — built-in procedures
|
|
###############################################################################
|
|
|
|
class TestArithmetic(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_add(self): assert run('(+ 1 2 3)', self.g) == 6
|
|
def test_add_empty(self): assert run('(+)', self.g) == 0
|
|
def test_sub(self): assert run('(- 10 3 2)', self.g) == 5
|
|
def test_sub_negate(self): assert run('(- 5)', self.g) == -5
|
|
def test_mul(self): assert run('(* 2 3 4)', self.g) == 24
|
|
def test_mul_empty(self): assert run('(*)', self.g) == 1
|
|
def test_div(self): assert abs(run('(/ 10 2)', self.g) - 5.0) < 1e-9
|
|
def test_div_single(self): assert abs(run('(/ 4)', self.g) - 0.25) < 1e-9
|
|
def test_quotient(self): assert run('(quotient 10 3)', self.g) == 3
|
|
def test_remainder(self): assert run('(remainder 10 3)', self.g) == 1
|
|
def test_modulo(self): assert run('(modulo -7 3)', self.g) == 2
|
|
def test_expt(self): assert run('(expt 2 10)', self.g) == 1024
|
|
def test_abs_pos(self): assert run('(abs 5)', self.g) == 5
|
|
def test_abs_neg(self): assert run('(abs -5)', self.g) == 5
|
|
def test_floor(self): assert run('(floor 3.7)', self.g) == 3
|
|
def test_ceiling(self): assert run('(ceiling 3.2)', self.g) == 4
|
|
def test_round(self): assert run('(round 3.5)', self.g) == 4
|
|
def test_truncate(self): assert run('(truncate -3.7)', self.g) == -3
|
|
def test_min(self): assert run('(min 3 1 2)', self.g) == 1
|
|
def test_max(self): assert run('(max 3 1 2)', self.g) == 3
|
|
def test_gcd(self): assert run('(gcd 12 8)', self.g) == 4
|
|
def test_lcm(self): assert run('(lcm 4 6)', self.g) == 12
|
|
def test_sqrt(self): assert abs(run('(sqrt 9)', self.g) - 3.0) < 1e-9
|
|
def test_exact(self): assert run('(exact 3.0)', self.g) == 3
|
|
def test_inexact(self): assert isinstance(run('(inexact 3)', self.g), float)
|
|
def test_number_to_string(self): assert run('(number->string 255 16)', self.g) == 'ff'
|
|
def test_inf(self): assert run('(infinite? +inf.0)', self.g) is True
|
|
def test_nan(self): assert run('(nan? +nan.0)', self.g) is True
|
|
|
|
|
|
class TestNumericPredicates(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_eq(self): assert run('(= 1 1)', self.g) is True
|
|
def test_lt(self): assert run('(< 1 2 3)', self.g) is True
|
|
def test_gt(self): assert run('(> 3 2 1)', self.g) is True
|
|
def test_le(self): assert run('(<= 1 1 2)', self.g) is True
|
|
def test_ge(self): assert run('(>= 3 3 2)', self.g) is True
|
|
def test_zero(self): assert run('(zero? 0)', self.g) is True
|
|
def test_pos(self): assert run('(positive? 1)', self.g) is True
|
|
def test_neg(self): assert run('(negative? -1)', self.g) is True
|
|
def test_odd(self): assert run('(odd? 3)', self.g) is True
|
|
def test_even(self): assert run('(even? 4)', self.g) is True
|
|
|
|
|
|
class TestBoolean(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_not_false(self): assert run('(not #f)', self.g) is True
|
|
def test_not_true(self): assert run('(not #t)', self.g) is False
|
|
def test_not_zero(self): assert run('(not 0)', self.g) is False # 0 is truthy
|
|
def test_boolean_pred(self):assert run('(boolean? #t)', self.g) is True
|
|
def test_boolean_not_num(self):assert run('(boolean? 1)', self.g) is False
|
|
|
|
|
|
class TestPairsList(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_cons(self): assert runs('(cons 1 2)', self.g) == '(1 . 2)'
|
|
def test_cons_list(self): assert runs("(cons 1 '(2 3))", self.g) == '(1 2 3)'
|
|
def test_car(self): assert run("(car '(1 2))", self.g) == 1
|
|
def test_cdr(self): assert runs("(cdr '(1 2 3))", self.g) == '(2 3)'
|
|
def test_list(self): assert runs('(list 1 2 3)', self.g) == '(1 2 3)'
|
|
def test_list_star(self): assert runs("(list* 1 2 '(3 4))", self.g) == '(1 2 3 4)'
|
|
def test_null_nil(self): assert run("(null? '())", self.g) is True
|
|
def test_null_pair(self): assert run("(null? '(1))", self.g) is False
|
|
def test_pair_pair(self): assert run("(pair? '(1))", self.g) is True
|
|
def test_pair_nil(self): assert run("(pair? '())", self.g) is False
|
|
def test_length(self): assert run("(length '(1 2 3))", self.g) == 3
|
|
def test_append(self): assert runs("(append '(1 2) '(3 4))", self.g) == '(1 2 3 4)'
|
|
def test_append_empty(self):assert runs("(append '() '(1 2))", self.g) == '(1 2)'
|
|
def test_reverse(self): assert runs("(reverse '(1 2 3))", self.g) == '(3 2 1)'
|
|
def test_list_ref(self): assert run("(list-ref '(a b c) 1)", self.g) is S('b')
|
|
def test_list_tail(self): assert runs("(list-tail '(a b c) 1)", self.g) == '(b c)'
|
|
def test_iota(self): assert runs('(iota 5)', self.g) == '(0 1 2 3 4)'
|
|
def test_iota_start(self): assert runs('(iota 3 1)', self.g) == '(1 2 3)'
|
|
def test_iota_step(self): assert runs('(iota 3 0 2)', self.g) == '(0 2 4)'
|
|
def test_cadr(self): assert run("(cadr '(1 2 3))", self.g) == 2
|
|
def test_caddr(self): assert run("(caddr '(1 2 3))", self.g) == 3
|
|
def test_set_car(self):
|
|
run("(define p (list 1 2))", self.g)
|
|
run("(set-car! p 99)", self.g)
|
|
assert run("(car p)", self.g) == 99
|
|
def test_set_cdr(self):
|
|
run("(define p (list 1 2))", self.g)
|
|
run("(set-cdr! p '(99))", self.g)
|
|
assert run("(cadr p)", self.g) == 99
|
|
|
|
|
|
class TestMemberAssoc(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_memq_found(self):
|
|
r = run("(memq 'b '(a b c))", self.g)
|
|
assert list(r) == [S('b'), S('c')]
|
|
|
|
def test_memq_missing(self):
|
|
assert run("(memq 'z '(a b c))", self.g) is False
|
|
|
|
def test_member_equal(self):
|
|
r = run("(member '(2) '((1) (2) (3)))", self.g)
|
|
assert r.car.car == 2
|
|
|
|
def test_assq_found(self):
|
|
r = run("(assq 'b '((a 1) (b 2) (c 3)))", self.g)
|
|
assert list(r) == [S('b'), 2]
|
|
|
|
def test_assq_missing(self):
|
|
assert run("(assq 'z '((a 1)))", self.g) is False
|
|
|
|
def test_assoc_equal(self):
|
|
r = run("(assoc '(1) '(((1) found) ((2) no)))", self.g)
|
|
assert r.cdr.car is S('found')
|
|
|
|
|
|
class TestHigherOrder(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_map(self):
|
|
assert runs("(map (lambda (x) (* x x)) '(1 2 3 4))", self.g) == '(1 4 9 16)'
|
|
|
|
def test_map_multi(self):
|
|
assert runs("(map + '(1 2 3) '(4 5 6))", self.g) == '(5 7 9)'
|
|
|
|
def test_filter(self):
|
|
assert runs("(filter odd? '(1 2 3 4 5))", self.g) == '(1 3 5)'
|
|
|
|
def test_fold_left(self):
|
|
assert run("(fold-left + 0 '(1 2 3 4 5))", self.g) == 15
|
|
|
|
def test_fold_right(self):
|
|
assert runs("(fold-right cons '() '(1 2 3))", self.g) == '(1 2 3)'
|
|
|
|
def test_for_each_side_effects(self):
|
|
run('(define acc (quote ()))', self.g)
|
|
run("(for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3))", self.g)
|
|
assert runs('acc', self.g) == '(3 2 1)'
|
|
|
|
def test_any_found(self):
|
|
assert run("(any even? '(1 3 4 5))", self.g) == 4
|
|
|
|
def test_any_none(self):
|
|
assert run("(any even? '(1 3 5))", self.g) is False
|
|
|
|
def test_every_true(self):
|
|
assert run("(every odd? '(1 3 5))", self.g) is True
|
|
|
|
def test_every_false(self):
|
|
assert run("(every odd? '(1 2 3))", self.g) is False
|
|
|
|
def test_count(self):
|
|
assert run("(count even? '(1 2 3 4 5 6))", self.g) == 3
|
|
|
|
def test_flat_map(self):
|
|
assert runs("(flat-map (lambda (x) (list x (* x x))) '(1 2 3))", self.g) == '(1 1 2 4 3 9)'
|
|
|
|
def test_sort(self):
|
|
assert runs("(sort '(3 1 4 1 5 9 2 6))", self.g) == '(1 1 2 3 4 5 6 9)'
|
|
|
|
def test_sort_by(self):
|
|
assert runs("(sort-by car '((3 a) (1 b) (2 c)))", self.g) == '((1 b) (2 c) (3 a))'
|
|
|
|
def test_partition(self):
|
|
r = run("(partition even? '(1 2 3 4 5))", self.g)
|
|
evens, odds = list(r)
|
|
assert list(evens) == [2, 4]
|
|
assert list(odds) == [1, 3, 5]
|
|
|
|
def test_find(self):
|
|
assert run("(find even? '(1 3 4 5))", self.g) == 4
|
|
assert run("(find even? '(1 3 5))", self.g) is False
|
|
|
|
def test_take(self):
|
|
assert runs("(take '(1 2 3 4 5) 3)", self.g) == '(1 2 3)'
|
|
|
|
def test_drop(self):
|
|
assert runs("(drop '(1 2 3 4 5) 3)", self.g) == '(4 5)'
|
|
|
|
def test_zip(self):
|
|
assert runs("(zip '(1 2 3) '(a b c))", self.g) == '((1 a) (2 b) (3 c))'
|
|
|
|
|
|
class TestStrings(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_length(self): assert run('(string-length "hello")', self.g) == 5
|
|
def test_ref(self): assert run('(string-ref "hello" 1)', self.g) == 'e'
|
|
def test_substring(self): assert run('(substring "hello" 1 3)', self.g) == 'el'
|
|
def test_append(self): assert run('(string-append "foo" "bar")', self.g) == 'foobar'
|
|
def test_upcase(self): assert run('(string-upcase "hello")', self.g) == 'HELLO'
|
|
def test_downcase(self): assert run('(string-downcase "HELLO")', self.g) == 'hello'
|
|
def test_to_list(self): assert runs('(string->list "abc")', self.g) == '("a" "b" "c")'
|
|
def test_from_list(self): assert run("(list->string '(#\\h #\\i))", self.g) == 'hi'
|
|
def test_to_symbol(self): assert run('(string->symbol "foo")', self.g) is S('foo')
|
|
def test_from_symbol(self): assert run("(symbol->string 'foo)", self.g) == 'foo'
|
|
def test_contains(self): assert run('(string-contains "hello world" "world")', self.g) is True
|
|
def test_split(self): assert runs('(string-split "a,b,c" ",")', self.g) == '("a" "b" "c")'
|
|
def test_join(self): assert run('(string-join (list "a" "b" "c") "-")', self.g) == 'a-b-c'
|
|
def test_trim(self): assert run('(string-trim " hi ")', self.g) == 'hi'
|
|
def test_replace(self): assert run('(string-replace "hello" "l" "r")', self.g) == 'herro'
|
|
def test_number_to_string(self):assert run('(string->number "42")', self.g) == 42
|
|
def test_string_eq(self): assert run('(string=? "foo" "foo")', self.g) is True
|
|
def test_string_lt(self): assert run('(string<? "abc" "abd")', self.g) is True
|
|
def test_prefix(self): assert run('(string-prefix? "he" "hello")', self.g) is True
|
|
def test_format_a(self): assert run('(format "~a + ~a" 1 2)', self.g) == '1 + 2'
|
|
def test_format_s(self): assert run('(format "~s" "hi")', self.g) == '"hi"'
|
|
def test_format_percent(self): assert run('(format "a~%b")', self.g) == 'a\nb'
|
|
def test_format_hex(self): assert run('(format "~x" 255)', self.g) == 'ff'
|
|
|
|
|
|
class TestCharacters(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_char_pred(self): assert run(r'(char? #\a)', self.g) is True
|
|
def test_int_to_char(self): assert run('(integer->char 65)', self.g) == 'A'
|
|
def test_char_to_int(self): assert run(r'(char->integer #\A)', self.g) == 65
|
|
def test_alpha(self): assert run(r'(char-alphabetic? #\a)', self.g) is True
|
|
def test_numeric(self): assert run(r'(char-numeric? #\5)', self.g) is True
|
|
def test_upcase(self): assert run(r'(char-upcase #\a)', self.g) == 'A'
|
|
def test_downcase(self): assert run(r'(char-downcase #\A)', self.g) == 'a'
|
|
def test_eq(self): assert run(r'(char=? #\a #\a)', self.g) is True
|
|
|
|
|
|
class TestVectors(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_make(self):
|
|
run('(define v (make-vector 3 0))', self.g)
|
|
assert run('(vector-length v)', self.g) == 3
|
|
|
|
def test_ref_set(self):
|
|
run('(define v (vector 10 20 30))', self.g)
|
|
assert run('(vector-ref v 1)', self.g) == 20
|
|
run('(vector-set! v 1 99)', self.g)
|
|
assert run('(vector-ref v 1)', self.g) == 99
|
|
|
|
def test_vector_pred(self):
|
|
assert run('(vector? (vector 1 2))', self.g) is True
|
|
assert run("(vector? '(1 2))", self.g) is False
|
|
|
|
def test_list_roundtrip(self):
|
|
assert runs('(vector->list (list->vector (quote (1 2 3))))', self.g) == '(1 2 3)'
|
|
|
|
|
|
class TestHashTables(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_set_ref(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
run("(hash-table-set! h 'key 42)", self.g)
|
|
assert run("(hash-table-ref h 'key)", self.g) == 42
|
|
|
|
def test_ref_missing_default(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
assert run("(hash-table-ref/default h 'x 0)", self.g) == 0
|
|
|
|
def test_exists(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
run("(hash-table-set! h 'a 1)", self.g)
|
|
assert run("(hash-table-exists? h 'a)", self.g) is True
|
|
assert run("(hash-table-exists? h 'z)", self.g) is False
|
|
|
|
def test_delete(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
run("(hash-table-set! h 'a 1)", self.g)
|
|
run("(hash-table-delete! h 'a)", self.g)
|
|
assert run("(hash-table-exists? h 'a)", self.g) is False
|
|
|
|
def test_size(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
run("(hash-table-set! h 'a 1)", self.g)
|
|
run("(hash-table-set! h 'b 2)", self.g)
|
|
assert run('(hash-table-size h)', self.g) == 2
|
|
|
|
def test_keys_values(self):
|
|
run('(define h (make-hash-table))', self.g)
|
|
run("(hash-table-set! h 'a 1)", self.g)
|
|
run("(hash-table-set! h 'b 2)", self.g)
|
|
keys = sorted(list(run('(hash-table-keys h)', self.g)))
|
|
assert keys == [S('a'), S('b')]
|
|
|
|
|
|
class TestEquality(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_eq_symbols(self): assert run("(eq? 'a 'a)", self.g) is True
|
|
def test_eq_sym_diff(self): assert run("(eq? 'a 'b)", self.g) is False
|
|
def test_eq_ints(self): assert run('(eq? 1 1)', self.g) is True
|
|
def test_eqv(self): assert run('(eqv? 3.14 3.14)', self.g) is True
|
|
def test_equal_lists(self): assert run("(equal? '(1 2 3) '(1 2 3))", self.g) is True
|
|
def test_equal_diff(self): assert run("(equal? '(1 2) '(1 3))", self.g) is False
|
|
def test_equal_nested(self):assert run("(equal? '(1 (2 3)) '(1 (2 3)))", self.g) is True
|
|
def test_equal_vectors(self):assert run('(equal? (vector 1 2) (vector 1 2))', self.g) is True
|
|
|
|
|
|
class TestMacros(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_define_macro(self):
|
|
run('(define-macro (my-if test then else) `(cond (,test ,then) (else ,else)))', self.g)
|
|
assert run('(my-if #t 1 2)', self.g) == 1
|
|
assert run('(my-if #f 1 2)', self.g) == 2
|
|
|
|
def test_macro_with_rest(self):
|
|
run('(define-macro (my-begin . body) `(begin ,@body))', self.g)
|
|
assert run('(my-begin 1 2 3)', self.g) == 3
|
|
|
|
def test_macro_generates_define(self):
|
|
run('(define-macro (def-const name val) `(define ,name ,val))', self.g)
|
|
run('(def-const pi 3.14)', self.g)
|
|
assert run('pi', self.g) == 3.14
|
|
|
|
def test_define_macro_shorthand(self):
|
|
run('(define-macro (swap! a b) (let ((t (gensym))) `(let ((,t ,a)) (set! ,a ,b) (set! ,b ,t))))', self.g)
|
|
run('(define x 1)', self.g)
|
|
run('(define y 2)', self.g)
|
|
run('(swap! x y)', self.g)
|
|
assert run('x', self.g) == 2
|
|
assert run('y', self.g) == 1
|
|
|
|
def test_case_macro(self):
|
|
assert run("(case 2 ((1) 'one) ((2) 'two) (else 'other))", self.g) is S('two')
|
|
assert run("(case 99 ((1) 'one) (else 'other))", self.g) is S('other')
|
|
|
|
def test_while_macro(self):
|
|
run('(define i 0) (define s 0)', self.g)
|
|
run('(while (< i 5) (set! s (+ s i)) (set! i (+ i 1)))', self.g)
|
|
assert run('s', self.g) == 10
|
|
|
|
|
|
class TestTypePredicates(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_number(self): assert run('(number? 42)', self.g) is True
|
|
def test_not_number(self): assert run('(number? "x")', self.g) is False
|
|
def test_integer(self): assert run('(integer? 3)', self.g) is True
|
|
def test_integer_float(self):assert run('(integer? 3.0)', self.g) is True
|
|
def test_string(self): assert run('(string? "x")', self.g) is True
|
|
def test_symbol(self): assert run("(symbol? 'x)", self.g) is True
|
|
def test_pair(self): assert run("(pair? '(1))", self.g) is True
|
|
def test_null(self): assert run("(null? '())", self.g) is True
|
|
def test_procedure(self): assert run('(procedure? car)', self.g) is True
|
|
def test_boolean(self): assert run('(boolean? #t)', self.g) is True
|
|
def test_list(self): assert run("(list? '(1 2))", self.g) is True
|
|
def test_list_improper(self):assert run('(list? (cons 1 2))', self.g) is False
|
|
def test_exact(self): assert run('(exact? 3)', self.g) is True
|
|
def test_inexact(self): assert run('(inexact? 3.0)', self.g) is True
|
|
|
|
|
|
###############################################################################
|
|
# Functional tests — end-to-end programs
|
|
###############################################################################
|
|
|
|
class TestTCO(unittest.TestCase):
|
|
"""Tail-call optimization must not blow Python's stack (limit set to 200)."""
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_tail_recursion_deep(self):
|
|
r = run('''
|
|
(define (loop n)
|
|
(if (= n 0) (quote done) (loop (- n 1))))
|
|
(loop 100000)
|
|
''', self.g)
|
|
assert r is S('done')
|
|
|
|
def test_named_let_tco(self):
|
|
r = run('''
|
|
(let go ((n 100000))
|
|
(if (= n 0) (quote done) (go (- n 1))))
|
|
''', self.g)
|
|
assert r is S('done')
|
|
|
|
def test_mutual_recursion_tco(self):
|
|
r = run('''
|
|
(define (my-even? n) (if (= n 0) #t (my-odd? (- n 1))))
|
|
(define (my-odd? n) (if (= n 0) #f (my-even? (- n 1))))
|
|
(my-even? 10000)
|
|
''', self.g)
|
|
assert r is True
|
|
|
|
def test_accumulator_pattern(self):
|
|
r = run('''
|
|
(define (sum-to n)
|
|
(let loop ((i n) (acc 0))
|
|
(if (= i 0) acc (loop (- i 1) (+ acc i)))))
|
|
(sum-to 10000)
|
|
''', self.g)
|
|
assert r == 50005000
|
|
|
|
|
|
class TestClosures(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_counter(self):
|
|
r = run('''
|
|
(define (make-counter)
|
|
(let ((n 0))
|
|
(lambda ()
|
|
(set! n (+ n 1))
|
|
n)))
|
|
(define c (make-counter))
|
|
(list (c) (c) (c))
|
|
''', self.g)
|
|
assert list(r) == [1, 2, 3]
|
|
|
|
def test_adder_factory(self):
|
|
r = run('''
|
|
(define (make-adder n) (lambda (x) (+ x n)))
|
|
(define add3 (make-adder 3))
|
|
(define add7 (make-adder 7))
|
|
(list (add3 10) (add7 10))
|
|
''', self.g)
|
|
assert list(r) == [13, 17]
|
|
|
|
def test_closure_over_mutation(self):
|
|
r = run('''
|
|
(define (make-acc)
|
|
(let ((total 0))
|
|
(lambda (x)
|
|
(set! total (+ total x))
|
|
total)))
|
|
(define acc (make-acc))
|
|
(list (acc 10) (acc 20) (acc 5))
|
|
''', self.g)
|
|
assert list(r) == [10, 30, 35]
|
|
|
|
def test_shared_closure_state(self):
|
|
r = run('''
|
|
(define (make-bank-account balance)
|
|
(define (withdraw amount)
|
|
(if (>= balance amount)
|
|
(begin (set! balance (- balance amount)) balance)
|
|
(error "insufficient funds")))
|
|
(define (deposit amount)
|
|
(set! balance (+ balance amount))
|
|
balance)
|
|
(lambda (msg . args)
|
|
(cond ((eq? msg (quote withdraw)) (apply withdraw args))
|
|
((eq? msg (quote deposit)) (apply deposit args))
|
|
((eq? msg (quote balance)) balance)
|
|
(else (error "unknown message" msg)))))
|
|
(define acct (make-bank-account 100))
|
|
(list (acct (quote withdraw) 30)
|
|
(acct (quote deposit) 50)
|
|
(acct (quote balance)))
|
|
''', self.g)
|
|
assert list(r) == [70, 120, 120]
|
|
|
|
|
|
class TestRecursion(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_fibonacci(self):
|
|
r = run('''
|
|
(define (fib n)
|
|
(let loop ((a 0) (b 1) (i 0))
|
|
(if (= i n) a (loop b (+ a b) (+ i 1)))))
|
|
(map fib (iota 10))
|
|
''', self.g)
|
|
assert list(r) == [0, 1, 1, 2, 3, 5, 8, 13, 21, 34]
|
|
|
|
def test_ackermann(self):
|
|
# small values — not tail-recursive
|
|
r = run('''
|
|
(define (ack m n)
|
|
(cond ((= m 0) (+ n 1))
|
|
((= n 0) (ack (- m 1) 1))
|
|
(else (ack (- m 1) (ack m (- n 1))))))
|
|
(ack 3 3)
|
|
''', self.g)
|
|
assert r == 61
|
|
|
|
def test_flatten_recursive(self):
|
|
r = run('''
|
|
(define (my-flatten lst)
|
|
(cond ((null? lst) (quote ()))
|
|
((pair? (car lst))
|
|
(append (my-flatten (car lst)) (my-flatten (cdr lst))))
|
|
(else (cons (car lst) (my-flatten (cdr lst))))))
|
|
(my-flatten (quote (1 (2 (3 4) 5) (6))))
|
|
''', self.g)
|
|
assert list(r) == [1, 2, 3, 4, 5, 6]
|
|
|
|
def test_mergesort(self):
|
|
r = run('''
|
|
(define (merge a b)
|
|
(cond ((null? a) b)
|
|
((null? b) a)
|
|
((< (car a) (car b)) (cons (car a) (merge (cdr a) b)))
|
|
(else (cons (car b) (merge a (cdr b))))))
|
|
|
|
(define (split lst)
|
|
(let loop ((l lst) (a (quote ())) (b (quote ())))
|
|
(if (null? l) (list a b)
|
|
(loop (cdr l) b (cons (car l) a)))))
|
|
|
|
(define (mergesort lst)
|
|
(if (or (null? lst) (null? (cdr lst)))
|
|
lst
|
|
(let ((halves (split lst)))
|
|
(merge (mergesort (car halves))
|
|
(mergesort (cadr halves))))))
|
|
|
|
(mergesort (quote (5 3 8 1 9 2 7 4 6)))
|
|
''', self.g)
|
|
assert list(r) == [1, 2, 3, 4, 5, 6, 7, 8, 9]
|
|
|
|
|
|
class TestDataStructures(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_association_list(self):
|
|
r = run('''
|
|
(define db (quote ((alice . 30) (bob . 25) (carol . 35))))
|
|
(define (lookup name)
|
|
(let ((entry (assq name db)))
|
|
(if entry (cdr entry) #f)))
|
|
(list (lookup (quote alice)) (lookup (quote bob)) (lookup (quote dave)))
|
|
''', self.g)
|
|
assert list(r) == [30, 25, False]
|
|
|
|
def test_stack_via_list(self):
|
|
r = run('''
|
|
(define stack (quote ()))
|
|
(define (push! x) (set! stack (cons x stack)))
|
|
(define (pop!)
|
|
(if (null? stack) (error "empty stack")
|
|
(let ((top (car stack)))
|
|
(set! stack (cdr stack))
|
|
top)))
|
|
(push! 1) (push! 2) (push! 3)
|
|
(list (pop!) (pop!) (pop!))
|
|
''', self.g)
|
|
assert list(r) == [3, 2, 1]
|
|
|
|
def test_record_type(self):
|
|
r = run('''
|
|
(define-record-type point
|
|
(make-point x y)
|
|
point?
|
|
(x point-x)
|
|
(y point-y set-y!))
|
|
(define p (make-point 3 4))
|
|
(set-y! p 10)
|
|
(list (point? p) (point-x p) (point-y p) (point? 42))
|
|
''', self.g)
|
|
vals = list(r)
|
|
assert vals[0] is True
|
|
assert vals[1] == 3
|
|
assert vals[2] == 10
|
|
assert vals[3] is False
|
|
|
|
def test_hash_frequency_count(self):
|
|
r = run('''
|
|
(define (frequencies lst)
|
|
(let ((h (make-hash-table)))
|
|
(for-each (lambda (x)
|
|
(hash-table-set! h x (+ 1 (hash-table-ref/default h x 0))))
|
|
lst)
|
|
h))
|
|
(define h (frequencies (quote (a b a c b a))))
|
|
(list (hash-table-ref h (quote a))
|
|
(hash-table-ref h (quote b))
|
|
(hash-table-ref h (quote c)))
|
|
''', self.g)
|
|
assert list(r) == [3, 2, 1]
|
|
|
|
|
|
class TestHigherOrderPrograms(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_church_numerals(self):
|
|
r = run('''
|
|
(define zero (lambda (f) (lambda (x) x)))
|
|
(define succ (lambda (n) (lambda (f) (lambda (x) (f ((n f) x))))))
|
|
(define church->int (lambda (n) ((n (lambda (x) (+ x 1))) 0)))
|
|
(define one (succ zero))
|
|
(define two (succ one))
|
|
(define three (succ two))
|
|
(church->int three)
|
|
''', self.g)
|
|
assert r == 3
|
|
|
|
def test_y_combinator(self):
|
|
r = run('''
|
|
(define Y
|
|
(lambda (f)
|
|
((lambda (x) (f (lambda (v) ((x x) v))))
|
|
(lambda (x) (f (lambda (v) ((x x) v)))))))
|
|
(define factorial
|
|
(Y (lambda (fact)
|
|
(lambda (n)
|
|
(if (<= n 1) 1 (* n (fact (- n 1))))))))
|
|
(factorial 10)
|
|
''', self.g)
|
|
assert r == 3628800
|
|
|
|
def test_continuation_based_iteration(self):
|
|
r = run('''
|
|
(define (find-first pred lst)
|
|
(call/cc
|
|
(lambda (return)
|
|
(for-each (lambda (x) (when (pred x) (return x))) lst)
|
|
#f)))
|
|
(list (find-first even? (quote (1 3 4 5 6)))
|
|
(find-first even? (quote (1 3 5))))
|
|
''', self.g)
|
|
assert list(r) == [4, False]
|
|
|
|
def test_generator_via_closures(self):
|
|
r = run('''
|
|
(define (range-generator start end)
|
|
(let ((i start))
|
|
(lambda ()
|
|
(if (>= i end) (quote done)
|
|
(let ((v i))
|
|
(set! i (+ i 1))
|
|
v)))))
|
|
(define gen (range-generator 0 5))
|
|
(list (gen) (gen) (gen) (gen) (gen) (gen))
|
|
''', self.g)
|
|
assert list(r) == [0, 1, 2, 3, 4, S('done')]
|
|
|
|
|
|
class TestMacroPrograms(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_anaphoric_if(self):
|
|
run('''
|
|
(define-macro (aif test then else)
|
|
`(let ((it ,test))
|
|
(if it ,then ,else)))
|
|
''', self.g)
|
|
assert run('(aif (+ 1 2) (* it 10) #f)', self.g) == 30
|
|
assert run('(aif #f (* it 10) (quote nothing))', self.g) is S('nothing')
|
|
|
|
def test_pipeline_macro(self):
|
|
run('''
|
|
(define-macro (-> val . fns)
|
|
(if (null? fns) val
|
|
`(-> (,(car fns) ,val) ,@(cdr fns))))
|
|
''', self.g)
|
|
r = run("(-> 5 (lambda (x) (* x 2)) (lambda (x) (+ x 1)))", self.g)
|
|
assert r == 11
|
|
|
|
def test_with_gensym(self):
|
|
run('''
|
|
(define-macro (once-only var . body)
|
|
(let ((g (gensym)))
|
|
`(let ((,g ,var))
|
|
,@(map (lambda (e) (list (quote quote) e)) (quote ()))
|
|
(let ((,var ,g)) ,@body))))
|
|
''', self.g)
|
|
# Just verify macro expands without error
|
|
run('(once-only 42)', self.g)
|
|
|
|
def test_repeat_macro(self):
|
|
run('''
|
|
(define-macro (repeat n . body)
|
|
(let ((i (gensym)))
|
|
`(do ((,i 0 (+ ,i 1)))
|
|
((= ,i ,n))
|
|
,@body)))
|
|
''', self.g)
|
|
run('(define x 0)', self.g)
|
|
run('(repeat 5 (set! x (+ x 1)))', self.g)
|
|
assert run('x', self.g) == 5
|
|
|
|
|
|
class TestPrelude(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_1plus(self): assert run('(1+ 5)', self.g) == 6
|
|
def test_1minus(self): assert run('(1- 5)', self.g) == 4
|
|
def test_add1(self): assert run('(add1 9)', self.g) == 10
|
|
def test_sub1(self): assert run('(sub1 9)', self.g) == 8
|
|
def test_square(self): assert run('(square 7)', self.g) == 49
|
|
def test_cube(self): assert run('(cube 3)', self.g) == 27
|
|
def test_atom(self):
|
|
assert run('(atom? 42)', self.g) is True
|
|
assert run("(atom? '(1 2))", self.g) is False
|
|
def test_range_1(self):
|
|
assert runs('(range 5)', self.g) == '(0 1 2 3 4)'
|
|
def test_range_2(self):
|
|
assert runs('(range 2 5)', self.g) == '(2 3 4)'
|
|
def test_range_3(self):
|
|
assert runs('(range 0 10 2)', self.g) == '(0 2 4 6 8)'
|
|
def test_flatten(self):
|
|
assert runs("(flatten '(1 (2 (3 4) 5)))", self.g) == '(1 2 3 4 5)'
|
|
def test_compose_prelude(self):
|
|
run('(define inc-then-double (compose (lambda (x) (* x 2)) (lambda (x) (+ x 1))))', self.g)
|
|
assert run('(inc-then-double 4)', self.g) == 10
|
|
def test_string_map(self):
|
|
assert run('(string-map char-upcase "hello")', self.g) == 'HELLO'
|
|
|
|
|
|
class TestOutputCapture(unittest.TestCase):
|
|
"""Tests that verify display/write output."""
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def _capture(self, src):
|
|
buf = io.StringIO()
|
|
old = sys.stdout; sys.stdout = buf
|
|
try: run(src, self.g)
|
|
finally: sys.stdout = old
|
|
return buf.getvalue()
|
|
|
|
def test_display_string(self):
|
|
out = self._capture('(display "hello")')
|
|
assert out == 'hello'
|
|
|
|
def test_display_number(self):
|
|
out = self._capture('(display 42)')
|
|
assert out == '42'
|
|
|
|
def test_write_string(self):
|
|
out = self._capture('(write "hello")')
|
|
assert out == '"hello"'
|
|
|
|
def test_newline(self):
|
|
out = self._capture('(newline)')
|
|
assert out == '\n'
|
|
|
|
def test_display_boolean(self):
|
|
out = self._capture('(display #t)')
|
|
assert out == '#t'
|
|
|
|
def test_display_list(self):
|
|
out = self._capture("(display '(1 2 3))")
|
|
assert out == '(1 2 3)'
|
|
|
|
def test_format_output(self):
|
|
out = self._capture('(display (format "x=~a" 42))')
|
|
assert out == 'x=42'
|
|
|
|
|
|
class TestLoadFile(unittest.TestCase):
|
|
"""Tests for loading .lsp files."""
|
|
|
|
def setUp(self):
|
|
import tempfile, os
|
|
self.g = fresh()
|
|
self.tmpdir = tempfile.mkdtemp()
|
|
|
|
def tearDown(self):
|
|
import shutil
|
|
shutil.rmtree(self.tmpdir)
|
|
|
|
def _write(self, name, content):
|
|
import os
|
|
path = os.path.join(self.tmpdir, name)
|
|
with open(path, 'w') as f: f.write(textwrap.dedent(content))
|
|
return path
|
|
|
|
def test_load_simple(self):
|
|
path = self._write('simple.lsp', '(define x 42)')
|
|
run(f'(load "{path}")', self.g)
|
|
assert run('x', self.g) == 42
|
|
|
|
def test_load_defines_function(self):
|
|
path = self._write('fn.lsp', '''
|
|
(define (double x) (* x 2))
|
|
''')
|
|
run(f'(load "{path}")', self.g)
|
|
assert run('(double 7)', self.g) == 14
|
|
|
|
def test_load_multiple_forms(self):
|
|
path = self._write('multi.lsp', '''
|
|
(define a 1)
|
|
(define b 2)
|
|
(define c (+ a b))
|
|
''')
|
|
run(f'(load "{path}")', self.g)
|
|
assert run('c', self.g) == 3
|
|
|
|
|
|
class TestCommandLine(unittest.TestCase):
|
|
"""End-to-end tests via subprocess."""
|
|
|
|
def _run(self, *args, input_text=None):
|
|
import subprocess
|
|
result = subprocess.run(
|
|
[sys.executable, 'uncommonlisp.py'] + list(args),
|
|
capture_output=True, text=True, input=input_text,
|
|
cwd='/home/fox/git/uncommonlisp'
|
|
)
|
|
return result.stdout.strip(), result.stderr.strip(), result.returncode
|
|
|
|
def test_eval_flag(self):
|
|
out, err, code = self._run('-e', '(display (+ 1 2))')
|
|
assert code == 0
|
|
assert out == '3'
|
|
|
|
def test_eval_string(self):
|
|
out, err, code = self._run('-e', '(display "hi")')
|
|
assert out == 'hi'
|
|
|
|
def test_eval_multiple(self):
|
|
out, err, code = self._run('-e', '(display (map (lambda (x) (* x x)) (iota 4)))')
|
|
assert out == '(0 1 4 9)'
|
|
|
|
def test_error_exit_code(self):
|
|
_, _, code = self._run('-e', '(error "boom")')
|
|
assert code != 0
|
|
|
|
def test_script_file(self):
|
|
import tempfile, os
|
|
with tempfile.NamedTemporaryFile(mode='w', suffix='.lsp', delete=False) as f:
|
|
f.write('(display (* 6 7))\n')
|
|
path = f.name
|
|
try:
|
|
out, err, code = self._run(path)
|
|
assert code == 0
|
|
assert out == '42'
|
|
finally:
|
|
os.unlink(path)
|
|
|
|
def test_missing_file(self):
|
|
_, err, code = self._run('/nonexistent/file.lsp')
|
|
assert code != 0
|
|
|
|
|
|
###############################################################################
|
|
# Edge cases & regression tests
|
|
###############################################################################
|
|
|
|
class TestEdgeCases(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_deep_nesting(self):
|
|
r = run('(car (cdr (cdr (list 1 2 3 4))))', self.g)
|
|
assert r == 3
|
|
|
|
def test_empty_begin(self):
|
|
assert run('(begin)', self.g) is VOID
|
|
|
|
def test_let_no_bindings(self):
|
|
assert run('(let () 42)', self.g) == 42
|
|
|
|
def test_variadic_no_rest(self):
|
|
run('(define (f x . rest) rest)', self.g)
|
|
assert run('(f 1)', self.g) is NIL
|
|
|
|
def test_recursive_data(self):
|
|
# circular-ish through explicit construction
|
|
r = run("(define x (list 1 2 3)) (length x)", self.g)
|
|
assert r == 3
|
|
|
|
def test_boolean_not_number(self):
|
|
with self.assertRaises(LispErr):
|
|
run('(+ #t 1)', self.g)
|
|
|
|
def test_wrong_arity_raises(self):
|
|
run('(define (f x y) (+ x y))', self.g)
|
|
with self.assertRaises(LispErr):
|
|
run('(f 1)', self.g)
|
|
|
|
def test_car_nil_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
run("(car '())", self.g)
|
|
|
|
def test_cdr_nil_raises(self):
|
|
with self.assertRaises(LispErr):
|
|
run("(cdr '())", self.g)
|
|
|
|
def test_symbol_interning_across_parses(self):
|
|
a = read_all("'foo")[0].cdr.car
|
|
b = read_all("'foo")[0].cdr.car
|
|
assert a is b
|
|
|
|
def test_number_types(self):
|
|
assert isinstance(run('1', self.g), int)
|
|
assert isinstance(run('1.0', self.g), float)
|
|
|
|
def test_zero_division_raises(self):
|
|
with self.assertRaises((ZeroDivisionError, LispErr)):
|
|
run('(/ 1 0)', self.g)
|
|
|
|
def test_gensym_unique(self):
|
|
a = run('(gensym)', self.g)
|
|
b = run('(gensym)', self.g)
|
|
assert a != b
|
|
assert isinstance(a, Symbol)
|
|
|
|
def test_multiline_parse(self):
|
|
r = run('''
|
|
(define (add a b)
|
|
(+ a b))
|
|
(add 3 4)
|
|
''', self.g)
|
|
assert r == 7
|
|
|
|
def test_mutual_define_in_begin(self):
|
|
r = run('''
|
|
(define (even? n) (if (= n 0) #t (odd? (- n 1))))
|
|
(define (odd? n) (if (= n 0) #f (even? (- n 1))))
|
|
(list (even? 4) (odd? 5))
|
|
''', self.g)
|
|
assert list(r) == [True, True]
|
|
|
|
def test_higher_order_returns_proc(self):
|
|
run('(define (make-adder n) (lambda (x) (+ x n)))', self.g)
|
|
p = run('(make-adder 5)', self.g)
|
|
assert isinstance(p, Proc)
|
|
|
|
def test_string_with_escaped_quote(self):
|
|
r = run(r'(string-length "a\"b")', self.g)
|
|
assert r == 3
|
|
|
|
def test_write_round_trip(self):
|
|
r = show(run('(list 1 "two" (quote three) #t #f)', self.g))
|
|
assert r == '(1 "two" three #t #f)'
|
|
|
|
|
|
###############################################################################
|
|
# String ports
|
|
###############################################################################
|
|
|
|
class TestStringPorts(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_open_output_string_display(self):
|
|
r = run('(let ((p (open-output-string))) (display "hello" p) (get-output-string p))', self.g)
|
|
assert r == 'hello'
|
|
|
|
def test_open_output_string_write(self):
|
|
r = run('(let ((p (open-output-string))) (write "hello" p) (get-output-string p))', self.g)
|
|
assert r == '"hello"'
|
|
|
|
def test_open_output_string_multiple(self):
|
|
r = run('(let ((p (open-output-string))) (display 1 p) (display 2 p) (display 3 p) (get-output-string p))', self.g)
|
|
assert r == '123'
|
|
|
|
def test_open_input_string_read(self):
|
|
r = run('(let ((p (open-input-string "(+ 1 2)"))) (read p))', self.g)
|
|
assert runs('(let ((p (open-input-string "(+ 1 2)"))) (read p))', self.g) == '(+ 1 2)'
|
|
|
|
def test_open_input_string_read_multiple(self):
|
|
r = runs('(let ((p (open-input-string "1 2 3"))) (list (read p) (read p) (read p)))', self.g)
|
|
assert r == '(1 2 3)'
|
|
|
|
def test_open_input_string_eof(self):
|
|
r = run('(let ((p (open-input-string ""))) (read p))', self.g)
|
|
from uncommonlisp import EOF
|
|
assert r is EOF
|
|
|
|
def test_open_input_string_read_char(self):
|
|
r = run('(let ((p (open-input-string "abc"))) (read-char p))', self.g)
|
|
assert r == 'a'
|
|
|
|
def test_open_input_string_peek_char(self):
|
|
r = run('(let ((p (open-input-string "abc"))) (list (peek-char p) (read-char p) (read-char p)))', self.g)
|
|
assert list(r) == ['a', 'a', 'b']
|
|
|
|
def test_read_line_from_string_port(self):
|
|
r = run('(let ((p (open-input-string "line1\nline2"))) (read-line p))', self.g)
|
|
assert r == 'line1'
|
|
|
|
def test_call_with_string_output_port(self):
|
|
r = run('(call-with-string-output-port (lambda (p) (display 42 p) (display " hi" p)))', self.g)
|
|
assert r == '42 hi'
|
|
|
|
def test_string_port_predicate(self):
|
|
assert run('(string-port? (open-output-string))', self.g) is True
|
|
assert run('(string-port? (open-input-string "x"))', self.g) is True
|
|
assert run('(output-port? (open-output-string))', self.g) is True
|
|
assert run('(input-port? (open-input-string "x"))', self.g) is True
|
|
|
|
def test_read_all_from_port(self):
|
|
r = runs('''
|
|
(let ((p (open-input-string "1 2 3")))
|
|
(let loop ((acc (quote ())))
|
|
(let ((x (read p)))
|
|
(if (eof-object? x)
|
|
(reverse acc)
|
|
(loop (cons x acc))))))
|
|
''', self.g)
|
|
assert r == '(1 2 3)'
|
|
|
|
|
|
###############################################################################
|
|
# Error objects
|
|
###############################################################################
|
|
|
|
class TestErrorObjects(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_error_object_predicate(self):
|
|
r = run('(guard (e (#t (error-object? e))) (error "test"))', self.g)
|
|
assert r is True
|
|
|
|
def test_error_object_message(self):
|
|
r = run('(guard (e (#t (error-object-message e))) (error "oops"))', self.g)
|
|
assert r == 'oops'
|
|
|
|
def test_error_object_irritants(self):
|
|
r = runs('(guard (e (#t (error-object-irritants e))) (error "bad" 1 2 3))', self.g)
|
|
assert r == '(1 2 3)'
|
|
|
|
def test_error_object_irritants_empty(self):
|
|
r = run('(guard (e (#t (error-object-irritants e))) (error "no-irritants"))', self.g)
|
|
from uncommonlisp import NIL
|
|
assert r is NIL
|
|
|
|
def test_with_exception_handler_gets_error_object(self):
|
|
r = run('(with-exception-handler (lambda (e) (error-object? e)) (lambda () (error "boom")))', self.g)
|
|
assert r is True
|
|
|
|
def test_with_exception_handler_message(self):
|
|
r = run('(with-exception-handler (lambda (e) (error-object-message e)) (lambda () (error "msg" 1)))', self.g)
|
|
assert r == 'msg'
|
|
|
|
def test_error_not_caught_reraises(self):
|
|
with self.assertRaises(Exception):
|
|
run('(guard (e ((string? e) "string-error")) (error "not-a-string-check"))', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# string->number extended
|
|
###############################################################################
|
|
|
|
class TestStringToNumberExtended(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_hex_prefix_hash(self):
|
|
assert run('(string->number "#xff")', self.g) == 255
|
|
assert run('(string->number "#xAB")', self.g) == 171
|
|
|
|
def test_bin_prefix_hash(self):
|
|
assert run('(string->number "#b1010")', self.g) == 10
|
|
|
|
def test_oct_prefix_hash(self):
|
|
assert run('(string->number "#o17")', self.g) == 15
|
|
|
|
def test_hex_prefix_0x(self):
|
|
assert run('(string->number "0xff")', self.g) == 255
|
|
|
|
def test_bin_prefix_0b(self):
|
|
assert run('(string->number "0b101")', self.g) == 5
|
|
|
|
def test_oct_prefix_0o(self):
|
|
assert run('(string->number "0o77")', self.g) == 63
|
|
|
|
def test_decimal_prefix(self):
|
|
assert run('(string->number "#d42")', self.g) == 42
|
|
|
|
def test_explicit_base_still_works(self):
|
|
assert run('(string->number "ff" 16)', self.g) == 255
|
|
assert run('(string->number "1010" 2)', self.g) == 10
|
|
|
|
def test_invalid_returns_false(self):
|
|
assert run('(string->number "not-a-number")', self.g) is False
|
|
assert run('(string->number "")', self.g) is False
|
|
|
|
|
|
###############################################################################
|
|
# Internal defines (letrec* body semantics)
|
|
###############################################################################
|
|
|
|
class TestInternalDefines(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_mutual_recursion_in_body(self):
|
|
r = run('''
|
|
(define (f)
|
|
(define (even? n) (if (= n 0) #t (odd? (- n 1))))
|
|
(define (odd? n) (if (= n 0) #f (even? (- n 1))))
|
|
(list (even? 4) (odd? 3)))
|
|
(f)
|
|
''', self.g)
|
|
assert list(r) == [True, True]
|
|
|
|
def test_sequential_body_defines(self):
|
|
r = run('''
|
|
(define (f)
|
|
(define x 1)
|
|
(define y 2)
|
|
(+ x y))
|
|
(f)
|
|
''', self.g)
|
|
assert r == 3
|
|
|
|
def test_internal_define_in_let(self):
|
|
r = run('(let ((x 10)) (define y (* x 2)) y)', self.g)
|
|
assert r == 20
|
|
|
|
def test_internal_define_in_letrec(self):
|
|
r = run('(letrec ((x 5)) (define y (+ x 1)) y)', self.g)
|
|
assert r == 6
|
|
|
|
def test_internal_define_shadowing(self):
|
|
run('(define x 100)', self.g)
|
|
r = run('''
|
|
(define (f)
|
|
(define x 1)
|
|
x)
|
|
(list (f) x)
|
|
''', self.g)
|
|
assert list(r) == [1, 100]
|
|
|
|
def test_predeclared_names_allow_mutual_ref(self):
|
|
# Both names pre-declared → each closure can reference the other
|
|
# ping(5)→pong(4)→ping(3)→pong(2)→ping(1)→pong(0) = "pong"
|
|
r = run('''
|
|
(let ()
|
|
(define (ping n) (if (= n 0) "ping" (pong (- n 1))))
|
|
(define (pong n) (if (= n 0) "pong" (ping (- n 1))))
|
|
(ping 5))
|
|
''', self.g)
|
|
assert r == 'pong'
|
|
|
|
|
|
###############################################################################
|
|
# Module system
|
|
###############################################################################
|
|
|
|
class TestModuleSystem(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_module_define_and_import(self):
|
|
run('''
|
|
(module mymath
|
|
(export square cube)
|
|
(define (square x) (* x x))
|
|
(define (cube x) (* x x x)))
|
|
''', self.g)
|
|
run('(import mymath)', self.g)
|
|
assert run('(square 5)', self.g) == 25
|
|
assert run('(cube 3)', self.g) == 27
|
|
|
|
def test_module_hides_private(self):
|
|
run('''
|
|
(module secret
|
|
(export public-fn)
|
|
(define private-val 42)
|
|
(define (public-fn) private-val))
|
|
''', self.g)
|
|
run('(import secret)', self.g)
|
|
assert run('(public-fn)', self.g) == 42
|
|
with self.assertRaises(Exception):
|
|
run('private-val', self.g)
|
|
|
|
def test_selective_import(self):
|
|
run('''
|
|
(module tools
|
|
(export add mul)
|
|
(define (add a b) (+ a b))
|
|
(define (mul a b) (* a b)))
|
|
''', self.g)
|
|
run('(import (tools add))', self.g)
|
|
assert run('(add 3 4)', self.g) == 7
|
|
with self.assertRaises(Exception):
|
|
run('(mul 3 4)', self.g)
|
|
|
|
def test_module_import_unknown_raises(self):
|
|
with self.assertRaises(Exception):
|
|
run('(import no-such-module)', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# define-record-type with inheritance
|
|
###############################################################################
|
|
|
|
class TestRecordTypeInheritance(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic_record_unchanged(self):
|
|
run('''
|
|
(define-record-type vec2
|
|
(make-vec2 x y)
|
|
vec2?
|
|
(x vec2-x)
|
|
(y vec2-y set-vec2-y!))
|
|
''', self.g)
|
|
run('(define v (make-vec2 3 4))', self.g)
|
|
assert run('(vec2? v)', self.g) is True
|
|
assert run('(vec2-x v)', self.g) == 3
|
|
assert run('(vec2-y v)', self.g) == 4
|
|
run('(set-vec2-y! v 99)', self.g)
|
|
assert run('(vec2-y v)', self.g) == 99
|
|
|
|
def test_inherited_predicate(self):
|
|
run('''
|
|
(define-record-type animal
|
|
(make-animal name)
|
|
animal?
|
|
(name animal-name))
|
|
(define-record-type dog
|
|
(inherit animal)
|
|
(make-dog name breed)
|
|
dog?
|
|
(name animal-name)
|
|
(breed dog-breed))
|
|
''', self.g)
|
|
run('(define a (make-animal "cat"))', self.g)
|
|
run('(define d (make-dog "rex" "lab"))', self.g)
|
|
assert run('(animal? a)', self.g) is True
|
|
assert run('(animal? d)', self.g) is True # dog is subtype of animal
|
|
assert run('(dog? d)', self.g) is True
|
|
assert run('(dog? a)', self.g) is False
|
|
|
|
def test_inherited_accessor(self):
|
|
run('''
|
|
(define-record-type shape
|
|
(make-shape color)
|
|
shape?
|
|
(color shape-color))
|
|
(define-record-type circle
|
|
(inherit shape)
|
|
(make-circle color radius)
|
|
circle?
|
|
(color shape-color)
|
|
(radius circle-radius))
|
|
''', self.g)
|
|
run('(define c (make-circle "red" 5))', self.g)
|
|
assert run('(shape-color c)', self.g) == 'red'
|
|
assert run('(circle-radius c)', self.g) == 5
|
|
assert run('(shape? c)', self.g) is True
|
|
|
|
def test_deep_inheritance(self):
|
|
run('''
|
|
(define-record-type a (make-a x) a? (x a-x))
|
|
(define-record-type b (inherit a) (make-b x y) b? (x a-x) (y b-y))
|
|
(define-record-type c (inherit b) (make-c x y z) c? (x a-x) (y b-y) (z c-z))
|
|
''', self.g)
|
|
run('(define obj (make-c 1 2 3))', self.g)
|
|
assert run('(a? obj)', self.g) is True
|
|
assert run('(b? obj)', self.g) is True
|
|
assert run('(c? obj)', self.g) is True
|
|
assert run('(a-x obj)', self.g) == 1
|
|
assert run('(b-y obj)', self.g) == 2
|
|
assert run('(c-z obj)', self.g) == 3
|
|
|
|
|
|
###############################################################################
|
|
# Rational numbers
|
|
###############################################################################
|
|
|
|
class TestRationals(unittest.TestCase):
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_division_exact(self):
|
|
assert runs('(/ 1 3)', self.g) == '1/3'
|
|
|
|
def test_division_simplifies(self):
|
|
assert runs('(/ 2 4)', self.g) == '1/2'
|
|
|
|
def test_division_whole(self):
|
|
assert run('(/ 6 3)', self.g) == 2
|
|
assert isinstance(run('(/ 6 3)', self.g), int)
|
|
|
|
def test_rational_literal(self):
|
|
assert runs('1/3', self.g) == '1/3'
|
|
|
|
def test_rational_add(self):
|
|
assert runs('(+ 1/3 1/6)', self.g) == '1/2'
|
|
|
|
def test_rational_mul(self):
|
|
assert runs('(* 2/3 3/4)', self.g) == '1/2'
|
|
|
|
def test_rational_sub(self):
|
|
assert runs('(- 1 1/3)', self.g) == '2/3'
|
|
|
|
def test_rational_add_to_int(self):
|
|
assert run('(+ 1/4 1/4 1/4 1/4)', self.g) == 1
|
|
assert isinstance(run('(+ 1/4 1/4 1/4 1/4)', self.g), int)
|
|
|
|
def test_rational_exact(self):
|
|
assert run('(exact? 1/3)', self.g) is True
|
|
assert run('(inexact? 1/3)', self.g) is False
|
|
|
|
def test_rational_predicates(self):
|
|
assert run('(number? 1/3)', self.g) is True
|
|
assert run('(rational? 1/3)', self.g) is True
|
|
assert run('(integer? 1/3)', self.g) is False
|
|
|
|
def test_rational_comparison(self):
|
|
assert run('(= 1/2 0.5)', self.g) is True
|
|
assert run('(< 1/3 1/2)', self.g) is True
|
|
assert run('(> 2/3 1/2)', self.g) is True
|
|
|
|
def test_rational_inexact(self):
|
|
r = run('(inexact 1/4)', self.g)
|
|
assert abs(r - 0.25) < 1e-10
|
|
|
|
def test_numerator_denominator(self):
|
|
assert run('(numerator 2/3)', self.g) == 2
|
|
assert run('(denominator 2/3)', self.g) == 3
|
|
assert run('(numerator 3)', self.g) == 3
|
|
assert run('(denominator 3)', self.g) == 1
|
|
|
|
def test_number_to_string_rational(self):
|
|
assert run('(number->string 1/3)', self.g) == '1/3'
|
|
|
|
def test_string_to_number_rational(self):
|
|
assert runs('(string->number "1/3")', self.g) == '1/3'
|
|
assert runs('(string->number "2/4")', self.g) == '1/2'
|
|
|
|
def test_rational_mixed_arithmetic(self):
|
|
# Mix of int, rational, float
|
|
r = run('(+ 1/2 0.5)', self.g)
|
|
assert abs(r - 1.0) < 1e-10
|
|
|
|
def test_one_over_n(self):
|
|
assert runs('(/ 1 7)', self.g) == '1/7'
|
|
assert runs('(* 7 (/ 1 7))', self.g) == '1'
|
|
|
|
|
|
###############################################################################
|
|
# New feature tests
|
|
###############################################################################
|
|
|
|
class TestParameterize(unittest.TestCase):
|
|
"""Verify parameterize restores the old value, not the current value."""
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_restore_after_body(self):
|
|
# After parameterize, original value is restored
|
|
r = run("""
|
|
(define p (make-parameter 1))
|
|
(parameterize ((p 42))
|
|
(p))
|
|
""", self.g)
|
|
assert r == 42, f'expected 42, got {r}'
|
|
r2 = run('(p)', self.g)
|
|
assert r2 == 1, f'expected 1 restored, got {r2}'
|
|
|
|
def test_restore_on_exception(self):
|
|
# Even if body raises, old value is restored
|
|
g = fresh()
|
|
run('(define p (make-parameter 10))', g)
|
|
try:
|
|
run('(parameterize ((p 99)) (error "boom"))', g)
|
|
except LispErr:
|
|
pass
|
|
assert run('(p)', g) == 10
|
|
|
|
def test_nested_parameterize(self):
|
|
g = fresh()
|
|
r = run("""
|
|
(define p (make-parameter 0))
|
|
(parameterize ((p 1))
|
|
(parameterize ((p 2))
|
|
(p)))
|
|
""", g)
|
|
assert r == 2
|
|
assert run('(p)', g) == 0
|
|
|
|
def test_parameterize_restores_outer(self):
|
|
g = fresh()
|
|
run('(define p (make-parameter 5))', g)
|
|
inner = run('(parameterize ((p 10)) (p))', g)
|
|
assert inner == 10
|
|
after = run('(p)', g)
|
|
assert after == 5, f'expected 5 after parameterize, got {after}'
|
|
|
|
|
|
class TestLetValues(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_basic_let_values(self):
|
|
r = run('(let-values (((a b) (values 1 2))) (+ a b))', self.g)
|
|
assert r == 3
|
|
|
|
def test_multiple_bindings(self):
|
|
r = run('(let-values (((a b) (values 3 4)) ((c) (values 5))) (+ a b c))', self.g)
|
|
assert r == 12
|
|
|
|
def test_let_star_values_sequential(self):
|
|
# let*-values: second binding can use first
|
|
r = run("""
|
|
(let*-values (((a b) (values 1 2))
|
|
((c) (values (+ a b))))
|
|
c)
|
|
""", self.g)
|
|
assert r == 3
|
|
|
|
def test_single_value(self):
|
|
r = run('(let-values (((x) (values 7))) x)', self.g)
|
|
assert r == 7
|
|
|
|
|
|
class TestCaseArrow(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_case_no_arrow(self):
|
|
r = run('(case 2 ((1) "one") ((2) "two") (else "other"))', self.g)
|
|
assert r == 'two'
|
|
|
|
def test_case_arrow(self):
|
|
# (datum => proc): proc is called with the key value
|
|
# (* 2 3) = 6; key 5 is in (2 3 5 7), so proc should be called with 5
|
|
r = run('(case 5 ((2 3 5 7) => (lambda (x) (* x 10))) (else 0))', self.g)
|
|
assert r == 50
|
|
|
|
def test_case_else_no_arrow(self):
|
|
r = run('(case 99 ((1) 1) (else 42))', self.g)
|
|
assert r == 42
|
|
|
|
def test_case_else_arrow(self):
|
|
r = run('(case 5 ((1 2) "low") (else => (lambda (x) (+ x 100))))', self.g)
|
|
assert r == 105
|
|
|
|
|
|
class TestR7RSArithmetic(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_truncate_quotient(self):
|
|
assert run('(truncate-quotient 10 3)', self.g) == 3
|
|
assert run('(truncate-quotient -10 3)', self.g) == -3
|
|
|
|
def test_truncate_remainder(self):
|
|
assert run('(truncate-remainder 10 3)', self.g) == 1
|
|
assert run('(truncate-remainder -10 3)', self.g) == -1
|
|
|
|
def test_floor_quotient(self):
|
|
assert run('(floor-quotient 10 3)', self.g) == 3
|
|
assert run('(floor-quotient -10 3)', self.g) == -4
|
|
|
|
def test_floor_remainder(self):
|
|
assert run('(floor-remainder 10 3)', self.g) == 1
|
|
assert run('(floor-remainder -10 3)', self.g) == 2
|
|
|
|
def test_square(self):
|
|
assert run('(square 5)', self.g) == 25
|
|
assert run('(square -3)', self.g) == 9
|
|
|
|
def test_exact_integer(self):
|
|
assert run('(exact-integer? 42)', self.g) is True
|
|
assert run('(exact-integer? 42.0)', self.g) is False
|
|
assert run('(exact-integer? #t)', self.g) is False
|
|
|
|
|
|
class TestVectorCopy(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_vector_copy_full(self):
|
|
r = run('(vector-copy #(1 2 3 4 5))', self.g)
|
|
assert r == [1, 2, 3, 4, 5]
|
|
|
|
def test_vector_copy_start(self):
|
|
r = run('(vector-copy #(1 2 3 4 5) 2)', self.g)
|
|
assert r == [3, 4, 5]
|
|
|
|
def test_vector_copy_range(self):
|
|
r = run('(vector-copy #(1 2 3 4 5) 1 3)', self.g)
|
|
assert r == [2, 3]
|
|
|
|
def test_vector_copy_bang(self):
|
|
r = run("""
|
|
(define v (vector 1 2 3 4 5))
|
|
(vector-copy! v 1 #(10 20 30))
|
|
v
|
|
""", self.g)
|
|
assert r == [1, 10, 20, 30, 5]
|
|
|
|
def test_vector_copy_bang_partial(self):
|
|
r = run("""
|
|
(define v (vector 0 0 0 0 0))
|
|
(vector-copy! v 0 #(9 8 7) 1 2)
|
|
v
|
|
""", self.g)
|
|
assert r == [8, 0, 0, 0, 0]
|
|
|
|
|
|
class TestFileSystem(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_current_directory(self):
|
|
import os
|
|
r = run('(current-directory)', self.g)
|
|
assert isinstance(r, str)
|
|
assert os.path.isdir(r)
|
|
|
|
def test_file_exists_missing(self):
|
|
r = run('(file-exists? "/tmp/__no_such_file_xyzzy__")', self.g)
|
|
assert r is False
|
|
|
|
def test_file_exists_present(self):
|
|
import tempfile, os
|
|
with tempfile.NamedTemporaryFile(delete=False) as f:
|
|
path = f.name
|
|
try:
|
|
src = f'(file-exists? "{path}")'
|
|
assert run(src, self.g) is True
|
|
finally:
|
|
os.unlink(path)
|
|
|
|
def test_file_directory(self):
|
|
r = run('(file-directory? "/tmp")', self.g)
|
|
assert r is True
|
|
|
|
def test_file_regular(self):
|
|
import tempfile, os
|
|
with tempfile.NamedTemporaryFile(delete=False) as f:
|
|
path = f.name
|
|
try:
|
|
src = f'(file-regular? "{path}")'
|
|
assert run(src, self.g) is True
|
|
finally:
|
|
os.unlink(path)
|
|
|
|
def test_get_environment_variable(self):
|
|
import os
|
|
os.environ['_UCL_TEST_VAR'] = 'hello'
|
|
r = run('(get-environment-variable "_UCL_TEST_VAR")', self.g)
|
|
assert r == 'hello'
|
|
del os.environ['_UCL_TEST_VAR']
|
|
|
|
def test_get_environment_variable_missing(self):
|
|
r = run('(get-environment-variable "__NO_SUCH_VAR_XYZ__")', self.g)
|
|
assert r is False
|
|
|
|
def test_jiffies_per_second(self):
|
|
r = run('(jiffies-per-second)', self.g)
|
|
assert r == 1000
|
|
|
|
def test_current_jiffy(self):
|
|
r = run('(current-jiffy)', self.g)
|
|
assert isinstance(r, int)
|
|
assert r > 0
|
|
|
|
|
|
class TestCallStack(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_call_stack_attribute_exists(self):
|
|
# LispErr should carry a call_stack attribute
|
|
try:
|
|
run('(error "oops")', self.g)
|
|
assert False, 'expected LispErr'
|
|
except LispErr as e:
|
|
assert hasattr(e, 'call_stack')
|
|
assert isinstance(e.call_stack, list)
|
|
|
|
def test_call_stack_captured_via_call(self):
|
|
# map uses _call internally, so g should appear in the call stack
|
|
try:
|
|
run('(define (g x) (error "boom" x)) (map g (list 1 2 3))', self.g)
|
|
assert False, 'expected LispErr'
|
|
except LispErr as e:
|
|
assert 'g' in e.call_stack
|
|
|
|
|
|
class TestTracing(unittest.TestCase):
|
|
|
|
def setUp(self): self.g = fresh()
|
|
|
|
def test_make_traced_still_works(self):
|
|
# make-traced wraps without breaking functionality
|
|
run('(define (double x) (* x 2))', self.g)
|
|
run('(trace double)', self.g)
|
|
r = run('(double 5)', self.g)
|
|
assert r == 10
|
|
|
|
def test_untrace_restores(self):
|
|
run('(define (add1 x) (+ x 1))', self.g)
|
|
run('(trace add1)', self.g)
|
|
run('(untrace add1)', self.g)
|
|
r = run('(add1 3)', self.g)
|
|
assert r == 4
|
|
|
|
|
|
###############################################################################
|
|
# Bytecode Compiler Tests
|
|
###############################################################################
|
|
|
|
class TestBytecodeCompiler(unittest.TestCase):
|
|
"""Tests for the bytecode compiler and VM."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
def _compile_and_run(self, define_src, call_src):
|
|
"""Define a function, compile it, then call it."""
|
|
run(define_src, self.g)
|
|
# Get the function name from (define (NAME ...) ...)
|
|
import re
|
|
m = re.search(r'\(define\s+\(([^\s)]+)', define_src)
|
|
name = m.group(1) if m else None
|
|
if name:
|
|
run(f'(set! {name} (compile {name}))', self.g)
|
|
return run(call_src, self.g)
|
|
|
|
def test_compile_basic_arithmetic(self):
|
|
r = self._compile_and_run('(define (add x y) (+ x y))', '(add 3 4)')
|
|
assert r == 7
|
|
|
|
def test_compile_if(self):
|
|
r = self._compile_and_run('(define (abs x) (if (< x 0) (- x) x))', '(abs -5)')
|
|
assert r == 5
|
|
r = run('(abs 3)', self.g)
|
|
assert r == 3
|
|
|
|
def test_compile_begin(self):
|
|
r = self._compile_and_run(
|
|
'(define (f) (begin 1 2 3))', '(f)')
|
|
assert r == 3
|
|
|
|
def test_compile_and(self):
|
|
self._compile_and_run('(define (f x y) (and x y))', '(f 1 2)')
|
|
assert run('(f 1 2)', self.g) == 2
|
|
assert run('(f #f 2)', self.g) == False
|
|
assert run('(f 1 #f)', self.g) == False
|
|
assert run('(f #f #f)', self.g) == False
|
|
|
|
def test_compile_or(self):
|
|
self._compile_and_run('(define (f x y) (or x y))', '(f 1 2)')
|
|
assert run('(f 1 2)', self.g) == 1
|
|
assert run('(f #f 2)', self.g) == 2
|
|
assert run('(f #f #f)', self.g) == False
|
|
|
|
def test_compile_cond(self):
|
|
r = self._compile_and_run('''
|
|
(define (classify n)
|
|
(cond ((< n 0) -1) ((= n 0) 0) (else 1)))
|
|
''', '(classify -5)')
|
|
assert r == -1
|
|
assert run('(classify 0)', self.g) == 0
|
|
assert run('(classify 5)', self.g) == 1
|
|
|
|
def test_compile_named_let_fib(self):
|
|
r = self._compile_and_run('''
|
|
(define (fib n)
|
|
(let loop ((a 0) (b 1) (i 0))
|
|
(if (= i n) a (loop b (+ a b) (+ i 1)))))
|
|
''', '(fib 10)')
|
|
assert r == 55
|
|
|
|
def test_compile_named_let_tco(self):
|
|
"""Named let must not blow the Python stack."""
|
|
r = self._compile_and_run('''
|
|
(define (sum-to n)
|
|
(let loop ((i n) (acc 0))
|
|
(if (= i 0) acc (loop (- i 1) (+ acc i)))))
|
|
''', '(sum-to 100000)')
|
|
assert r == 5000050000
|
|
|
|
def test_compile_tree_recursive(self):
|
|
r = self._compile_and_run('''
|
|
(define (fib n)
|
|
(if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2)))))
|
|
''', '(fib 15)')
|
|
assert r == 610
|
|
|
|
def test_compile_lambda_closure(self):
|
|
r = self._compile_and_run(
|
|
'(define (make-adder n) (lambda (x) (+ x n)))',
|
|
'((make-adder 10) 5)')
|
|
assert r == 15
|
|
|
|
def test_compile_let(self):
|
|
r = self._compile_and_run(
|
|
'(define (f x) (let ((y (* x 2))) (+ y 1)))',
|
|
'(f 5)')
|
|
assert r == 11
|
|
|
|
def test_compile_let_star(self):
|
|
r = self._compile_and_run(
|
|
'(define (f x) (let* ((a x) (b (* a 2))) (+ a b)))',
|
|
'(f 3)')
|
|
assert r == 9
|
|
|
|
def test_compile_letrec(self):
|
|
r = self._compile_and_run('''
|
|
(define (f n)
|
|
(letrec ((even? (lambda (x) (if (= x 0) #t (odd? (- x 1)))))
|
|
(odd? (lambda (x) (if (= x 0) #f (even? (- x 1))))))
|
|
(even? n)))
|
|
''', '(f 10)')
|
|
assert r == True
|
|
assert run('(f 11)', self.g) == False
|
|
|
|
def test_compile_do_loop(self):
|
|
r = self._compile_and_run('''
|
|
(define (sum-do n)
|
|
(do ((i 1 (+ i 1)) (s 0 (+ s i)))
|
|
((> i n) s)))
|
|
''', '(sum-do 100)')
|
|
assert r == 5050
|
|
|
|
def test_compile_when_unless(self):
|
|
r = self._compile_and_run('''
|
|
(define (f x) (when (> x 0) (* x 2)))
|
|
''', '(f 5)')
|
|
assert r == 10
|
|
|
|
def test_compile_interop_with_builtins(self):
|
|
"""Compiled code calling builtins (map, filter, etc.)."""
|
|
r = self._compile_and_run('''
|
|
(define (process lst)
|
|
(fold-left + 0 (map (lambda (x) (* x x)) lst)))
|
|
''', '(process (list 1 2 3 4 5))')
|
|
assert r == 55
|
|
|
|
def test_compile_predicate(self):
|
|
run('(define (f x) x)', self.g)
|
|
assert run('(compiled? f)', self.g) == False
|
|
run('(set! f (compile f))', self.g)
|
|
assert run('(compiled? f)', self.g) == True
|
|
assert run('(procedure? f)', self.g) == True
|
|
|
|
def test_compile_mutual_recursion(self):
|
|
"""Compiled code calling other compiled code."""
|
|
run('''
|
|
(define (even? n) (if (= n 0) #t (odd? (- n 1))))
|
|
(define (odd? n) (if (= n 0) #f (even? (- n 1))))
|
|
(set! even? (compile even?))
|
|
(set! odd? (compile odd?))
|
|
''', self.g)
|
|
assert run('(even? 10)', self.g) == True
|
|
assert run('(odd? 10)', self.g) == False
|
|
|
|
def test_compile_tak(self):
|
|
old = sys.getrecursionlimit()
|
|
sys.setrecursionlimit(5000) # tak is not tail-recursive; compiled needs more frames
|
|
try:
|
|
r = self._compile_and_run('''
|
|
(define (tak x y z)
|
|
(if (>= y x) z
|
|
(tak (tak (- x 1) y z)
|
|
(tak (- y 1) z x)
|
|
(tak (- z 1) x y))))
|
|
''', '(tak 15 10 6)')
|
|
assert r == 10
|
|
finally:
|
|
sys.setrecursionlimit(old)
|
|
|
|
def test_compile_ackermann(self):
|
|
old = sys.getrecursionlimit()
|
|
sys.setrecursionlimit(5000)
|
|
try:
|
|
r = self._compile_and_run('''
|
|
(define (ack m n)
|
|
(cond ((= m 0) (+ n 1))
|
|
((= n 0) (ack (- m 1) 1))
|
|
(else (ack (- m 1) (ack m (- n 1))))))
|
|
''', '(ack 3 4)')
|
|
assert r == 125
|
|
finally:
|
|
sys.setrecursionlimit(old)
|
|
|
|
def test_compile_internal_defines(self):
|
|
r = self._compile_and_run('''
|
|
(define (f x)
|
|
(define a (* x 2))
|
|
(define b (+ a 1))
|
|
(+ a b))
|
|
''', '(f 5)')
|
|
assert r == 21
|
|
|
|
def test_compile_rest_args(self):
|
|
r = self._compile_and_run(
|
|
'(define (f x . rest) (cons x rest))',
|
|
'(f 1 2 3)')
|
|
assert show(r) == '(1 2 3)'
|
|
|
|
def test_compile_macro_expansion(self):
|
|
"""Macros should expand at compile time."""
|
|
r = self._compile_and_run('''
|
|
(define (f lst)
|
|
(while (pair? lst) (set! lst (cdr lst)))
|
|
lst)
|
|
''', "(f '(1 2 3))")
|
|
assert r is NIL
|
|
|
|
def test_auto_compile(self):
|
|
"""auto-compile! should compile defines automatically."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (sq x) (* x x))', self.g)
|
|
assert run('(compiled? sq)', self.g) == True
|
|
assert run('(sq 7)', self.g) == 49
|
|
run('(auto-compile! #f)', self.g)
|
|
run('(define (cube x) (* x x x))', self.g)
|
|
assert run('(compiled? cube)', self.g) == False
|
|
|
|
def test_auto_compile_lambda(self):
|
|
"""auto-compile! works for (define name (lambda ...))."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define double (lambda (x) (* x 2)))', self.g)
|
|
assert run('(compiled? double)', self.g) == True
|
|
assert run('(double 5)', self.g) == 10
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_disassemble(self):
|
|
"""disassemble should return without error."""
|
|
run('(define (f x) (+ x 1))', self.g)
|
|
run('(set! f (compile f))', self.g)
|
|
run('(disassemble f)', self.g) # should not raise
|
|
|
|
def test_auto_compile_tco(self):
|
|
"""Auto-compiled named-let should have proper TCO."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''(define (sum-to n)
|
|
(let loop ((i n) (acc 0))
|
|
(if (= i 0) acc (loop (- i 1) (+ acc i)))))''', self.g)
|
|
assert run('(sum-to 100000)', self.g) == 5000050000
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_full_continuation_upward(self):
|
|
"""Upward continuation: capture and invoke later."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''(define saved-k #f)
|
|
(define (capture) (call/cc (lambda (k) (set! saved-k k) (quote first))))''', self.g)
|
|
assert run('(capture)', self.g) == S('first')
|
|
assert run("(saved-k (quote second))", self.g) == S('second')
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_full_continuation_generator(self):
|
|
"""Generator pattern using full continuations."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''
|
|
(define (make-gen thunk)
|
|
(let ((k #f) (done #f))
|
|
(lambda ()
|
|
(if done (quote done)
|
|
(call/cc
|
|
(lambda (return)
|
|
(if k (k return)
|
|
(begin
|
|
(thunk (lambda (val)
|
|
(call/cc (lambda (next)
|
|
(set! k next)
|
|
(return val)))))
|
|
(set! done #t)
|
|
(return (quote done))))))))))
|
|
(define gen (make-gen (lambda (yield)
|
|
(yield 10) (yield 20) (yield 30))))
|
|
''', self.g)
|
|
assert run('(gen)', self.g) == 10
|
|
assert run('(gen)', self.g) == 20
|
|
assert run('(gen)', self.g) == 30
|
|
assert run('(gen)', self.g) == S('done')
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_constant_folding(self):
|
|
"""Compile-time constant folding for arithmetic."""
|
|
run('(auto-compile! #t)', self.g)
|
|
# (+ 1 2) should fold to 3 at compile time
|
|
run('(define (f) (+ 1 2))', self.g)
|
|
assert run('(f)', self.g) == 3
|
|
# Nested: (+ (* 3 4) 1) — inner folds, outer doesn't (different calls)
|
|
run('(define (g x) (+ x (* 3 4)))', self.g)
|
|
assert run('(g 1)', self.g) == 13
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_auto_compile_inline_lambda(self):
|
|
"""Inline lambdas should be compiled when auto-compile is on."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run("(define f (lambda (x) (* x 2)))", self.g)
|
|
assert run('(compiled? f)', self.g) == True
|
|
# Lambda in expression position
|
|
assert run('((lambda (x) (+ x 1)) 5)', self.g) == 6
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_specialized_opcodes_arithmetic(self):
|
|
"""Specialized opcodes for +, -, *, =, <, etc."""
|
|
self._compile_and_run('(define (f x y) (+ x y))', '(f 3 4)')
|
|
assert run('(f 3 4)', self.g) == 7
|
|
assert run('(f 1.5 2.5)', self.g) == 4.0
|
|
|
|
def test_specialized_opcodes_add1_sub1(self):
|
|
"""(+ x 1) → ADD1, (- x 1) → SUB1."""
|
|
self._compile_and_run(
|
|
'(define (inc x) (+ x 1))', '(inc 41)')
|
|
assert run('(inc 41)', self.g) == 42
|
|
self._compile_and_run(
|
|
'(define (dec x) (- x 1))', '(dec 43)')
|
|
assert run('(dec 43)', self.g) == 42
|
|
|
|
def test_specialized_opcodes_car_cdr_cons(self):
|
|
"""Specialized car, cdr, cons."""
|
|
self._compile_and_run(
|
|
'(define (hd lst) (car lst))', "(hd '(1 2 3))")
|
|
assert run("(hd '(1 2 3))", self.g) == 1
|
|
self._compile_and_run(
|
|
'(define (tl lst) (cdr lst))', "(tl '(1 2 3))")
|
|
assert show(run("(tl '(1 2 3))", self.g)) == '(2 3)'
|
|
self._compile_and_run(
|
|
'(define (pair a b) (cons a b))', '(pair 1 2)')
|
|
assert show(run('(pair 1 2)', self.g)) == '(1 . 2)'
|
|
|
|
def test_specialized_opcodes_predicates(self):
|
|
"""null?, pair?, not, zero?."""
|
|
self._compile_and_run(
|
|
"(define (f x) (null? x))", "(f '())")
|
|
assert run("(f '())", self.g) == True
|
|
assert run("(f '(1))", self.g) == False
|
|
|
|
def test_specialized_tail_position(self):
|
|
"""Specialized opcodes work in tail position."""
|
|
r = self._compile_and_run(
|
|
'(define (f x) (+ x 1))', '(f 99)')
|
|
assert r == 100
|
|
|
|
def test_string_set(self):
|
|
"""string-set! for mutable strings."""
|
|
run('(define s (string-copy "hello"))', self.g)
|
|
run('(string-set! s 0 #\\H)', self.g)
|
|
assert run('s', self.g) == "Hello"
|
|
|
|
def test_string_fill(self):
|
|
"""string-fill! fills a mutable string."""
|
|
run('(define s (make-string 3 #\\x))', self.g)
|
|
run('(string-fill! s #\\o)', self.g)
|
|
assert run('s', self.g) == "ooo"
|
|
|
|
|
|
###############################################################################
|
|
# Source Maps Tests
|
|
###############################################################################
|
|
|
|
class TestSourceMaps(unittest.TestCase):
|
|
"""Unit, integration, and functional tests for source map tracking."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
# ── Unit tests ──
|
|
|
|
def test_tokenize_lines_basic(self):
|
|
toks = _tokenize_lines("(+ 1 2)")
|
|
assert len(toks) == 5 # ( + 1 2 )
|
|
assert all(t[1] == 1 for t in toks)
|
|
|
|
def test_tokenize_lines_multiline(self):
|
|
src = "(define x\n 42)"
|
|
toks = _tokenize_lines(src)
|
|
# 'define' and 'x' on line 1, '42' on line 2
|
|
assert toks[0] == ('(', 1)
|
|
assert toks[1] == ('define', 1)
|
|
assert toks[2] == ('x', 1)
|
|
assert toks[3] == ('42', 2)
|
|
|
|
def test_pair_line_tracking(self):
|
|
exprs = read_all("(+ 1 2)\n(* 3 4)", track_lines=True)
|
|
assert isinstance(exprs[0], Pair)
|
|
assert exprs[0]._line == 1
|
|
assert exprs[1]._line == 2
|
|
|
|
def test_codeobj_source_map(self):
|
|
code = CodeObj(name='test')
|
|
code._cur_line = 5
|
|
code.emit(OP_CONST, 42)
|
|
code._cur_line = 6
|
|
code.emit(OP_RETURN)
|
|
assert code.source_map == [5, 6]
|
|
|
|
# ── Integration tests ──
|
|
|
|
def test_compiled_source_map(self):
|
|
"""Compiled code should have source map entries."""
|
|
run('(auto-compile! #t)', self.g)
|
|
# Multi-line define
|
|
src = '(define (f x)\n (+ x\n 1))'
|
|
for e in read_all(src, track_lines=True): leval(e, self.g)
|
|
f = self.g.lookup(S('f'))
|
|
assert isinstance(f, CompiledProc)
|
|
# source_map should have entries (at least some non-None)
|
|
assert any(line is not None for line in f.code.source_map)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_error_has_source_line(self):
|
|
"""Errors in compiled code should carry source line."""
|
|
run('(auto-compile! #t)', self.g)
|
|
src = '(define (boom)\n (car 42))'
|
|
for e in read_all(src, track_lines=True): leval(e, self.g)
|
|
try:
|
|
run('(boom)', self.g)
|
|
assert False, "should have raised"
|
|
except (LispErr, Exception):
|
|
pass # error raised, line info attached if available
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Functional tests ──
|
|
|
|
def test_load_tracks_lines(self):
|
|
"""Scripts loaded via _load should track line numbers."""
|
|
import tempfile, os
|
|
with tempfile.NamedTemporaryFile(mode='w', suffix='.lsp', delete=False) as f:
|
|
f.write('(define x 1)\n(define y 2)\n(+ x y)')
|
|
path = f.name
|
|
try:
|
|
from uncommonlisp import _load
|
|
env = fresh()
|
|
_load(path, env)
|
|
assert env.lookup(S('x')) == 1
|
|
assert env.lookup(S('y')) == 2
|
|
finally:
|
|
os.unlink(path)
|
|
|
|
|
|
###############################################################################
|
|
# Multi-shot Continuation Tests
|
|
###############################################################################
|
|
|
|
class TestMultiShotContinuations(unittest.TestCase):
|
|
"""Unit, integration, and functional tests for multi-shot continuations."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
# ── Unit tests ──
|
|
|
|
def test_deep_copy_env_independent(self):
|
|
"""Deep-copied env should be independent of original."""
|
|
parent = Env()
|
|
parent.g = parent
|
|
child = Env(parent)
|
|
child.define(S('x'), 1)
|
|
copy = _deep_copy_env(child)
|
|
copy.define(S('x'), 99)
|
|
assert child.lookup(S('x')) == 1 # original unchanged
|
|
assert copy.lookup(S('x')) == 99
|
|
|
|
def test_deep_copy_env_shares_global(self):
|
|
"""Deep copy should share global env (not copy builtins)."""
|
|
g = Env(); g.g = g
|
|
g.define(S('+'), 'plus_fn')
|
|
child = Env(g)
|
|
child.define(S('x'), 1)
|
|
copy = _deep_copy_env(child)
|
|
assert copy.g is g # global shared
|
|
assert copy.lookup(S('+')) == 'plus_fn'
|
|
|
|
def test_deep_copy_env_chain(self):
|
|
"""Deep copy should copy entire chain up to global."""
|
|
g = Env(); g.g = g
|
|
a = Env(g); a.define(S('a'), 1)
|
|
b = Env(a); b.define(S('b'), 2)
|
|
c = Env(b); c.define(S('c'), 3)
|
|
copy = _deep_copy_env(c)
|
|
# Mutate copy
|
|
copy.set(S('a'), 99)
|
|
assert a.lookup(S('a')) == 1 # original chain unaffected
|
|
|
|
# ── Integration tests ──
|
|
|
|
def test_multishot_counter(self):
|
|
"""Classic multi-shot test: continuation invoked twice, each sees original state."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''
|
|
(define saved #f)
|
|
(define (capture-state)
|
|
(let ((n 0))
|
|
(call/cc (lambda (k) (set! saved k)))
|
|
(set! n (+ n 1))
|
|
n))
|
|
''', self.g)
|
|
# First call captures continuation with n=0
|
|
r1 = run('(capture-state)', self.g)
|
|
assert r1 == 1 # n was 0, +1 = 1
|
|
# Invoke continuation — should see n=0 again (fresh copy)
|
|
r2 = run('(saved 42)', self.g)
|
|
assert r2 == 1 # n was 0 in the copied env, +1 = 1
|
|
# Third invocation — still sees n=0
|
|
r3 = run('(saved 42)', self.g)
|
|
assert r3 == 1
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_generator_multishot_safe(self):
|
|
"""Generator should work across multiple iterations."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''
|
|
(define (make-gen thunk)
|
|
(let ((k #f) (done #f))
|
|
(lambda ()
|
|
(if done (quote done)
|
|
(call/cc (lambda (return)
|
|
(if k (k return)
|
|
(begin (thunk (lambda (val)
|
|
(call/cc (lambda (next)
|
|
(set! k next) (return val)))))
|
|
(set! done #t) (return (quote done))))))))))
|
|
(define g (make-gen (lambda (yield) (yield 10) (yield 20))))
|
|
''', self.g)
|
|
assert run('(g)', self.g) == 10
|
|
assert run('(g)', self.g) == 20
|
|
assert run('(g)', self.g) == S('done')
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Functional tests ──
|
|
|
|
def test_multishot_no_state_leak(self):
|
|
"""Multiple continuation invocations should not leak state between them."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''
|
|
(define k-box #f)
|
|
(define (run-test)
|
|
(let ((x 0))
|
|
(let ((v (call/cc (lambda (k) (set! k-box k) 0))))
|
|
(set! x (+ x v))
|
|
x)))
|
|
''', self.g)
|
|
assert run('(run-test)', self.g) == 0
|
|
assert run('(k-box 10)', self.g) == 10
|
|
assert run('(k-box 20)', self.g) == 20 # fresh env, not 30
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# Inline Caching Tests
|
|
###############################################################################
|
|
|
|
class TestInlineCaching(unittest.TestCase):
|
|
"""Unit, integration, and functional tests for inline caching."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
# ── Unit tests ──
|
|
|
|
def test_lookup_returns_correct_value(self):
|
|
"""Cached lookups should return correct values."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (f) (+ 1 2))', self.g)
|
|
assert run('(f)', self.g) == 3
|
|
assert run('(f)', self.g) == 3 # second call uses cache
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_local_shadows_global(self):
|
|
"""Local bindings should override cached globals (non-specialized ops)."""
|
|
run('(auto-compile! #t)', self.g)
|
|
# Use a non-specialized function to test IC shadowing
|
|
run('(define (f x) (let ((string-length (lambda (s) 42))) (string-length "hello")))', self.g)
|
|
assert run('(f 0)', self.g) == 42
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_cache_correctness_in_loop(self):
|
|
"""IC should remain correct across loop iterations."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''(define (sum n)
|
|
(let loop ((i n) (acc 0))
|
|
(if (= i 0) acc (loop (- i 1) (+ acc i)))))''', self.g)
|
|
assert run('(sum 100)', self.g) == 5050
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Integration tests ──
|
|
|
|
def test_redefine_global(self):
|
|
"""Redefining a global should produce correct results despite cache."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define my-val 1)', self.g)
|
|
run('(define (get-val) my-val)', self.g)
|
|
assert run('(get-val)', self.g) == 1
|
|
run('(define my-val 2)', self.g)
|
|
assert run('(get-val)', self.g) == 2 # cache should see new value
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_mixed_compiled_interpreted(self):
|
|
"""IC should work when compiled code calls interpreted code."""
|
|
run('(define (interp-add x y) (+ x y))', self.g)
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (compiled-fn x) (interp-add x 10))', self.g)
|
|
assert run('(compiled-fn 5)', self.g) == 15
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Functional tests ──
|
|
|
|
def test_ic_with_higher_order(self):
|
|
"""IC should work correctly with higher-order functions."""
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (apply-twice f x) (f (f x)))', self.g)
|
|
assert run('(apply-twice (lambda (x) (+ x 1)) 0)', self.g) == 2
|
|
assert run('(apply-twice (lambda (x) (* x 2)) 3)', self.g) == 12
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# Bytecode Serialization Tests
|
|
###############################################################################
|
|
|
|
class TestBytecodeSerialization(unittest.TestCase):
|
|
"""Unit, integration, and functional tests for bytecode serialization."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
# ── Unit tests ──
|
|
|
|
def test_serialize_int(self):
|
|
assert _deserialize_operand(_serialize_operand(42)) == 42
|
|
|
|
def test_serialize_float(self):
|
|
assert _deserialize_operand(_serialize_operand(3.14)) == 3.14
|
|
|
|
def test_serialize_float_inf(self):
|
|
import math
|
|
v = _deserialize_operand(_serialize_operand(math.inf))
|
|
assert math.isinf(v) and v > 0
|
|
|
|
def test_serialize_fraction(self):
|
|
f = Fraction(1, 3)
|
|
assert _deserialize_operand(_serialize_operand(f)) == f
|
|
|
|
def test_serialize_symbol(self):
|
|
s = S('hello')
|
|
r = _deserialize_operand(_serialize_operand(s))
|
|
assert isinstance(r, Symbol) and str(r) == 'hello'
|
|
|
|
def test_serialize_string(self):
|
|
assert _deserialize_operand(_serialize_operand("hello")) == "hello"
|
|
|
|
def test_serialize_bool(self):
|
|
assert _deserialize_operand(_serialize_operand(True)) is True
|
|
assert _deserialize_operand(_serialize_operand(False)) is False
|
|
|
|
def test_serialize_nil(self):
|
|
assert _deserialize_operand(_serialize_operand(NIL)) is NIL
|
|
|
|
def test_serialize_pair(self):
|
|
p = Pair(1, Pair(2, NIL))
|
|
r = _deserialize_operand(_serialize_operand(p))
|
|
assert isinstance(r, Pair) and r.car == 1 and r.cdr.car == 2
|
|
|
|
def test_serialize_vector(self):
|
|
v = [1, 2, 3]
|
|
r = _deserialize_operand(_serialize_operand(v))
|
|
assert r == [1, 2, 3]
|
|
|
|
def test_serialize_codeobj(self):
|
|
code = CodeObj(name='test')
|
|
code.instrs = [(OP_CONST, 42), (OP_RETURN, None)]
|
|
code.source_map = [1, 1]
|
|
data = _serialize_code(code)
|
|
restored = _deserialize_code(data)
|
|
assert restored.name == 'test'
|
|
assert len(restored.instrs) == 2
|
|
assert restored.instrs[0] == (OP_CONST, 42)
|
|
|
|
# ── Integration tests ──
|
|
|
|
def test_round_trip_compiled_proc(self):
|
|
"""Compile, serialize, deserialize, run — should produce same result."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (sq x) (* x x))', self.g)
|
|
f = self.g.lookup(S('sq'))
|
|
path = tempfile.mktemp(suffix='.lspc')
|
|
try:
|
|
save_compiled(path, f)
|
|
loaded = load_compiled(path, self.g)
|
|
assert isinstance(loaded, CompiledProc)
|
|
self.g.define(S('sq2'), loaded)
|
|
assert run('(sq2 7)', self.g) == 49
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_round_trip_with_closure(self):
|
|
"""Compiled proc with inner closures should serialize correctly."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (make-adder n) (lambda (x) (+ x n)))', self.g)
|
|
f = self.g.lookup(S('make-adder'))
|
|
path = tempfile.mktemp(suffix='.lspc')
|
|
try:
|
|
save_compiled(path, f)
|
|
loaded = load_compiled(path, self.g)
|
|
self.g.define(S('make-adder2'), loaded)
|
|
assert run('((make-adder2 10) 5)', self.g) == 15
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_round_trip_with_cond(self):
|
|
"""Proc using cond should serialize and run correctly."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''(define (classify n)
|
|
(cond ((< n 0) (quote negative)) ((= n 0) (quote zero)) (else (quote positive))))''', self.g)
|
|
f = self.g.lookup(S('classify'))
|
|
path = tempfile.mktemp(suffix='.lspc')
|
|
try:
|
|
save_compiled(path, f)
|
|
loaded = load_compiled(path, self.g)
|
|
self.g.define(S('classify2'), loaded)
|
|
assert run('(classify2 -1)', self.g) == S('negative')
|
|
assert run('(classify2 0)', self.g) == S('zero')
|
|
assert run('(classify2 1)', self.g) == S('positive')
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Functional tests ──
|
|
|
|
def test_compile_flag(self):
|
|
"""--compile flag should produce a .lspc file."""
|
|
import tempfile, os, subprocess
|
|
with tempfile.NamedTemporaryFile(mode='w', suffix='.lsp', delete=False) as f:
|
|
f.write('(define (double x) (* x 2))\n')
|
|
path = f.name
|
|
lspc = path.rsplit('.', 1)[0] + '.lspc'
|
|
try:
|
|
result = subprocess.run(
|
|
['python3', 'uncommonlisp.py', '--compile', path],
|
|
capture_output=True, text=True, timeout=30)
|
|
assert result.returncode == 0
|
|
assert os.path.exists(lspc)
|
|
assert 'compiled' in result.stdout.lower()
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
if os.path.exists(lspc): os.unlink(lspc)
|
|
|
|
def test_save_load_builtins(self):
|
|
"""save-compiled / load-compiled builtins from Scheme."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (cube x) (* x x x))', self.g)
|
|
path = tempfile.mktemp(suffix='.lspc')
|
|
try:
|
|
run(f'(save-compiled "{path}" cube)', self.g)
|
|
run(f'(define cube2 (load-compiled "{path}"))', self.g)
|
|
assert run('(cube2 3)', self.g) == 27
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
|
|
###############################################################################
|
|
# Portal Tests
|
|
###############################################################################
|
|
|
|
class TestPortal(unittest.TestCase):
|
|
"""Unit, integration, and functional tests for portal (machine state transfer)."""
|
|
|
|
def setUp(self):
|
|
self.g = fresh()
|
|
|
|
# ── Unit tests ──
|
|
|
|
def test_portal_serialize_env(self):
|
|
"""Env serialization round-trips correctly."""
|
|
import tempfile, os
|
|
run('(define x 42)', self.g)
|
|
run('(define lst (list 1 2 3))', self.g)
|
|
path = tempfile.mktemp(suffix='.portal')
|
|
try:
|
|
portal_save(self.g, path)
|
|
g2 = fresh()
|
|
env2, _ = portal_resume(path, g2)
|
|
assert env2.lookup(S('x')) == 42
|
|
assert show(env2.lookup(S('lst'))) == '(1 2 3)'
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
|
|
def test_portal_serialize_compiled_proc(self):
|
|
"""Compiled procedures survive portal round-trip."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('(define (sq x) (* x x))', self.g)
|
|
path = tempfile.mktemp(suffix='.portal')
|
|
try:
|
|
portal_save(self.g, path)
|
|
g2 = fresh()
|
|
env2, _ = portal_resume(path, g2)
|
|
sq = env2.lookup(S('sq'))
|
|
assert isinstance(sq, CompiledProc)
|
|
assert run('(sq 7)', env2) == 49
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_portal_serialize_hash_table(self):
|
|
"""Hash tables survive portal round-trip."""
|
|
import tempfile, os
|
|
run('(define h (make-hash-table))', self.g)
|
|
run('(hash-table-set! h (quote a) 1)', self.g)
|
|
run('(hash-table-set! h (quote b) 2)', self.g)
|
|
path = tempfile.mktemp(suffix='.portal')
|
|
try:
|
|
portal_save(self.g, path)
|
|
g2 = fresh()
|
|
env2, _ = portal_resume(path, g2)
|
|
h = env2.lookup(S('h'))
|
|
assert isinstance(h, dict)
|
|
assert h[S('a')] == 1
|
|
assert h[S('b')] == 2
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
|
|
# ── Integration tests ──
|
|
|
|
def test_portal_continuation_resume(self):
|
|
"""Continuation saved mid-computation resumes correctly."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
# count-to with checkpoint at i=5
|
|
run('''(define (count-to n)
|
|
(let loop ((i 0))
|
|
(when (= i 5) (portal-checkpoint! "__test_cp.portal"))
|
|
(if (= i n) i (loop (+ i 1)))))''', self.g)
|
|
result = run('(count-to 10)', self.g)
|
|
assert result == 10
|
|
path = "__test_cp.portal"
|
|
try:
|
|
assert os.path.exists(path)
|
|
g2 = fresh()
|
|
env2, cont = portal_resume(path, g2)
|
|
assert cont is not None
|
|
result2 = _cont_resume(_ContInvoked(cont, VOID))
|
|
assert result2 == 10 # same result from resumed computation
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
def test_portal_prime_check(self):
|
|
"""Prime checker with checkpoint produces correct result after resume."""
|
|
import tempfile, os
|
|
run('(auto-compile! #t)', self.g)
|
|
run('''(define (prime? n)
|
|
(let loop ((i 2))
|
|
(cond ((> (* i i) n) #t)
|
|
((= (remainder n i) 0) #f)
|
|
(else
|
|
(when (= (remainder i 100) 0)
|
|
(portal-checkpoint! "__test_prime.portal"))
|
|
(loop (+ i 1))))))''', self.g)
|
|
# 10007 is prime, sqrt ≈ 100, will trigger checkpoint at i=100
|
|
result = run('(prime? 10007)', self.g)
|
|
assert result is True
|
|
path = "__test_prime.portal"
|
|
try:
|
|
if os.path.exists(path):
|
|
g2 = fresh()
|
|
env2, cont = portal_resume(path, g2)
|
|
if cont:
|
|
result2 = _cont_resume(_ContInvoked(cont, VOID))
|
|
assert result2 is True
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
run('(auto-compile! #f)', self.g)
|
|
|
|
# ── Functional tests ──
|
|
|
|
def test_portal_cli_resume(self):
|
|
"""--portal-resume flag works from command line."""
|
|
import tempfile, os, subprocess
|
|
run('(define answer 42)', self.g)
|
|
path = tempfile.mktemp(suffix='.portal')
|
|
try:
|
|
portal_save(self.g, path)
|
|
result = subprocess.run(
|
|
['python3', 'uncommonlisp.py', '--portal-resume', path,
|
|
'-e', '(display answer)'],
|
|
capture_output=True, text=True, timeout=30)
|
|
# portal-resume loads state, then -e isn't processed (portal-resume returns)
|
|
# just verify no crash
|
|
assert result.returncode == 0
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
|
|
def test_portal_file_format(self):
|
|
"""Portal file is valid JSON with expected structure."""
|
|
import tempfile, os, json
|
|
run('(define x 1)', self.g)
|
|
path = tempfile.mktemp(suffix='.portal')
|
|
try:
|
|
portal_save(self.g, path)
|
|
with open(path) as f:
|
|
data = json.load(f)
|
|
assert data['format'] == 'uncommonlisp-portal-v1'
|
|
assert 'objects' in data
|
|
assert 'env' in data
|
|
finally:
|
|
if os.path.exists(path): os.unlink(path)
|
|
|
|
|
|
###############################################################################
|
|
# Main
|
|
###############################################################################
|
|
|
|
if __name__ == '__main__':
|
|
unittest.main(verbosity=2 if '-v' in sys.argv else 1)
|