From 3464b8d226f6ea8f84681cbaea4442876969b026 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 3 Dec 2018 09:19:01 +0000 Subject: [PATCH] Add missing type checks to some bit string operations. --- src/microcode/bitstr.c | 2 ++ tests/runtime/test-bit-string.scm | 54 +++++++++++-------------------- 2 files changed, 20 insertions(+), 36 deletions(-) diff --git a/src/microcode/bitstr.c b/src/microcode/bitstr.c index e011d2e99..056b184a0 100644 --- a/src/microcode/bitstr.c +++ b/src/microcode/bitstr.c @@ -273,6 +273,8 @@ Returns true iff the two bit strings contain the same bits.") long i; \ SCHEME_OBJECT *scan1, *scan2; \ PRIMITIVE_HEADER (2); \ + CHECK_ARG (1, BIT_STRING_P); \ + CHECK_ARG (2, BIT_STRING_P); \ bit_string_1 = (ARG_REF (1)); \ bit_string_2 = (ARG_REF (2)); \ if ((BIT_STRING_LENGTH (bit_string_1)) != \ diff --git a/tests/runtime/test-bit-string.scm b/tests/runtime/test-bit-string.scm index 7bbd4d594..10371937e 100644 --- a/tests/runtime/test-bit-string.scm +++ b/tests/runtime/test-bit-string.scm @@ -34,65 +34,47 @@ USA. (define-test 'bit-string-move!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-move! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) + (bit-string-move! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) (define-test 'bit-string-movec!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-movec! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) + (bit-string-movec! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) (define-test 'bit-string-or!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-or! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) + (bit-string-or! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) (define-test 'bit-string-and!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-and! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) + (bit-string-and! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) (define-test 'bit-string-andc!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-andc! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) + (bit-string-andc! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) (define-test 'bit-string-xor!/type-error (lambda () (let ((x (no-op #f))) - (expect-error + (assert-error (lambda () - (assert-error - (lambda () - (bit-string-xor! x (make-bit-string 64 #f))) - (list condition-type:wrong-type-argument))) - (list condition-type:hardware-trap))))) \ No newline at end of file + (bit-string-xor! x (make-bit-string 64 #f))) + (list condition-type:wrong-type-argument))))) \ No newline at end of file -- 2.25.1