interpl

Experiments with intepreters in Prolog
git clone https://ccx.te2000.cz/git/interpl
Log | Files | Refs | README

tests.pl (5130B)


      1 :- use_module(library(debug), [assertion/1]).
      2 
      3 :- use_module(interpreter).
      4 
      5 portray_long :- portray_depth(32).
      6 portray_depth(Depth) :-
      7 	set_prolog_flag(answer_write_options, [quoted(true), portrayed(true), max_depth(Depth), spacing(next_argument)]),
      8 	set_prolog_flag(debugger_write_options, [quoted(true), portrayed(true), max_depth(Depth), spacing(next_argument)]).
      9 
     10 test_one_result(Template, Goal, Output) :-
     11 	findall(Template, Goal, Results),
     12 	% write(Results), nl,
     13 	assertion(length(Results, 1)),
     14 	Results = [Output].
     15 
     16 decode(Codes, Expression) :-
     17 	test_one_result(E, parse_input_expression(Codes, E), Expression).
     18 
     19 :- begin_tests(errors).
     20 %:- use_module('$messages', [message_to_string/2]).
     21 test(read_error) :-
     22 	message_to_string(error(read_error, _), Message),
     23 	assertion(Message =@= "Failed to read line.").
     24 :- end_tests(errors).
     25 :- begin_tests(sexp).
     26 
     27 test(sexp_atom) :-
     28 	decode(`a`, Expression),
     29 	assertion(Expression =@= a).
     30 
     31 test(sexp_atom2) :-
     32 	decode(`hello-world!`, Expression),
     33 	assertion(Expression =@= 'hello-world!').
     34 
     35 test(sexp_number) :-
     36 	decode(`0`, Expression),
     37 	assertion(Expression =@= 0).
     38 
     39 test(sexp_number2) :-
     40 	decode(`31337`, Expression),
     41 	assertion(Expression =@= 31337).
     42 
     43 test(sexp_list_empty) :-
     44 	decode(`()`, Expression),
     45 	assertion(Expression =@= []).
     46 
     47 test(sexp_list_one_atom) :-
     48 	decode(`(a)`, Expression),
     49 	assertion(Expression =@= [a]).
     50 
     51 test(sexp_list_one_two_atoms) :-
     52 	decode(`(a b)`, Expression),
     53 	assertion(Expression =@= [a, b]).
     54 
     55 test(sexp_def) :-
     56 	decode(`(define proc (lambda (e f g) (lambda () e)))`, Expression),
     57 	assertion(Expression =@= [define, proc, [lambda, [e, f, g], [lambda, [], e]]]).
     58 
     59 test(sexp_qq) :-
     60 	Expression = {|sexp||(define proc (lambda (e f g) (lambda () e)))|},
     61 	assertion(Expression =@= [define, proc, [lambda, [e, f, g], [lambda, [], e]]]).
     62 
     63 :- end_tests(sexp).
     64 
     65 apply_example(car, [{|sexp||(a b c)|}], {|sexp||a|}).
     66 apply_example(car, [{|sexp||((a b c) x y z)|}], {|sexp||(a b c)|}).
     67 apply_example(car, [{|sexp||(((hotdogs)) (and) (pickle) relish)|}], {|sexp||((hotdogs))|}).
     68 apply_example(car, [{|sexp||((hotdogs))|}], {|sexp||(hotdogs)|}).
     69 
     70 apply_example(cdr, [{|sexp||(a b c)|}], {|sexp||(b c)|}).
     71 apply_example(cdr, [{|sexp||((a b c) x y z)|}], {|sexp||(x y z)|}).
     72 apply_example(cdr, [{|sexp||(hamburger)|}], {|sexp||()|}).
     73 apply_example(cdr, [{|sexp||((x) t r)|}], {|sexp||(t r)|}).
     74 
     75 apply_example(Func, Args, ExpectedResult) :-
     76 	apply_example(CallCs, ResultCs),
     77 	decode(CallCs, [Func|Args]),
     78 	decode(ResultCs, ExpectedResult).
     79 
     80 apply_example(`(cons peanut (butter and jelly))`,
     81               `(peanut butter and jelly)`).
     82 
     83 apply_example(`(cons ((help) this) (is very ((hard) to learn)))`,
     84               `(((help) this) is very ((hard) to learn))`).
     85 
     86 apply_example(`(cons (a b (c)) ())`, `((a b (c)))`).
     87 
     88 apply_example(`(+ 0 0)`, `0`).
     89 apply_example(`(+ 3 2)`, `5`).
     90 
     91 :- begin_tests(primitive_apply).
     92 test(apply_example, [forall(apply_example(Func, Args, ExpectedResult))]) :-
     93 	initial_state(State0),
     94 	primitive_arity(Func, Arity),
     95 	interp_apply(primitive(Func, Arity), Args, Result, State0, _State1),
     96 	assertion(Result =@= ExpectedResult).
     97 
     98 test(apply_arity_error, [error(interp_error(arity, car))]) :-
     99 	Func=car,
    100 	initial_state(State0),
    101 	primitive_arity(Func, Arity),
    102 	interp_apply(primitive(Func, Arity), [[a], [b]], _Result, State0, _State1).
    103 
    104 :- end_tests(primitive_apply).
    105 :- begin_tests(eval).
    106 
    107 quoted_args([], []).
    108 quoted_args([H|T], [[quote, H]|QT]) :- quoted_args(T, QT).
    109 
    110 test_eval(Call, ExpectedResult) :-
    111 	initial_state(State0),
    112 	test_eval(Call, ExpectedResult, State0, _State1).
    113 test_eval(Call, ExpectedResult, State0, State1) :-
    114 	format('testing call: ~w  → expecting ~w  |  ~w~n', [Call, ExpectedResult, State0]),
    115 	interp_eval(Call, Result, State0, State1),
    116 	assertion(Result =@= ExpectedResult).
    117 
    118 eval_example(`(car (cdr (quote ((b) (x y) ((c))))))`, `(x y)`).
    119 eval_example(`(cdr (cdr (quote ((b) (x y) ((c))))))`, `(((c)))`).
    120 
    121 eval_example_decoded(Call, ExpectedResult) :-
    122 	eval_example(CallCodes, ResultCodes),
    123 	decode(CallCodes, Call),
    124 	decode(ResultCodes, ExpectedResult).
    125 
    126 test(eval_quote) :-
    127 	test_eval({|sexp||(quote a)|}, a).
    128 
    129 test(eval_quote2) :-
    130 	test_eval({|sexp||(quote ())|}, []).
    131 
    132 test(eval_apply_example, [forall(apply_example(Func, Args, ExpectedResult))]) :-
    133 	quoted_args(Args, QArgs),
    134 	Call = [Func|QArgs],
    135 	test_eval(Call, ExpectedResult).
    136 
    137 test(eval_example, [forall(eval_example_decoded(Call, ExpectedResult))]) :-
    138 	test_eval(Call, ExpectedResult).
    139 
    140 eval_define_lat :-
    141 	DefLat = {|sexp||
    142 (define lat?
    143   (lambda (l)
    144     (cond
    145       ((null? l) #t)
    146       ((atom? (car l)) (lat? (cdr l)))
    147       (else #f))))|},
    148 	initial_state(State0),
    149 	interp_eval(DefLat, _, State0, State1),
    150 	lookup_variable_value('lat?', Proc, State1, _),
    151 	assertion(Proc = proc([l], _, _)),
    152 	Call0 = {|sexp||(lat? (quote ()))|},
    153 	test_eval(Call0, '#t', State1, _),
    154 	Call1 = {|sexp||(lat? (quote (Jack Sprat could eat no chicken fat)))|},
    155 	test_eval(Call1, '#t', State1, _),
    156 	Call2 = {|sexp||(lat? (quote ((Jack) Sprat could eat no chicken fat)))|},
    157 	test_eval(Call2, '#f', State1, _).
    158 test(eval_define_lat) :- eval_define_lat.
    159 
    160 :- end_tests(eval).