From 60b367cddd49f3d387851746ad1699eeb654da49 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 9 Oct 2021 11:43:40 -0700 Subject: ffi: fix broken range checks in enumed type. Reported by Paul A. Patience. * ffi.c (make_ffi_type_enum): Do not use the cnum native type for doing the member value calculations. Work with Lisp numbers, and verify their range by passing them into the put function of the underlying integer type. Duplicated code is merged, too. * tests/017/ffi-misc.tl: New tests. Two 64 bit ones fail due to conversion bugs. --- tests/017/ffi-misc.tl | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) (limited to 'tests') 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) -- cgit v1.2.3