Add missing type checks to some bit string operations.
authorTaylor R Campbell <campbell@mumble.net>
Mon, 3 Dec 2018 09:19:01 +0000 (09:19 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Mon, 3 Dec 2018 09:19:01 +0000 (09:19 +0000)
src/microcode/bitstr.c
tests/runtime/test-bit-string.scm

index e011d2e9926f62258d0c4d78a6c6c69d254a89b2..056b184a05296268a5def8b38d18325e1eb33b6e 100644 (file)
@@ -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)) !=                            \
index 7bbd4d59460f7360e504aef4e479357a74698208..10371937e4282c493c6863f5ca5af7405d503449 100644 (file)
@@ -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