From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 3 Dec 2018 09:19:01 +0000 (+0000)
Subject: Add missing type checks to some bit string operations.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~51
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3464b8d226f6ea8f84681cbaea4442876969b026;p=mit-scheme.git

Add missing type checks to some bit string operations.
---

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