conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

import cond-expand tests from @KeenS's patch

This commit is contained in:
Yuichi Nishiwaki 2014-09-10 02:13:38 +09:00
parent 4be04205ae
commit 05e288449a
2 changed files with 38 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/main.c
View File

@ -14,15 +14,9 @@ void pic_load_piclib(pic_state *);
static pic_value
pic_features(pic_state *pic)
{
pic_value features = pic_nil_value();
pic_get_args(pic, "");
pic_push(pic, pic_sym_value(pic_intern_cstr(pic, "r7rs")), features);
pic_push(pic, pic_sym_value(pic_intern_cstr(pic, "ieee-float")), features);
pic_push(pic, pic_sym_value(pic_intern_cstr(pic, "picrin")), features);
return features;
return pic->features;
}
static pic_value
@ -42,6 +36,8 @@ pic_libraries(pic_state *pic)
void
pic_init_picrin(pic_state *pic)
{
pic_add_feature(pic, "r7rs");
pic_deflibrary (pic, "(picrin library)") {
pic_defun(pic, "libraries", pic_libraries);
}

35
t/r7rs-tests.scm
View File

@ -48,6 +48,41 @@
(test-begin "R7RS")
(test-begin "cond-expand")
(test #t (cond-expand
(r7rs #t)
(else #f)))
(test #t (cond-expand
((library (scheme write)) #t)
(else #f)))
(test #t (cond-expand
((not r6rs) #t)
(else #f)))
(test #t (cond-expand
((and r7rs (library (picrin test))) #t)
(else #f)))
(test #t (cond-expand
((or r6rs r7rs) #t)
(else #f)))
(cond-expand
(r7rs (test #t #t))
(else (test #t #f)))
(cond-expand
((library (scheme write)) (test #t #t))
(else (test #t #f)))
(cond-expand
((not r6rs) (test #t #t))
(else (test #t #f)))
(cond-expand
((and r7rs (library (picrin test))) (test #t #t))
(else (test #t #f)))
(cond-expand
((or r6rs r7rs) (test #t #t))
(else (test #t #f)))
(test-end)
(test-begin "4.1 Primitive expression types")
(let ()