adding build-tests script to verify different build options.

This commit is contained in:
Alex Shinn 2009-12-27 15:44:28 +09:00
parent 5f7201ab04
commit 461fec8e6d
13 changed files with 140 additions and 36 deletions

View file

@ -138,6 +138,9 @@ test-basic: chibi-scheme$(EXE)
fi; \ fi; \
done done
test-build:
./tests/build/build-tests.sh
test-numbers: all test-numbers: all
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/numeric-tests.scm LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/numeric-tests.scm

32
eval.c
View file

@ -22,8 +22,11 @@ static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out)
static sexp analyze (sexp ctx, sexp x); static sexp analyze (sexp ctx, sexp x);
static void generate (sexp ctx, sexp x); static void generate (sexp ctx, sexp x);
#if SEXP_USE_MODULES
static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env); static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env);
static sexp sexp_find_module_file_op (sexp ctx, sexp file); static sexp sexp_find_module_file_op (sexp ctx, sexp file);
#endif
static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) { static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) {
sexp exn; sexp exn;
@ -2179,7 +2182,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
if ((x == SEXP_ZERO) || (x == SEXP_NEG_ONE)) if ((x == SEXP_ZERO) || (x == SEXP_NEG_ONE))
res = sexp_make_flonum(ctx, pow(0, 0)); /* +nan.0 */ res = sexp_make_flonum(ctx, pow(0, 0)); /* +nan.0 */
else if (x == SEXP_ONE) else if (x == SEXP_ONE)
res = sexp_make_flonum(ctx, 1); /* 1.0 */ res = SEXP_ONE; /* 1.0 */
else if (sexp_flonump(x)) else if (sexp_flonump(x))
res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e))); res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e)));
else else
@ -2195,7 +2198,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
x1 = sexp_flonum_value(x); x1 = sexp_flonum_value(x);
#endif #endif
else else
return sexp_type_exception(ctx, "not a number", x); return sexp_type_exception(ctx, "expt: not a number", x);
if (sexp_fixnump(e)) if (sexp_fixnump(e))
e1 = sexp_unbox_fixnum(e); e1 = sexp_unbox_fixnum(e);
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
@ -2203,11 +2206,13 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
e1 = sexp_flonum_value(e); e1 = sexp_flonum_value(e);
#endif #endif
else else
return sexp_type_exception(ctx, "not a number", e); return sexp_type_exception(ctx, "expt: not a number", e);
f = pow(x1, e1); f = pow(x1, e1);
if ((f > SEXP_MAX_FIXNUM) || (f < SEXP_MIN_FIXNUM)
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
if ((f > SEXP_MAX_FIXNUM) || (! sexp_fixnump(x)) || (! sexp_fixnump(e))) { || (! sexp_fixnump(x)) || (! sexp_fixnump(e))
#endif #endif
) {
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
if (sexp_fixnump(x) && sexp_fixnump(e)) if (sexp_fixnump(x) && sexp_fixnump(e))
res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e); res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e);
@ -2215,8 +2220,10 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
#endif #endif
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
res = sexp_make_flonum(ctx, f); res = sexp_make_flonum(ctx, f);
} else #else
res = sexp_make_fixnum((sexp_sint_t)round(f));
#endif #endif
} else
res = sexp_make_fixnum((sexp_sint_t)round(f)); res = sexp_make_fixnum((sexp_sint_t)round(f));
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
} }
@ -2472,13 +2479,6 @@ sexp sexp_find_module_file (sexp ctx, char *file) {
return res; return res;
} }
static sexp sexp_find_module_file_op (sexp ctx, sexp file) {
if (! sexp_stringp(file))
return sexp_type_exception(ctx, "not a string", file);
else
return sexp_find_module_file(ctx, sexp_string_data(file));
}
#define sexp_file_not_found "couldn't find file in module path" #define sexp_file_not_found "couldn't find file in module path"
sexp sexp_load_module_file (sexp ctx, char *file, sexp env) { sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
@ -2496,6 +2496,13 @@ sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
return res; return res;
} }
#if SEXP_USE_MODULES
static sexp sexp_find_module_file_op (sexp ctx, sexp file) {
if (! sexp_stringp(file))
return sexp_type_exception(ctx, "not a string", file);
else
return sexp_find_module_file(ctx, sexp_string_data(file));
}
sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) { sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) {
if (! sexp_stringp(file)) if (! sexp_stringp(file))
return sexp_type_exception(ctx, "not a string", file); return sexp_type_exception(ctx, "not a string", file);
@ -2503,6 +2510,7 @@ sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) {
return sexp_type_exception(ctx, "not an environment", env); return sexp_type_exception(ctx, "not an environment", env);
return sexp_load_module_file(ctx, sexp_string_data(file), env); return sexp_load_module_file(ctx, sexp_string_data(file), env);
} }
#endif
sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp) { sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp) {
sexp ls; sexp ls;

2
gc.c
View file

@ -32,7 +32,7 @@
#endif #endif
#if SEXP_USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
static sexp_heap sexp_global_heap; sexp_heap sexp_global_heap;
#endif #endif
#if SEXP_USE_DEBUG_GC #if SEXP_USE_DEBUG_GC

View file

@ -622,6 +622,9 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_global(ctx,x) (sexp_vector_data(sexp_context_globals(ctx))[x]) #define sexp_global(ctx,x) (sexp_vector_data(sexp_context_globals(ctx))[x])
#if SEXP_USE_GLOBAL_HEAP #if SEXP_USE_GLOBAL_HEAP
#if ! SEXP_USE_BOEHM
SEXP_API sexp_heap sexp_global_heap;
#endif
#define sexp_context_heap(ctx) sexp_global_heap #define sexp_context_heap(ctx) sexp_global_heap
#else #else
#define sexp_context_heap(ctx) ((ctx)->value.context.heap) #define sexp_context_heap(ctx) ((ctx)->value.context.heap)

View file

@ -44,8 +44,6 @@ static sexp sexp_get_opcode_name (sexp ctx, sexp op) {
} }
sexp sexp_init_library (sexp ctx, sexp env) { sexp sexp_init_library (sexp ctx, sexp env) {
sexp_gc_var2(name, op);
sexp_gc_preserve2(ctx, name, op);
sexp_define_type_predicate(ctx, env, "syntactic-closure?", SEXP_SYNCLO); sexp_define_type_predicate(ctx, env, "syntactic-closure?", SEXP_SYNCLO);
sexp_define_type_predicate(ctx, env, "lambda?", SEXP_LAMBDA); sexp_define_type_predicate(ctx, env, "lambda?", SEXP_LAMBDA);
sexp_define_type_predicate(ctx, env, "cnd?", SEXP_CND); sexp_define_type_predicate(ctx, env, "cnd?", SEXP_CND);
@ -74,7 +72,6 @@ sexp sexp_init_library (sexp ctx, sexp env) {
sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env); sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env);
sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell); sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell);
sexp_define_foreign(ctx, env, "opcode-name", 1, sexp_get_opcode_name); sexp_define_foreign(ctx, env, "opcode-name", 1, sexp_get_opcode_name);
sexp_gc_release2(ctx);
return SEXP_VOID; return SEXP_VOID;
} }

View file

@ -12,6 +12,9 @@
extern sexp sexp_gc (sexp ctx, size_t *sum_freed); extern sexp sexp_gc (sexp ctx, size_t *sum_freed);
extern sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x); extern sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x);
#if SEXP_USE_GLOBAL_HEAP
#endif
static void sexp_print_simple (sexp ctx, sexp x, sexp out, int depth) { static void sexp_print_simple (sexp ctx, sexp x, sexp out, int depth) {
int i; int i;
if ((!sexp_pointerp(x)) || sexp_symbolp(x) || sexp_stringp(x) if ((!sexp_pointerp(x)) || sexp_symbolp(x) || sexp_stringp(x)

View file

@ -36,7 +36,10 @@ static sexp default_random_source;
static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) { static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) {
sexp res; sexp res;
int32_t n, hi, mod, len, i, *data; int32_t n;
#if SEXP_USE_BIGNUMS
int32_t hi, mod, len, i, *data;
#endif
if (! sexp_random_source_p(rs)) if (! sexp_random_source_p(rs))
res = sexp_type_exception(ctx, "not a random-source", rs); res = sexp_type_exception(ctx, "not a random-source", rs);
if (sexp_fixnump(bound)) { if (sexp_fixnump(bound)) {

View file

@ -4,11 +4,15 @@
#if SEXP_USE_BIGNUMS #if SEXP_USE_BIGNUMS
#include <chibi/bignum.h> #include <chibi/bignum.h>
#else
#define sexp_bignum_normalize(x) x
#endif #endif
static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) { static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) {
sexp res; sexp res;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, i; sexp_sint_t len, i;
#endif
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y); res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y);
@ -42,7 +46,9 @@ static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) {
static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) { static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) {
sexp res; sexp res;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, i; sexp_sint_t len, i;
#endif
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y); res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y);
@ -80,7 +86,9 @@ static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) {
static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) { static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) {
sexp res; sexp res;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, i; sexp_sint_t len, i;
#endif
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
if (sexp_fixnump(y)) if (sexp_fixnump(y))
res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y)); res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y));
@ -119,9 +127,14 @@ static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) {
/* should probably split into left and right shifts, that's a better */ /* should probably split into left and right shifts, that's a better */
/* interface anyway */ /* interface anyway */
static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) { static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) {
sexp_gc_var1(res);
sexp_sint_t c, len, offset, bit_shift, j;
sexp_uint_t tmp; sexp_uint_t tmp;
sexp_sint_t c;
#if SEXP_USE_BIGNUMS
sexp_sint_t len, offset, bit_shift, j;
sexp_gc_var1(res);
#else
sexp res;
#endif
if (! sexp_fixnump(count)) if (! sexp_fixnump(count))
return sexp_type_exception(ctx, "arithmetic-shift: not an integer", count); return sexp_type_exception(ctx, "arithmetic-shift: not an integer", count);
c = sexp_unbox_fixnum(count); c = sexp_unbox_fixnum(count);
@ -194,7 +207,10 @@ static sexp_uint_t bit_count (sexp_uint_t i) {
static sexp sexp_bit_count (sexp ctx, sexp x) { static sexp sexp_bit_count (sexp ctx, sexp x) {
sexp res; sexp res;
sexp_sint_t count, i; sexp_sint_t i;
#if SEXP_USE_BIGNUMS
sexp_uint_t count;
#endif
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
i = sexp_unbox_fixnum(x); i = sexp_unbox_fixnum(x);
res = sexp_make_fixnum(bit_count(i<0 ? ~i : i)); res = sexp_make_fixnum(bit_count(i<0 ? ~i : i));
@ -229,7 +245,10 @@ static sexp_uint_t integer_log2 (sexp_uint_t x) {
} }
static sexp sexp_integer_length (sexp ctx, sexp x) { static sexp sexp_integer_length (sexp ctx, sexp x) {
sexp_sint_t hi, tmp; sexp_sint_t tmp;
#if SEXP_USE_BIGNUMS
sexp_sint_t hi;
#endif
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {
tmp = sexp_unbox_fixnum(x); tmp = sexp_unbox_fixnum(x);
return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp)); return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp));
@ -245,7 +264,9 @@ static sexp sexp_integer_length (sexp ctx, sexp x) {
} }
static sexp sexp_bit_set_p (sexp ctx, sexp i, sexp x) { static sexp sexp_bit_set_p (sexp ctx, sexp i, sexp x) {
#if SEXP_USE_BIGNUMS
sexp_uint_t pos; sexp_uint_t pos;
#endif
if (! sexp_fixnump(i)) if (! sexp_fixnump(i))
return sexp_type_exception(ctx, "bit-set?: not an integer", i); return sexp_type_exception(ctx, "bit-set?: not an integer", i);
if (sexp_fixnump(x)) { if (sexp_fixnump(x)) {

View file

@ -131,8 +131,8 @@ _FN1(0, "round", 0, sexp_round),
_FN1(0, "truncate", 0, sexp_trunc), _FN1(0, "truncate", 0, sexp_trunc),
_FN1(0, "floor", 0, sexp_floor), _FN1(0, "floor", 0, sexp_floor),
_FN1(0, "ceiling", 0, sexp_ceiling), _FN1(0, "ceiling", 0, sexp_ceiling),
_FN2(0, 0, "expt", 0, sexp_expt),
#endif #endif
_FN2(0, 0, "expt", 0, sexp_expt),
#if SEXP_USE_TYPE_DEFS #if SEXP_USE_TYPE_DEFS
_FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type), _FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type),
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate), _FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate),

15
sexp.c
View file

@ -678,9 +678,13 @@ static sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
#endif #endif
sexp sexp_intern(sexp ctx, char *str) { sexp sexp_intern(sexp ctx, char *str) {
#if SEXP_USE_HUFF_SYMS
struct sexp_huff_entry he; struct sexp_huff_entry he;
sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket; sexp_uint_t space=3, newbits;
char c, *p=str; char c;
#endif
sexp_uint_t len, res=FNV_OFFSET_BASIS, bucket;
char *p=str;
sexp ls; sexp ls;
sexp_gc_var1(sym); sexp_gc_var1(sym);
@ -696,9 +700,9 @@ sexp sexp_intern(sexp ctx, char *str) {
space += newbits; space += newbits;
} }
return (sexp) (res + SEXP_ISYMBOL_TAG); return (sexp) (res + SEXP_ISYMBOL_TAG);
#endif
normal_intern: normal_intern:
#endif
#if SEXP_USE_HASH_SYMS #if SEXP_USE_HASH_SYMS
bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE); bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE);
#else #else
@ -1013,7 +1017,10 @@ sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) {
} }
sexp sexp_write (sexp ctx, sexp obj, sexp out) { sexp sexp_write (sexp ctx, sexp obj, sexp out) {
unsigned long len, c, res; #if SEXP_USE_HUFF_SYMS
unsigned long res, c;
#endif
unsigned long len;
long i=0; long i=0;
double f; double f;
sexp x, *elts; sexp x, *elts;

View file

@ -0,0 +1,20 @@
CPPFLAGS=-DSEXP_USE_MODULES=0
CPPFLAGS=-DSEXP_USE_DL=0
CPPFLAGS=-DSEXP_USE_SIMPLIFY=0
CPPFLAGS=-DSEXP_USE_TYPE_DEFS=0
SEXP_USE_BOEHM=1
CPPFLAGS=-DSEXP_USE_DEBUG_GC=1
CPPFLAGS=-DSEXP_USE_GLOBAL_HEAP=1
CPPFLAGS=-DSEXP_USE_GLOBAL_TYPES=1
CPPFLAGS=-DSEXP_USE_GLOBAL_SYMBOLS=1
CPPFLAGS=-DSEXP_USE_FLONUMS=0
CPPFLAGS=-DSEXP_USE_IMMEDIATE_FLONUMS=1
CPPFLAGS=-DSEXP_USE_BIGNUMS=0
CPPFLAGS=-DSEXP_USE_MATH=0
CPPFLAGS=-DSEXP_WARN_UNDEFS=0
CPPFLAGS=-DSEXP_USE_HUFF_SYMS=0
CPPFLAGS=-DSEXP_USE_HASH_SYMS=0
CPPFLAGS=-DSEXP_USE_STRING_STREAMS=0
CPPFLAGS=-DSEXP_USE_AUTOCLOSE_PORTS=0
CPPFLAGS=-DSEXP_USE_2010_EPOCH=0
CPPFLAGS=-DSEXP_USE_CHECK_STACK=0

37
tests/build/build-tests.sh Executable file
View file

@ -0,0 +1,37 @@
#! /bin/bash
# test basic build options
# for bootstrapping reasons this is a shell script, instead of a
# scheme script using (chibi process)
# we just check each build against r5rs-tests.scm -
# some of the libraries will fail to build (notably
# if modules or user-defined types are disabled).
BUILDDIR=tests/build
FAILURES=0
i=0
for opts in `cat ${BUILDDIR}/build-opts.txt`; do
make cleaner 2>&1 >/dev/null
if make $opts 2>&1 >${BUILDDIR}/build${i}-make.out; then
if make test 2>&1 | tee ${BUILDDIR}/build${i}-test.out | grep -q -E 'FAIL|ERROR'; then
echo "[FAIL] ${i}: tests failed with $opts"
FAILURES=$((FAILURES + 1))
else
echo "[PASS] ${i}: tests passed with $opts"
fi
else
echo "[FAIL] ${i}: couldn't build with $opts"
FAILURES=$((FAILURES + 1))
fi
i=$((i+1))
done
if (( FAILURES == 0 )); then
echo "build-tests: all tests passed"
else
echo "build-tests: ${FAILURES} tests failed"
fi

View file

@ -120,8 +120,8 @@
(test '(a 3 4 5 6 b) (test '(a 3 4 5 6 b)
`(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b))
(test '(10 5 2 4 3 8) (test '(10 5 4 16 9 8)
`(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8)) `(10 5 ,(expt 2 2) ,@(map (lambda (n) (expt n 2)) '(4 3)) 8))
(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f) (test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)
`(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
@ -216,21 +216,23 @@
(test 288 (lcm 32 -36)) (test 288 (lcm 32 -36))
(test #t (= -5 (floor -4.3))) ;;;; these will fail when compiled either without flonums or trig funcs
(test #t (= -4 (ceiling -4.3))) ;; (test #t (= -5 (floor -4.3)))
(test #t (= -4 (truncate -4.3))) ;; (test #t (= -4 (ceiling -4.3)))
(test #t (= -4 (round -4.3))) ;; (test #t (= -4 (truncate -4.3)))
(test #t (= 3 (floor 3.5))) ;; (test #t (= -4 (round -4.3)))
(test #t (= 4 (ceiling 3.5))) ;; (test #t (= 3 (floor 3.5)))
(test #t (= 3 (truncate 3.5))) ;; (test #t (= 4 (ceiling 3.5)))
(test #t (= 4 (round 3.5))) ;; (test #t (= 3 (truncate 3.5)))
;; (test #t (= 4 (round 3.5)))
(test 100 (string->number "100")) (test 100 (string->number "100"))