Skip to content

Commit 40da4ab

Browse files
bksaikibksaiki
committed
split tests; update CI
1 parent 6c4084a commit 40da4ab

File tree

5 files changed

+204
-105
lines changed

5 files changed

+204
-105
lines changed

‎.github/workflows/tests.yml‎

Lines changed: 4 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -10,35 +10,17 @@ jobs:
1010
- uses: actions/checkout@v2
1111
with:
1212
submodules: recursive
13-
- name: Build GC
14-
run: make boehm-gc
1513
- name: Build
16-
run: make boot && make
14+
run: make
1715

18-
boot:
16+
unit:
1917
runs-on: ubuntu-latest
2018
needs: [ 'build' ]
2119
steps:
2220
- uses: actions/checkout@v2
2321
with:
2422
submodules: recursive
25-
- name: Build GC
26-
run: make boehm-gc
2723
- name: Build
28-
run: make boot && make
24+
run: make
2925
- name: Tests
30-
run: make boot-tests
31-
32-
boot-file:
33-
runs-on: ubuntu-latest
34-
needs: [ 'build' ]
35-
steps:
36-
- uses: actions/checkout@v2
37-
with:
38-
submodules: recursive
39-
- name: Build GC
40-
run: make boehm-gc
41-
- name: Build
42-
run: make boot && make
43-
- name: Rebuild boot file
44-
run: make boot-file
26+
run: make test

‎Makefile‎

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,9 @@ SRCS = $(shell find $(SRC_DIR) -name "*.c" ! -wholename $(ENTRY))
1616
OBJS = $(SRCS:%.c=$(BUILD_DIR)/%.o)
1717
DEPS = $(OBJS:.o=.d)
1818

19+
TESTS = $(shell find $(TEST_DIR) -name "*.c" -printf "%f\n")
20+
TEST_OBJS = $(TESTS:%.c=$(BUILD_DIR)/%)
21+
1922
MKDIR_P = mkdir -p
2023
RM = rm -rf
2124

@@ -24,19 +27,20 @@ RM = rm -rf
2427

2528
all: $(EXENAME)
2629

27-
gc: build/libgc.a
30+
base: $(BUILD_DIR) $(CONFIG) gc
2831

2932
clean:
3033
$(RM) $(BUILD_DIR)
3134

3235
clean-all: clean
3336
$(MAKE) -C $(GC_DIR) clean
3437

35-
test: $(BUILD_DIR)/read $(BUILD_DIR)/syntax
36-
$(BUILD_DIR)/read
37-
$(BUILD_DIR)/syntax
38+
gc: $(BUILD_DIR)/libgc.a
3839

39-
$(EXENAME): $(BUILD_DIR) gc $(CONFIG) $(OBJS)
40+
test: base $(OBJS) $(TEST_OBJS)
41+
$(TEST_DIR)/unit.sh $(TEST_OBJS)
42+
43+
$(EXENAME): base $(OBJS)
4044
$(CC) $(CFLAGS) $(INCFLAGS) $(OBJS) $(ENTRY) $(LDFLAGS) -o $(EXENAME)
4145

4246
$(GC_DIR)/Makefile:
@@ -65,4 +69,4 @@ $(BUILD_DIR)/$(SRC_DIR)/%.o: $(SRC_DIR)/%.c | $$(@D)/.
6569
$(BUILD_DIR)/%: $(TEST_DIR)/%.c $(OBJS)
6670
$(CC) $(CFLAGS) $(INCFLAGS) $(DEPFLAGS) -o $@ $(OBJS) $< $(LDFLAGS)
6771

68-
.PHONY: all clean gc
72+
.PHONY: all base clean clean-all gc test

‎tests/prims.c‎

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
// prims.c: tests for primitives
2+
3+
#include "../src/minim.h"
4+
5+
int return_code, passed;
6+
7+
#define log_test(name, t) { \
8+
if (t() == 1) { \
9+
printf("[ \033[32mPASS\033[0m ] %s\n", name); \
10+
} else { \
11+
return_code = 1; \
12+
printf("[ \033[31mFAIL\033[0m ] %s\n", name); \
13+
} \
14+
}
15+
16+
#define log_failed_case(s, expect, actual) { \
17+
printf(" %s => expected: %s, actual: %s\n", s, expect, actual); \
18+
}
19+
20+
char *write_debug(obj o) {
21+
FILE *stream;
22+
char *buffer;
23+
size_t len, read;
24+
25+
stream = tmpfile();
26+
write_obj(stream, o);
27+
len = ftell(stream);
28+
fseek(stream, 0, SEEK_SET);
29+
30+
buffer = GC_malloc_atomic((len + 1) * sizeof(char));
31+
read = fread(buffer, 1, len, stream);
32+
buffer[len] = '\0';
33+
if (read != len) {
34+
fprintf(stderr, "read error occured");
35+
exit(1);
36+
}
37+
38+
fclose(stream);
39+
return buffer;
40+
}
41+
42+
void check_equal(const char *input, const char *expect) {
43+
obj p, e, tc, x;
44+
char *str;
45+
46+
p = Minput_string_port(Mstring(input));
47+
e = read_object(p);
48+
49+
tc = Mcurr_tc();
50+
Mtc_env(tc) = prim_env(empty_env());
51+
x = eval_expr(e);
52+
53+
str = write_debug(x);
54+
if (strcmp(str, expect) != 0) {
55+
log_failed_case(input, expect, str);
56+
passed = 0;
57+
}
58+
}
59+
60+
int test_callwv(void) {
61+
passed = 1;
62+
63+
check_equal("(call-with-values (lambda () (values)) (lambda xs xs))", "()");
64+
check_equal("(call-with-values (lambda () (values 1)) (lambda xs xs))", "(1)");
65+
check_equal("(call-with-values (lambda () (values 1 2 3)) (lambda xs xs))", "(1 2 3)");
66+
check_equal("(call-with-values (lambda () (values 1 2)) fx2+)", "3");
67+
68+
return passed;
69+
}
70+
71+
72+
int test_callcc(void) {
73+
passed = 1;
74+
75+
check_equal("(call/cc (lambda (k) 1))", "1");
76+
check_equal("(call/cc (lambda (k) (k 1) 2))", "1");
77+
check_equal("(let ([x #f]) (cons 1 (call/cc (lambda (k) (set! x k) 2))))", "(1 . 2)");
78+
79+
// from ChezScheme documentation
80+
check_equal("(call/cc (lambda (k) (fx2* 5 (k 4))))", "4");
81+
check_equal("(fx2+ 2 (call/cc (lambda (k) (fx2* 5 (k 4)))))", "6");
82+
check_equal("(letrec ([product "
83+
"(lambda (xs) "
84+
"(call/cc "
85+
"(lambda (break) "
86+
"(if (null? xs) "
87+
"1 "
88+
"(if (fx2= (car xs) 0) "
89+
"(break 0) "
90+
"(fx2* (car xs) (product (cdr xs))))))))]) "
91+
"(product '(7 3 8 0 1 9 5)))",
92+
"0");
93+
check_equal("(let ([x (call/cc (lambda (k) k))]) "
94+
"(x (lambda (ignore) \"hi\")))",
95+
"\"hi\"");
96+
97+
check_equal("(letrec ([k* #f] "
98+
"[y (fx1+ (call/cc (lambda (k) (set! k* k) 0)))]) "
99+
"(if (fx2< y 5) "
100+
"(k* y) "
101+
"y))",
102+
"5");
103+
104+
return passed;
105+
}
106+
107+
int test_dynamic_wind(void) {
108+
passed = 1;
109+
110+
check_equal("(dynamic-wind (lambda () 1) (lambda () 2) (lambda () 3))", "2");
111+
check_equal("(dynamic-wind (lambda () (values)) (lambda () 1) (lambda () (values 1 2)))", "1");
112+
113+
check_equal(
114+
"(let ((path '()) (c #f)) "
115+
"(let ((add (lambda (s) "
116+
"(set! path (cons s path))))) "
117+
"(dynamic-wind "
118+
"(lambda () (add 'connect)) "
119+
"(lambda () "
120+
"(add (call/cc "
121+
"(lambda (c0) "
122+
"(set! c c0) "
123+
"'talk1)))) "
124+
"(lambda () (add 'disconnect))) "
125+
"(if (fx2< (length path) 4) "
126+
"(c 'talk2) "
127+
"(reverse path))))",
128+
"(disconnect talk2 connect disconnect talk1 connect)"
129+
);
130+
131+
return passed;
132+
}
133+
134+
135+
int main(int argc, char **argv) {
136+
GC_init();
137+
minim_init();
138+
139+
return_code = 0;
140+
141+
log_test("call-with-values", test_callwv);
142+
log_test("call/cc", test_callcc);
143+
log_test("dynamic-wind", test_dynamic_wind);
144+
145+
minim_shutdown(return_code);
146+
}
147+

‎tests/syntax.c‎

Lines changed: 0 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -92,17 +92,6 @@ int test_begin(void) {
9292
return passed;
9393
}
9494

95-
int test_values(void) {
96-
passed = 1;
97-
98-
check_equal("(call-with-values (lambda () (values)) (lambda xs xs))", "()");
99-
check_equal("(call-with-values (lambda () (values 1)) (lambda xs xs))", "(1)");
100-
check_equal("(call-with-values (lambda () (values 1 2 3)) (lambda xs xs))", "(1 2 3)");
101-
check_equal("(call-with-values (lambda () (values 1 2)) fx2+)", "3");
102-
103-
return passed;
104-
}
105-
10695
int test_let_values(void) {
10796
passed = 1;
10897

@@ -205,69 +194,6 @@ int test_setb(void) {
205194
return passed;
206195
}
207196

208-
int test_callcc(void) {
209-
passed = 1;
210-
211-
check_equal("(call/cc (lambda (k) 1))", "1");
212-
check_equal("(call/cc (lambda (k) (k 1) 2))", "1");
213-
check_equal("(let ([x #f]) (cons 1 (call/cc (lambda (k) (set! x k) 2))))", "(1 . 2)");
214-
215-
// from ChezScheme documentation
216-
check_equal("(call/cc (lambda (k) (fx2* 5 (k 4))))", "4");
217-
check_equal("(fx2+ 2 (call/cc (lambda (k) (fx2* 5 (k 4)))))", "6");
218-
check_equal("(letrec ([product "
219-
"(lambda (xs) "
220-
"(call/cc "
221-
"(lambda (break) "
222-
"(if (null? xs) "
223-
"1 "
224-
"(if (fx2= (car xs) 0) "
225-
"(break 0) "
226-
"(fx2* (car xs) (product (cdr xs))))))))]) "
227-
"(product '(7 3 8 0 1 9 5)))",
228-
"0");
229-
check_equal("(let ([x (call/cc (lambda (k) k))]) "
230-
"(x (lambda (ignore) \"hi\")))",
231-
"\"hi\"");
232-
233-
check_equal("(letrec ([k* #f] "
234-
"[y (fx1+ (call/cc (lambda (k) (set! k* k) 0)))]) "
235-
"(if (fx2< y 5) "
236-
"(k* y) "
237-
"y))",
238-
"5");
239-
240-
return passed;
241-
}
242-
243-
int test_dynamic_wind(void) {
244-
passed = 1;
245-
246-
check_equal("(dynamic-wind (lambda () 1) (lambda () 2) (lambda () 3))", "2");
247-
check_equal("(dynamic-wind (lambda () (values)) (lambda () 1) (lambda () (values 1 2)))", "1");
248-
249-
check_equal(
250-
"(let ((path '()) (c #f)) "
251-
"(let ((add (lambda (s) "
252-
"(set! path (cons s path))))) "
253-
"(dynamic-wind "
254-
"(lambda () (add 'connect)) "
255-
"(lambda () "
256-
"(add (call/cc "
257-
"(lambda (c0) "
258-
"(set! c c0) "
259-
"'talk1)))) "
260-
"(lambda () (add 'disconnect))) "
261-
"(if (fx2< (length path) 4) "
262-
"(c 'talk2) "
263-
"(reverse path))))",
264-
"(disconnect talk2 connect disconnect talk1 connect)"
265-
);
266-
267-
268-
return passed;
269-
}
270-
271197
int main(int argc, char **argv) {
272198
GC_init();
273199
minim_init();
@@ -277,16 +203,13 @@ int main(int argc, char **argv) {
277203
log_test("quote", test_quote);
278204
log_test("if", test_if);
279205
log_test("begin", test_begin);
280-
log_test("values", test_values);
281206
log_test("let-values", test_let_values);
282207
log_test("letrec-values", test_letrec_values);
283208
log_test("let", test_let);
284209
log_test("letrec", test_letrec);
285210
log_test("let (loop)", test_let_loop);
286211
log_test("lambda", test_lambda);
287212
log_test("set!", test_setb);
288-
log_test("call/cc", test_callcc);
289-
log_test("dynamic-wind", test_dynamic_wind);
290213

291214
minim_shutdown(return_code);
292215
}

‎tests/unit.sh‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
#!/bin/bash
2+
3+
RED="\e[31m"
4+
GREEN="\e[32m"
5+
ENDCOLOR="\e[0m"
6+
7+
# determine physical directory of this script
8+
src="${BASH_SOURCE[0]}"
9+
while [ -L "$src" ]; do
10+
dir="$(cd -P "$(dirname "$src")" && pwd)"
11+
src="$(readlink "$src")"
12+
[[ $src != /* ]] && src="$dir/$src"
13+
done
14+
DIR="$(cd -P "$(dirname "$src")" && pwd)"
15+
16+
TOPDIR="$DIR/.."
17+
TESTS="$@"
18+
19+
20+
## Unit tests
21+
22+
23+
failed=0
24+
total=0
25+
26+
echo "Running unit tests"
27+
28+
for file in $TESTS; do
29+
test="$(realpath $TOPDIR/$file)"
30+
echo "Running $test"
31+
32+
$test
33+
if [ $? -ne 0 ]; then
34+
((failed++))
35+
fi
36+
37+
((total++))
38+
done
39+
40+
printf "%i/%i tests passed\n" $(expr $total - $failed) $total
41+
if [[ $failed != 0 ]]; then
42+
exit 1
43+
fi

0 commit comments

Comments
 (0)