diff --git a/src/main.c b/src/main.c index ebbef40a..7418e61d 100644 --- a/src/main.c +++ b/src/main.c @@ -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); } diff --git a/t/r7rs-tests.scm b/t/r7rs-tests.scm index 6143a555..a5eeb2a6 100644 --- a/t/r7rs-tests.scm +++ b/t/r7rs-tests.scm @@ -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 ()