Test Typed Jerboa wrapper boundary checks
ober
0a98e22d571a136af8155acc1f60dbb7382bc18c
--- a/docs/typed-jerboa.md +++ b/docs/typed-jerboa.md @@ -164,7 +164,8 @@ Current landing: pairs for scalar-return functions. - `make typed-wrapper-smoke` builds the primitive Rust fixture, generates its wrapper, loads the cdylib, and calls the generated Jerboa functions through - Chez FFI. + Chez FFI. It also checks that bad dynamic calls are rejected by generated + wrapper predicates before crossing the FFI boundary. - `support/typed-rust.ss`, `make typed-rust`, and `make typed-build` generate a disposable Cargo crate under `build/typed/rust`; `typed-build` also writes wrappers under `build/typed/jerboa` and runs `cargo build` against the --- a/tests/test-typed-wrapper-e2e.ss +++ b/tests/test-typed-wrapper-e2e.ss @@ -24,6 +24,11 @@ (set! fail (+ fail 1)) (printf "FAIL ~a~%" name)))) +(define (raises? thunk) + (guard (exn [#t #t]) + (thunk) + #f)) + (printf "--- Typed Jerboa wrapper FFI smoke ---~%") (check "zero" (= (zero) 0)) @@ -33,6 +38,14 @@ (check "double-add" (= (double-add 20) 41)) (check "text-length" (= (text-length "hello") 5)) (check "bytes-length" (= (bytes-length (make-bytevector 7 0)) 7)) +(check "add-one rejects non-Nat" + (raises? (lambda () (add-one "not a number")))) +(check "choose rejects non-Bool" + (raises? (lambda () (choose 1)))) +(check "text-length rejects non-String" + (raises? (lambda () (text-length (make-bytevector 3 0))))) +(check "bytes-length rejects non-Bytes" + (raises? (lambda () (bytes-length "not bytes")))) (printf "~%Typed wrapper FFI smoke: ~a passed, ~a failed~%" pass fail) (when (> fail 0)