slime/src/testing.cpp

#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
    Int_Array_List list = create_Int_array_list();
    append_to_array_list(&list, 1);
    append_to_array_list(&list, 2);
    append_to_array_list(&list, 3);
    append_to_array_list(&list, 4);

    assert_equal_int(list.next_index, 4);

    remove_index_from_array_list(&list, 0);

    assert_equal_int(list.next_index, 3);
    assert_equal_int(list.data[0], 4);
    assert_equal_int(list.data[1], 2);
    assert_equal_int(list.data[2], 3);

    remove_index_from_array_list(&list, 2);

    assert_equal_int(list.next_index, 2);
    assert_equal_int(list.data[0], 4);
    assert_equal_int(list.data[1], 2);

    return pass;
}

proc test_array_lists_sorting() -> testresult {
    // test adding and removing
    Int_Array_List list = create_Int_array_list();
    append_to_array_list(&list, 1);
    append_to_array_list(&list, 2);
    append_to_array_list(&list, 3);
    append_to_array_list(&list, 4);

    sort_array_list(&list);

    assert_equal_int(list.next_index, 4);

    assert_equal_int(list.data[0], 1);
    assert_equal_int(list.data[1], 2);
    assert_equal_int(list.data[2], 3);
    assert_equal_int(list.data[3], 4);

    append_to_array_list(&list, 0);
    append_to_array_list(&list, 5);

    assert_equal_int(list.next_index, 6);

    sort_array_list(&list);

    assert_equal_int(list.data[0], 0);
    assert_equal_int(list.data[1], 1);
    assert_equal_int(list.data[2], 2);
    assert_equal_int(list.data[3], 3);
    assert_equal_int(list.data[4], 4);
    assert_equal_int(list.data[5], 5);


    return pass;
}

proc test_array_lists_searching() -> testresult {
    Int_Array_List list = create_Int_array_list();
    append_to_array_list(&list, 1);
    append_to_array_list(&list, 2);
    append_to_array_list(&list, 3);
    append_to_array_list(&list, 4);

    int index = sorted_array_list_find(&list, 3);
    assert_equal_int(index, 2);

    index = sorted_array_list_find(&list, 1);
    assert_equal_int(index, 0);

    index = sorted_array_list_find(&list, 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);
    int operands_length;
    try operands = eval_arguments(operands, &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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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.symbol.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;
    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.identifier, "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.identifier, "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.identifier, "number");

    return pass;
}

proc test_singular_t_and_nil() -> testresult {
    Environment* env;
    try env = get_root_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);

    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_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();
    };

    built_in_load(Memory::create_string(file));
    assert_no_error();

    return pass;
}

proc run_all_tests() -> bool {

    bool result = true;

    printf("-- Util --\n");
    invoke_test(test_array_lists_adding_and_removing);
    invoke_test(test_array_lists_sorting);
    invoke_test(test_array_lists_searching);

    Memory::init(4096 * 2000, 1024 * 32, 4096 * 16 * 10);

    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);

    printf("\n-- Test Files --\n");

    invoke_test_script("alists");
    invoke_test_script("case_and_cond");
    invoke_test_script("evaluation_of_default_args");
    invoke_test_script("lexical_scope");
    invoke_test_script("class_macro");
    invoke_test_script("import_and_load");
    invoke_test_script("sicp");
    invoke_test_script("macro_expand");
    invoke_test_script("automata");


    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