work on type inference some more

[ccc.git] / test / test_sem_hm_gamma.c

diff --git a/test/test_sem_hm_gamma.c b/test/test_sem_hm_gamma.c
new file mode 100644 (file)
index 0000000..1665031
--- /dev/null
+++ b/test/test_sem_hm_gamma.c
@@ -0,0 +1,97 @@
+#include <stdbool.h>
+#include <stdlib.h>
+#include <check.h>
+
+#include "../sem/hm/gamma.h"
+#include "../sem/hm/subst.h"
+#include "../sem/hm/scheme.h"
+
+START_TEST(test_gamma_lookup)
+{
+       struct gamma *gamma = gamma_init();
+
+       ck_assert_ptr_null(gamma_lookup(gamma, "fun"));
+       ck_assert_ptr_null(gamma_lookup(gamma, "fun2"));
+
+       gamma_insert(gamma, "fun", scheme_generalise(gamma, type_basic(btint)));
+
+       ck_assert_ptr_nonnull(gamma_lookup(gamma, "fun"));
+       ck_assert_ptr_null(gamma_lookup(gamma, "fun2"));
+
+       struct type *t1 = gamma_fresh(gamma);
+       ck_assert(t1->type == tvar);
+       struct type *t2 = gamma_fresh(gamma);
+       ck_assert(t2->type == tvar);
+       struct type *t3 = gamma_fresh(gamma);
+       ck_assert(t3->type == tvar);
+       struct type *t4 = gamma_fresh(gamma);
+       ck_assert(t4->type == tvar);
+
+       ck_assert_str_ne(t1->data.tvar, t2->data.tvar);
+       ck_assert_str_ne(t2->data.tvar, t3->data.tvar);
+       ck_assert_str_ne(t3->data.tvar, t4->data.tvar);
+}
+END_TEST
+
+START_TEST(test_scheme)
+{
+       struct gamma *gamma = gamma_init();
+
+       char **var = malloc(sizeof(char *));
+       var[0] = safe_strdup("a");
+       struct scheme scheme = {.type=type_var("a"), .nvar=1, .var=var};
+
+       struct type *t = scheme_instantiate(gamma, &scheme);
+       ck_assert(t->type == tvar);
+       ck_assert_str_eq(t->data.tvar, "0");
+
+       scheme.type = type_list(type_var("a"));
+       t = scheme_instantiate(gamma, &scheme);
+       ck_assert(t->type == tlist);
+       ck_assert(t->data.tlist->type == tvar);
+       ck_assert_str_eq(t->data.tlist->data.tvar, "1");
+}
+END_TEST
+
+START_TEST(test_subst)
+{
+       struct subst *s1 = subst_id();
+       ck_assert_int_eq(0, s1->nvar);
+       s1 = subst_singleton("i1", type_basic(btint));
+       ck_assert_int_eq(1, s1->nvar);
+       s1 = subst_union(subst_id(), subst_singleton("i1", type_basic(btint)));
+       ck_assert_int_eq(1, s1->nvar);
+       s1 = subst_union(subst_singleton("i2", type_basic(btbool)),
+               subst_singleton("i1", type_basic(btint)));
+       ck_assert_int_eq(2, s1->nvar);
+
+}
+END_TEST
+
+Suite *util_suite(void)
+{
+       Suite *s = suite_create("List");
+
+       TCase *tc_gamma = tcase_create("Gamma lookup");
+       tcase_add_test(tc_gamma, test_gamma_lookup);
+       tcase_add_test(tc_gamma, test_scheme);
+       tcase_add_test(tc_gamma, test_subst);
+       suite_add_tcase(s, tc_gamma);
+
+       return s;
+}
+
+int main(void)
+{
+       int failed;
+       Suite *s;
+       SRunner *sr;
+
+       s = util_suite();
+       sr = srunner_create(s);
+
+       srunner_run_all(sr, CK_NORMAL);
+       failed = srunner_ntests_failed(sr);
+       srunner_free(sr);
+       return (failed == 0) ? EXIT_SUCCESS : EXIT_FAILURE;
+}