summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ffi.c47
-rw-r--r--tests/017/ffi-misc.tl54
2 files changed, 76 insertions, 25 deletions
diff --git a/ffi.c b/ffi.c
index ced44f2f..53971cc4 100644
--- a/ffi.c
+++ b/ffi.c
@@ -3599,7 +3599,7 @@ static val make_ffi_type_enum(val syntax, val enums,
val sym_num = make_hash(hash_weak_none, t);
val num_sym = make_hash(hash_weak_none, nil);
val obj = cobj(coerce(mem_t *, tft), ffi_type_cls, &ffi_type_enum_ops);
- cnum cur = -1;
+ val cur;
val iter;
val enum_env = make_env(nil, nil, nil);
val shadow_menv = make_env(nil, nil, nil);
@@ -3625,28 +3625,27 @@ static val make_ffi_type_enum(val syntax, val enums,
tft->num_sym = num_sym;
tft->sym_num = sym_num;
- for (iter = enums; !endp(iter); iter = cdr(iter)) {
+ for (cur = negone, iter = enums; !endp(iter); iter = cdr(iter)) {
+ int_ptr_t conv_buf[2];
val en = car(iter);
- val nn;
+ val sym;
+
if (symbolp(en)) {
- val sym = en;
+ sym = en;
if (!bindable(sym))
uw_throwf(error_s, lit("~a: ~s member ~s isn't a bindable symbol"),
self, syntax, sym, nao);
- if (cur == INT_MAX)
- uw_throwf(error_s, lit("~a: ~s overflow at member ~s"),
- self, syntax, sym, nao);
+
if (gethash(num_sym, sym))
uw_throwf(error_s, lit("~a: ~s duplicate member ~s"),
self, syntax, sym, nao);
- sethash(num_sym, sym, nn = num(++cur));
- sethash(sym_num, nn, sym);
- env_vbind(enum_env, sym, nn);
- env_vbind(shadow_menv, sym, special_s);
+
+ cur = plus(cur, one);
} else {
val expr = cadr(en);
- val sym = car(en);
- val n;
+
+ sym = car(en);
+
if (!bindable(sym))
uw_throwf(error_s, lit("~a: ~s member ~s isn't a bindable symbol"),
self, syntax, sym, nao);
@@ -3654,22 +3653,20 @@ static val make_ffi_type_enum(val syntax, val enums,
uw_throwf(error_s, lit("~a: ~s duplicate member ~s"),
self, syntax, sym, nao);
- n = ffi_eval_expr(expr, shadow_menv, enum_env);
+ cur = ffi_eval_expr(expr, shadow_menv, enum_env);
- if (!integerp(n)) {
+ if (!integerp(cur)) {
uw_throwf(error_s, lit("~a: ~s member ~s value ~s not integer"),
- self, syntax, sym, n, nao);
+ self, syntax, sym, cur, nao);
}
-
- cur = c_num(n, self);
- if (cur > INT_MAX)
- uw_throwf(error_s, lit("~a: ~s member ~s value ~s too large"),
- self, syntax, sym, n, nao);
- sethash(num_sym, sym, nn = num(cur));
- sethash(sym_num, nn, sym);
- env_vbind(enum_env, sym, nn);
- env_vbind(shadow_menv, sym, special_s);
}
+
+ btft->put(btft, cur, coerce(mem_t *, conv_buf), self);
+
+ sethash(num_sym, sym, cur);
+ sethash(sym_num, cur, sym);
+ env_vbind(enum_env, sym, cur);
+ env_vbind(shadow_menv, sym, special_s);
}
return obj;
diff --git a/tests/017/ffi-misc.tl b/tests/017/ffi-misc.tl
index db510737..3b3c4438 100644
--- a/tests/017/ffi-misc.tl
+++ b/tests/017/ffi-misc.tl
@@ -16,3 +16,57 @@
(test (ffi-get #b'ED7F7FEDFF00' (ffi (zarray char)))
"\xDCED\x7F\x7F\xDCED\xDCFF"))
+
+(mtest
+ (typeof (ffi (enum a))) ffi-type
+ (typeof (ffi (enum b b0 b1 b2 (b3 -15)))) ffi-type
+ (typeof (ffi (enum c (c0 (expt 2 512))))) :error
+ (typeof (ffi (enum d d0 d0))) :error
+ (typeof (ffi (enum e (e0 0) (e0 1)))) :error)
+
+(mtest
+ (typeof (ffi (enumed uint16 m))) ffi-type
+ (typeof (ffi (enumed uint16 n n0 n1 n2 (n3 15)))) ffi-type
+ (typeof (ffi (enumed uint16 o (o0 (expt 2 512))))) :error
+ (typeof (ffi (enumed uint16 p p0 p0))) :error
+ (typeof (ffi (enumed uint16 q (q0 0) (q0 1)))) :error)
+
+(mtest
+ (typeof (ffi (enumed uint8 e (x 0) (y #xff)))) ffi-type
+ (typeof (ffi (enumed uint8 e (x -1)))) :error
+ (typeof (ffi (enumed uint8 e (x #x100)))) :error)
+
+(mtest
+ (typeof (ffi (enumed uint16 e (x 0) (y #xffff)))) ffi-type
+ (typeof (ffi (enumed uint16 e (x -1)))) :error
+ (typeof (ffi (enumed uint16 e (x #x10000)))) :error)
+
+(mtest
+ (typeof (ffi (enumed uint32 e (x 0) (y #xffffffff)))) ffi-type
+ (typeof (ffi (enumed uint32 e (x -1)))) :error
+ (typeof (ffi (enumed uint32 e (x #x100000000)))) :error)
+
+(mtest
+ (typeof (ffi (enumed uint64 e (x 0) (y #xffffffffffffffff)))) ffi-type
+ ;(typeof (ffi (enumed uint64 e (x -1)))) #:error
+ (typeof (ffi (enumed uint64 e (x #x10000000000000000)))) :error)
+
+(mtest
+ (typeof (ffi (enumed int8 e (x 0) (y #x7f)))) ffi-type
+ (typeof (ffi (enumed int8 e (x #x-81)))) :error
+ (typeof (ffi (enumed int8 e (x #x800)))) :error)
+
+(mtest
+ (typeof (ffi (enumed int16 e (x 0) (y #x7fff)))) ffi-type
+ (typeof (ffi (enumed int16 e (x #x-8001)))) :error
+ (typeof (ffi (enumed int16 e (x #x8000)))) :error)
+
+(mtest
+ (typeof (ffi (enumed int32 e (x 0) (y #x7fffffff)))) ffi-type
+ (typeof (ffi (enumed int32 e (x #x-80000001)))) :error
+ (typeof (ffi (enumed int32 e (x #x80000000)))) :error)
+
+(mtest
+ (typeof (ffi (enumed int64 e (x 0) (y #x7fffffffffffffff)))) ffi-type
+ (typeof (ffi (enumed int64 e (x #x-8000000000000001)))) :error
+ (typeof (ffi (enumed int64 e (x #x8000000000000000)))) :error)