From c29b90e26f27dcfa7b275964a2b2f60b551def81 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 27 Feb 2017 00:19:53 -0800 Subject: [PATCH] Fix broken unit tests. --- tests/runtime/test-bytevector.scm | 90 ++++++++++++++++++++++++++++++- tests/runtime/test-mime-codec.scm | 4 ++ tests/runtime/test-string.scm | 83 ---------------------------- 3 files changed, 93 insertions(+), 84 deletions(-) diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm index d2de1e891..a15ac631c 100644 --- a/tests/runtime/test-bytevector.scm +++ b/tests/runtime/test-bytevector.scm @@ -321,4 +321,92 @@ USA. (+ (* (cadddr bytes) #x1000000) (* (caddr bytes) #x10000) (* (cadr bytes) #x100) - (car bytes))))) \ No newline at end of file + (car bytes))))) + +;;;; Hexadecimal conversions + +(define (allbytes) + (let ((bv (make-bytevector #x100))) + (do ((i 0 (+ i 1))) + ((not (< i #x100))) + (bytevector-u8-set! bv i i)) + bv)) + +(define (allbytes:lower) + (string-append + "000102030405060708090a0b0c0d0e0f" + "101112131415161718191a1b1c1d1e1f" + "202122232425262728292a2b2c2d2e2f" + "303132333435363738393a3b3c3d3e3f" + "404142434445464748494a4b4c4d4e4f" + "505152535455565758595a5b5c5d5e5f" + "606162636465666768696a6b6c6d6e6f" + "707172737475767778797a7b7c7d7e7f" + "808182838485868788898a8b8c8d8e8f" + "909192939495969798999a9b9c9d9e9f" + "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" + "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" + "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" + "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" + "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" + "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff")) + +(define (allbytes:upper) + (string-append + "000102030405060708090A0B0C0D0E0F" + "101112131415161718191A1B1C1D1E1F" + "202122232425262728292A2B2C2D2E2F" + "303132333435363738393A3B3C3D3E3F" + "404142434445464748494A4B4C4D4E4F" + "505152535455565758595A5B5C5D5E5F" + "606162636465666768696A6B6C6D6E6F" + "707172737475767778797A7B7C7D7E7F" + "808182838485868788898A8B8C8D8E8F" + "909192939495969798999A9B9C9D9E9F" + "A0A1A2A3A4A5A6A7A8A9AAABACADAEAF" + "B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF" + "C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF" + "D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF" + "E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF" + "F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF")) + +(define-test 'hexadecimal->bytevector/lowercase + (lambda () + (assert-equal (hexadecimal->bytevector (allbytes:lower)) (allbytes)))) + +(define-test 'hexadecimal->bytevector/uppercase + (lambda () + (assert-equal (hexadecimal->bytevector (allbytes:upper)) (allbytes)))) + +;; Change this test if you change the case -- and consider whether +;; applications may break if you do. +(define-test 'bytevector->hexadecimal + (lambda () + (assert-equal (bytevector->hexadecimal (allbytes)) (allbytes:upper)))) + +(define-test 'bytevector->hexadecimal/lowercase + (lambda () + (assert-equal (string-downcase (bytevector->hexadecimal (allbytes))) + (allbytes:lower)))) + +(define-test 'bytevector->hexadecimal/uppercase + (lambda () + (assert-equal (string-upcase (bytevector->hexadecimal (allbytes))) + (allbytes:upper)))) + +(define-test 'bytevector->hexadecimal->bytevector + (lambda () + (do ((i 0 (+ i 1))) + ((not (< i #x100))) + (let* ((v (random-bytevector #x100))) + (assert-equal (hexadecimal->bytevector (bytevector->hexadecimal v)) + v))))) + +(define-test 'bytevector->hexadecimal->upper->bytevector + (lambda () + (do ((i 0 (+ i 1))) + ((not (< i #x100))) + (let* ((v (random-bytevector #x100))) + (assert-equal (hexadecimal->bytevector + (string-upcase (bytevector->hexadecimal v))) + v))))) \ No newline at end of file diff --git a/tests/runtime/test-mime-codec.scm b/tests/runtime/test-mime-codec.scm index f6e01aa60..8f1424673 100644 --- a/tests/runtime/test-mime-codec.scm +++ b/tests/runtime/test-mime-codec.scm @@ -58,6 +58,10 @@ USA. (string-set! string i (string-ref text-characters (random n-text)))) string)) +(define (random-byte-vector length) + (object-new-type (microcode-type 'string) + (random-bytevector length))) + (define text-characters (list->string (append '(#\tab #\newline) diff --git a/tests/runtime/test-string.scm b/tests/runtime/test-string.scm index 5c77eaeb0..e721e4236 100644 --- a/tests/runtime/test-string.scm +++ b/tests/runtime/test-string.scm @@ -28,89 +28,6 @@ USA. (declare (usual-integrations)) -(define (allbytes) - (let ((v8b (make-vector-8b #x100))) - (do ((i 0 (+ i 1))) ((>= i #x100)) - (vector-8b-set! v8b i i)) - v8b)) - -(define (allbytes:lower) - (string-append - "000102030405060708090a0b0c0d0e0f" - "101112131415161718191a1b1c1d1e1f" - "202122232425262728292a2b2c2d2e2f" - "303132333435363738393a3b3c3d3e3f" - "404142434445464748494a4b4c4d4e4f" - "505152535455565758595a5b5c5d5e5f" - "606162636465666768696a6b6c6d6e6f" - "707172737475767778797a7b7c7d7e7f" - "808182838485868788898a8b8c8d8e8f" - "909192939495969798999a9b9c9d9e9f" - "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" - "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" - "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" - "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" - "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" - "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff")) - -(define (allbytes:upper) - (string-append - "000102030405060708090A0B0C0D0E0F" - "101112131415161718191A1B1C1D1E1F" - "202122232425262728292A2B2C2D2E2F" - "303132333435363738393A3B3C3D3E3F" - "404142434445464748494A4B4C4D4E4F" - "505152535455565758595A5B5C5D5E5F" - "606162636465666768696A6B6C6D6E6F" - "707172737475767778797A7B7C7D7E7F" - "808182838485868788898A8B8C8D8E8F" - "909192939495969798999A9B9C9D9E9F" - "A0A1A2A3A4A5A6A7A8A9AAABACADAEAF" - "B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF" - "C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF" - "D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF" - "E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF" - "F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF")) - -(define-test 'HEXADECIMAL->VECTOR-8B/LOWERCASE - (lambda () - (assert-equal (allbytes) (hexadecimal->vector-8b (allbytes:lower))))) - -(define-test 'HEXADECIMAL->VECTOR-8B/UPPERCASE - (lambda () - (assert-equal (allbytes) (hexadecimal->vector-8b (allbytes:upper))))) - -;; Change this test if you change the case -- and consider whether -;; applications may break if you do. -(define-test 'VECTOR-8B->HEXADECIMAL - (lambda () - (assert-equal (allbytes:lower) (vector-8b->hexadecimal (allbytes))))) - -(define-test 'VECTOR-8B->HEXADECIMAL/LOWERCASE - (lambda () - (assert-equal (allbytes:lower) - (string-downcase (vector-8b->hexadecimal (allbytes)))))) - -(define-test 'VECTOR-8B->HEXADECIMAL/UPPERCASE - (lambda () - (assert-equal (allbytes:upper) - (string-upcase (vector-8b->hexadecimal (allbytes)))))) - -(define-test 'VECTOR-8B->HEXADECIMAL->VECTOR-8B - (lambda () - (do ((i 0 (+ i 1))) ((>= i #x100)) - (let* ((v (random-byte-vector #x100))) - (assert-equal v - (hexadecimal->vector-8b (vector-8b->hexadecimal v))))))) - -(define-test 'VECTOR-8B->HEXADECIMAL->UPPER->VECTOR-8B - (lambda () - (do ((i 0 (+ i 1))) ((>= i #x100)) - (let* ((v (random-byte-vector #x100))) - (assert-equal v - (hexadecimal->vector-8b - (string-upcase (vector-8b->hexadecimal v)))))))) - ;;;; Tests adapted from the Larceny R7RS test suite: (define-test 'larceny-string -- 2.25.1