Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix bug in procedure-flags in (chibi ast) (issue #864)

Browse source 
We were incorrectly boxing an already boxed value.
This commit is contained in:
Alex Shinn 2022-10-05 09:06:51 +09:00
parent 0eeeac7650
commit 49f95dc107
4 changed files with 10 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
include/chibi/sexp.h
View file

@ -533,7 +533,7 @@ struct sexp_struct {
} bytecode; } bytecode;
struct { struct {
sexp bc, vars; sexp bc, vars;
char flags; char flags; /* a boxed fixnum truncated to char */
sexp_proc_num_args_t num_args; sexp_proc_num_args_t num_args;
} procedure; } procedure;
struct { struct {

2
lib/chibi/ast.c
View file

@ -105,7 +105,7 @@ sexp sexp_get_procedure_variable_transformer_p (sexp ctx, sexp self, sexp_sint_t
sexp sexp_get_procedure_flags (sexp ctx, sexp self, sexp_sint_t n, sexp proc) { sexp sexp_get_procedure_flags (sexp ctx, sexp self, sexp_sint_t n, sexp proc) {
sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, proc); sexp_assert_type(ctx, sexp_procedurep, SEXP_PROCEDURE, proc);
return sexp_make_fixnum(sexp_procedure_flags(proc)); return (sexp) (sexp_uint_t) sexp_procedure_flags(proc);
} }
sexp sexp_make_variable_transformer_op (sexp ctx, sexp self, sexp_sint_t n, sexp base_proc) { sexp sexp_make_variable_transformer_op (sexp ctx, sexp self, sexp_sint_t n, sexp base_proc) {

7
lib/srfi/229/test.sld
View file

@ -14,11 +14,16 @@
(lambda/tag 43 (lambda/tag 43
(x) (x)
(* x x))) (* x x)))
(define g
(lambda/tag 44 args (apply list args)))
(test-assert (procedure/tag? f)) (test-assert (procedure/tag? f))
(test-not (procedure/tag? (lambda (x) (* x x)))) (test-not (procedure/tag? (lambda (x) (* x x))))
(test-not (procedure/tag? +)) (test-not (procedure/tag? +))
(test 9 (f 3)) (test 9 (f 3))
(test 42 (procedure-tag f)) (test 42 (procedure-tag f))
(test-not (eqv? f f*)) (test-not (eqv? f f*))
(test 43 (procedure-tag f*))) (test 43 (procedure-tag f*))
(test 44 (procedure-tag g))
(test '(1) (g 1))
(test '(1 2 3) (g 1 2 3)))
(test-end)))) (test-end))))

2
tests/lib-tests.scm
View file

@ -35,6 +35,7 @@
(rename (srfi 160 test) (run-tests run-srfi-160-tests)) (rename (srfi 160 test) (run-tests run-srfi-160-tests))
(rename (srfi 166 test) (run-tests run-srfi-166-tests)) (rename (srfi 166 test) (run-tests run-srfi-166-tests))
(rename (srfi 219 test) (run-tests run-srfi-219-tests)) (rename (srfi 219 test) (run-tests run-srfi-219-tests))
(rename (srfi 229 test) (run-tests run-srfi-229-tests))
(rename (scheme bytevector-test) (run-tests run-scheme-bytevector-tests)) (rename (scheme bytevector-test) (run-tests run-scheme-bytevector-tests))
(rename (chibi assert-test) (run-tests run-assert-tests)) (rename (chibi assert-test) (run-tests run-assert-tests))
(rename (chibi base64-test) (run-tests run-base64-tests)) (rename (chibi base64-test) (run-tests run-base64-tests))
@ -106,6 +107,7 @@
(run-srfi-160-tests) (run-srfi-160-tests)
(run-srfi-166-tests) (run-srfi-166-tests)
(run-srfi-219-tests) (run-srfi-219-tests)
(run-srfi-229-tests)
(run-scheme-bytevector-tests) (run-scheme-bytevector-tests)
(run-assert-tests) (run-assert-tests)
(run-base64-tests) (run-base64-tests)