slime/src/testing.cpp

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<s32> 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<s32> 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<s32> 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
}