namespace Slime { typedef s32 testresult; #define epsilon 2.2204460492503131E-16 #define pass 1 #define fail 0 #define print_assert_equal_fail(variable, value, type, format) \ print("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ "\n\texpected: " format \ "\n\tgot: " format "\n", \ __FILE__, __LINE__, (type)value, (type)variable) #define print_assert_not_equal_fail(variable, value, type, format) \ print("\n%s:%d: Assertion failed\n\tfor '" #variable "'" \ "\n\texpected not: " format \ "\n\tgot anyways: " format "\n", \ __FILE__, __LINE__, (type)value, (type)variable) #define assert_equal_int(variable, value) \ if (variable != value) { \ print_assert_equal_fail(variable, value, size_t, "%zd"); \ return fail; \ } #define assert_not_equal_int(variable, value) \ if (variable == value) { \ print_assert_not_equal_fail(variable, value, size_t, "%zd"); \ return fail; \ } #define assert_no_error() \ if (Globals::error) { \ print_assert_equal_fail(Globals::error, 0, size_t, "%zd"); \ printf("\nExpected no error to occur," \ " but an error occured anyways:\n"); \ return fail; \ } \ #define assert_error() \ if (!Globals::error) { \ print_assert_not_equal_fail(Globals::error, 0, size_t, "%zd"); \ printf("\nExpected an error to occur," \ " but no error occured:\n"); \ return fail; \ } \ #define assert_equal_f64(variable, value) \ if (fabsl((f64)variable - (f64)value) > epsilon) { \ print_assert_equal_fail(variable, value, f64, "%Lf"); \ return fail; \ } #define assert_not_equal_f64(variable, value) \ if (fabsl((f64)variable - (f64)value) <= epsilon) { \ print_assert_not_equal_fail(variable, value, f64, "L%f"); \ return fail; \ } #define assert_equal_string(variable, value) \ if (!string_equal(variable, value)) { \ print_assert_equal_fail(variable.data, value, char*, "%s"); \ return fail; \ } #define assert_equal_type(node, _type) \ if (node->type != _type) { \ print_assert_equal_fail(node->type, _type, Lisp_Object_Type, \ "%{l_o_t}"); \ return fail; \ } \ #define assert_null(variable) \ assert_equal_int(variable, nullptr) #define assert_not_null(variable) \ assert_not_equal_int(variable, nullptr) #define invoke_test(name) \ fputs("" #name ":", stdout); \ if (name() == pass) { \ for(size_t i = strlen(#name); i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_green "passed\n" console_normal, stdout); \ } \ else { \ result = false; \ for(s32 i = -1; i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_red "failed\n" console_normal, stdout); \ if(Globals::error) { \ free(Globals::error); \ Globals::error = nullptr; \ } \ } \ #define invoke_test_script(name) \ fputs("" name ":", stdout); \ if (test_file("tests/" name ".slime") == pass) { \ for(size_t i = strlen(name); i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_green "passed\n" console_normal, stdout); \ } \ else { \ result = false; \ for(s32 i = -1; i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_red "failed\n" console_normal, stdout); \ if(Globals::error) { \ free(Globals::error); \ Globals::error = nullptr; \ } \ } proc test_array_lists_adding_and_removing() -> testresult { // test adding and removing Array_List list; list.alloc(); defer { list.dealloc(); }; list.append(1); list.append(2); list.append(3); list.append(4); assert_equal_int(list.next_index, 4); list.remove_index(0); assert_equal_int(list.next_index, 3); assert_equal_int(list[0], 4); assert_equal_int(list[1], 2); assert_equal_int(list[2], 3); list.remove_index(2); assert_equal_int(list.next_index, 2); assert_equal_int(list[0], 4); assert_equal_int(list[1], 2); return pass; } proc test_array_lists_sorting() -> testresult { // test adding and removing Array_List list; list.alloc(); defer { list.dealloc(); }; list.append(1); list.append(2); list.append(3); list.append(4); list.sort(); assert_equal_int(list.next_index, 4); assert_equal_int(list[0], 1); assert_equal_int(list[1], 2); assert_equal_int(list[2], 3); assert_equal_int(list[3], 4); list.append(0); list.append(5); assert_equal_int(list.next_index, 6); list.sort(); assert_equal_int(list[0], 0); assert_equal_int(list[1], 1); assert_equal_int(list[2], 2); assert_equal_int(list[3], 3); assert_equal_int(list[4], 4); assert_equal_int(list[5], 5); return pass; } proc test_array_lists_searching() -> testresult { Array_List list; list.alloc(); defer { list.dealloc(); }; list.append(1); list.append(2); list.append(3); list.append(4); s32 index = list.sorted_find(3); assert_equal_int(index, 2); index = list.sorted_find(1); assert_equal_int(index, 0); index = list.sorted_find(5); assert_equal_int(index, -1); return pass; } proc test_parse_atom() -> testresult { u32 index_in_text = 0; char string[] = "123 -1.23e-2 " // numbers "\"asd\" " // strings ":key1 :key:2 " // keywords "sym +"; // symbols // test numbers Lisp_Object* result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 123); ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, -1.23e-2); // test strings ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::String); assert_equal_string(result->value.string, "asd"); // test keywords ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.symbol, "key1"); ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.symbol, "key:2"); // test symbols ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_string(result->value.symbol, "sym"); ++index_in_text; result = Parser::parse_atom(string, &index_in_text); assert_equal_type(result, Lisp_Object_Type::Symbol); assert_equal_string(result->value.symbol, "+"); return pass; } proc test_parse_expression() -> testresult { u32 index_in_text = 0; char string[] = "(fun + 12)"; Lisp_Object* result = Parser::parse_expression(string, &index_in_text); assert_no_error(); assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_string(result->value.pair.first->value.symbol, "fun"); result = result->value.pair.rest; assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_string(result->value.pair.first->value.symbol, "+"); result = result->value.pair.rest; assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number); assert_equal_f64(result->value.pair.first->value.number, 12); result = result->value.pair.rest; assert_equal_type(result, Lisp_Object_Type::Nil); char string2[] = "(define fun (lambda (x) (+ 5 (* x x ))))"; index_in_text = 0; result = Parser::parse_expression(string2, &index_in_text); assert_no_error(); assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_string(result->value.pair.first->value.symbol, "define"); result = result->value.pair.rest; assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_string(result->value.pair.first->value.symbol, "fun"); result = result->value.pair.rest; assert_equal_type(result, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first, Lisp_Object_Type::Pair); assert_equal_type(result->value.pair.first->value.pair.first, Lisp_Object_Type::Symbol); assert_equal_string(result->value.pair.first->value.pair.first->value.symbol, "lambda"); result = result->value.pair.rest; return pass; } proc test_string_copy() -> testresult { Lisp_Object* str = Memory::create_lisp_object("Hello World"); Lisp_Object* cpy = Memory::copy_lisp_object(str); assert_not_equal_int(str, cpy); assert_not_equal_int(str->value.string.data, cpy->value.string.data); return pass; } proc test_simple_stuff() -> testresult { { // built in add char exp_string[] = "(+ 10 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 14); } { // built in subtract char exp_string[] = "(- 10 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 6); } { // built in multiply char exp_string[] = "(* 10 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 40); } { // built in divide char exp_string[] = "(/ 20 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 5); } { // built in if char exp_string1[] = "(if 1 4 5)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 4); char exp_string2[] = "(if () 4 5)"; expression = Parser::parse_single_expression(exp_string2); try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); assert_equal_f64(result->value.number, 5); } { // built in and char exp_string1[] = "(and 1 \"asd\" 4)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::T); // a false case char exp_string2[] = "(and () \"asd\" 4)"; expression = Parser::parse_single_expression(exp_string2); try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Nil); } { // built in or char exp_string1[] = "(or \"asd\" nil)"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::T); // a false case char exp_string2[] = "(or () ())"; expression = Parser::parse_single_expression(exp_string2); try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Nil); } { // buit in not char exp_string1[] = "(not ())"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result; try result = eval_expr(expression); // a true case assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::T); // a false case char exp_string2[] = "(not \"asd xD\")"; expression = Parser::parse_single_expression(exp_string2); try result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Nil); } { // built in type // normal type testing char exp_string1[] = "(begin (define a 10)(type a))"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.symbol, "number"); // setting user type char exp_string2[] = "(begin (set-type! a :my-type)(type a))"; expression = Parser::parse_single_expression(exp_string2); result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.symbol, "my-type"); // deleting user type char exp_string4[] = "(begin (delete-type! a)(type a))"; expression = Parser::parse_single_expression(exp_string4); result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.symbol, "number"); } return pass; } proc test_singular_t_and_nil() -> testresult { // nil testing char exp_string1[] = "()"; char exp_string2[] = "nil"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result = eval_expr(expression); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Nil); assert_equal_int(expression, result); Lisp_Object* expression2 = Parser::parse_single_expression(exp_string2); Lisp_Object* result2 = eval_expr(expression2); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Nil); assert_equal_int(result, result2); assert_equal_int(expression, Memory::nil); // t testing char exp_string3[] = "t"; Lisp_Object* expression3 = Parser::parse_single_expression(exp_string3); Lisp_Object* result3 = eval_expr(expression3); assert_no_error(); assert_not_null(result3); return pass; } proc test_singular_symbols() -> testresult { auto cc_s_aa = Memory::get_symbol("aa"); auto cc_s_aa2 = Memory::get_symbol("aa2"); String s1 = Memory::create_string("aa"); String s2 = Memory::create_string("aa2"); auto s_s_aa = Memory::get_symbol(s1); auto s_s_aa2 = Memory::get_symbol(s2); free(s1.data); free(s2.data); assert_equal_int(cc_s_aa, s_s_aa); assert_equal_int(cc_s_aa2, s_s_aa2); assert_not_equal_int(cc_s_aa, cc_s_aa2); return pass; } proc test_file(const char* file) -> testresult { profile_with_name(file); push_environment(Memory::create_child_environment(get_current_environment())); String name = Memory::create_string(file); built_in_load(name); free(name.data); assert_no_error(); pop_environment(); return pass; } proc run_all_tests() -> bool { profile_this(); bool result = true; push_environment(Memory::create_child_environment( get_current_environment())); printf("-- Util --\n"); invoke_test(test_array_lists_adding_and_removing); invoke_test(test_array_lists_sorting); invoke_test(test_array_lists_searching); printf("\n -- Parsing --\n"); invoke_test(test_parse_atom); invoke_test(test_parse_expression); printf("\n-- Built ins --\n"); invoke_test(test_simple_stuff); invoke_test(test_string_copy); printf("\n-- Memory management --\n"); invoke_test(test_singular_t_and_nil); invoke_test(test_singular_symbols); pop_environment(); printf("\n-- Test Files --\n"); invoke_test_script("regression"); invoke_test_script("continuations"); invoke_test_script("evaluation_of_default_args"); invoke_test_script("case_and_cond"); invoke_test_script("lexical_scope"); invoke_test_script("singular_imports"); invoke_test_script("hashmaps"); invoke_test_script("import_and_load"); invoke_test_script("macro_expand"); invoke_test_script("sicp"); invoke_test_script("simple_built_ins"); invoke_test_script("modules"); invoke_test_script("class_macro"); invoke_test_script("automata"); invoke_test_script("alists"); return result; } #undef epsilon #undef testresult #undef pass #undef fail #undef print_assert_equal_fail #undef print_assert_not_equal_fail #undef assert_no_error #undef assert_equal_int #undef assert_not_equal_int #undef assert_equal_f64 #undef assert_not_equal_f64 #undef assert_equal_string #undef assert_equal_type #undef assert_null #undef assert_not_null #undef invoke_test #undef invoke_test_script }