#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_eval_operands() -> testresult { char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; Lisp_Object* operands = Parser::parse_single_expression(operands_string); int operands_length; operands = eval_arguments(operands, Memory::create_built_ins_environment(), &operands_length); 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.identifier, "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.identifier, "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.identifier, "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.identifier, "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.identifier, "+"); 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.identifier, "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.identifier, "+"); 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.identifier, "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.identifier, "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.identifier, "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 = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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); result = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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); result = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); 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); result = eval_expr(expression, Memory::create_built_ins_environment()); 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 = eval_expr(expression, Memory::create_built_ins_environment()); // 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); result = eval_expr(expression, Memory::create_built_ins_environment()); 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 = Memory::create_built_ins_environment(); // normal type testing char exp_string1[] = "(prog (define a 10)(type a))"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result = eval_expr(expression, env); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.identifier, "number"); // setting user type char exp_string2[] = "(prog (set-type a :my-type)(type a))"; expression = Parser::parse_single_expression(exp_string2); result = eval_expr(expression, env); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.identifier, "my-type"); // trying to set invalid user type char exp_string3[] = "(prog (set-type a \"wrong tpye\")(type a))"; expression = Parser::parse_single_expression(exp_string3); without_logging { result = eval_expr(expression, env); } assert_error(); delete_error(); // deleting user type char exp_string4[] = "(prog (delete-type a)(type a))"; expression = Parser::parse_single_expression(exp_string4); result = eval_expr(expression, env); assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Keyword); assert_equal_string(result->value.identifier, "number"); return pass; } proc test_singular_t_and_nil() -> testresult { Environment* env = Memory::create_built_ins_environment(); // nil testing char exp_string1[] = "()"; char exp_string2[] = "nil"; Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* result = eval_expr(expression, env); 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, env); 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, env); assert_no_error(); assert_not_null(result3); return pass; } proc test_file(const char* file) -> testresult { Memory::reset(); assert_no_error(); Environment* env = Memory::create_built_ins_environment(); assert_no_error(); Parser::init(env); assert_no_error(); built_in_load(Memory::create_string("pre.slime"), env); assert_no_error(); Lisp_Object* result = built_in_load(Memory::create_string(file), env); assert_no_error(); return pass; } proc run_all_tests() -> bool { Memory::init(4096 * 2000, 4096 * 16); Parser::init(Memory::create_built_ins_environment()); bool result = true; printf("-- 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); printf("\n-- Test Files --\n"); invoke_test_script("lexical_scope"); invoke_test_script("class_macro"); invoke_test_script("sicp"); 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