#define epsilon 2.2204460492503131E-16 #define testresult int #define pass 1 #define fail 0 #define print_assert_equal_fail(variable, value, type, format) \ printf("\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) \ printf("\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"); \ log_error(); \ 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_double(variable, value) \ if (fabs((double)variable - (double)value) > epsilon) { \ print_assert_equal_fail(variable, value, double, "%f"); \ return fail; \ } #define assert_not_equal_double(variable, value) \ if (fabs((double)variable - (double)value) <= epsilon) { \ print_assert_not_equal_fail(variable, value, double, "%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 (Memory::get_type(node) != _type) { \ print_assert_equal_fail( \ Lisp_Object_Type_to_string(Memory::get_type(node)), \ Lisp_Object_Type_to_string(_type), char*, "%s"); \ 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(int 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(int 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.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.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.append(1); list.append(2); list.append(3); list.append(4); int 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_eval_operands() -> testresult { char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; Lisp_Object* operands = Parser::parse_single_expression(operands_string); try operands = eval_arguments(operands); assert_no_error(); assert_equal_int(list_length(operands), 4); assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); assert_equal_double(operands->value.pair.first->value.number, 1); operands = operands->value.pair.rest; assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Number); assert_equal_double(operands->value.pair.first->value.number, 3); operands = operands->value.pair.rest; assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::String); assert_equal_string(operands->value.pair.first->value.string, "okay"); operands = operands->value.pair.rest; assert_equal_type(operands, Lisp_Object_Type::Pair); assert_equal_type(operands->value.pair.first, Lisp_Object_Type::Keyword); assert_equal_string(operands->value.pair.first->value.symbol, "haha"); return pass; } proc test_parse_atom() -> testresult { int 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_double(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_double(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 { int 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_double(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_built_in_add() -> testresult { 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_double(result->value.number, 14); return pass; } proc test_built_in_substract() -> testresult { 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_double(result->value.number, 6); return pass; } proc test_built_in_multiply() -> testresult { 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_double(result->value.number, 40); return pass; } proc test_built_in_divide() -> testresult { 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_double(result->value.number, 5); return pass; } proc test_built_in_if() -> testresult { 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_double(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_double(result->value.number, 5); return pass; } proc test_built_in_and() -> testresult { 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); return pass; } proc test_built_in_or() -> testresult { 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); return pass; } proc test_built_in_not() -> testresult { 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); return pass; } proc test_built_in_type() -> testresult { // Environment* env; // try env = get_root_environment(); // 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"); // // trying to set invalid user type // char exp_string3[] = "(begin (set-type! a \"wrong tpye\")(type a))"; // expression = Parser::parse_single_expression(exp_string3); // assert_no_error(); // ignore_logging { // dont_break_on_errors { // result = eval_expr(expression); // } // } // assert_error(); // delete_error(); // 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_or_create_lisp_object_symbol("aa"); auto cc_s_aa2 = Memory::get_or_create_lisp_object_symbol("aa2"); auto s_s_aa = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa")); auto s_s_aa2 = Memory::get_or_create_lisp_object_symbol(Memory::create_string("aa2")); 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 { Memory::reset(); assert_no_error(); Environment* root_env = get_root_environment(); Environment* user_env = Memory::create_child_environment(root_env); assert_no_error(); push_environment(user_env); defer { pop_environment(); }; try built_in_load(Memory::create_string(file)); assert_no_error(); return pass; } proc run_all_tests() -> bool { bool result = true; try Memory::init(409600); 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-- Basic evaluating --\n"); invoke_test(test_eval_operands); printf("\n-- Built ins --\n"); invoke_test(test_built_in_add); invoke_test(test_built_in_substract); invoke_test(test_built_in_multiply); invoke_test(test_built_in_divide); invoke_test(test_built_in_if); invoke_test(test_built_in_and); invoke_test(test_built_in_or); invoke_test(test_built_in_not); invoke_test(test_built_in_type); printf("\n-- Memory management --\n"); invoke_test(test_singular_t_and_nil); invoke_test(test_singular_symbols); printf("\n-- Test Files --\n"); invoke_test_script("evaluation_of_default_args"); invoke_test_script("alists"); invoke_test_script("case_and_cond"); invoke_test_script("lexical_scope"); invoke_test_script("class_macro"); invoke_test_script("import_and_load"); invoke_test_script("macro_expand"); invoke_test_script("automata"); invoke_test_script("sicp"); invoke_test_script("hashmaps"); invoke_test_script("singular_imports"); // // Memory::print_status(); 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_double #undef assert_not_equal_double #undef assert_equal_string #undef assert_equal_type #undef assert_null #undef assert_not_null #undef invoke_test #undef invoke_test_script