contrib/sb-md5/md5-tests.lisp

   1 (defpackage #:sb-md5-tests
   2   (:use #:sb-md5 #:cl #:sb-rt))
   3 (in-package #:sb-md5-tests)
   4
   5 (defun byte-array-to-hex-string (bytevec)
   6   (format nil "~(~{~2,'0X~}~)" (coerce bytevec 'list)))
   7
   8 (defun one-shot-test (string)
   9   (md5sum-string string :external-format :ascii))
  10
  11 (defun incremental-test (string)
  12   (let ((bytevec (sb-ext:string-to-octets string :external-format :ascii))
  13         (state (sb-md5:make-md5-state)))
  14     (dotimes (i (length bytevec) (sb-md5:finalize-md5-state state))
  15       (sb-md5:update-md5-state state bytevec :start i :end (1+ i)))))
  16
  17 (defun fill-pointer-test (string)
  18   (let* ((bytevec (sb-ext:string-to-octets string :external-format :ascii))
  19          (fillvec (let ((x (make-array (* 2 (length bytevec))
  20                                        :fill-pointer 0
  21                                        :element-type '(unsigned-byte 8))))
  22                     (dotimes (i (length bytevec) x)
  23                       (vector-push (aref bytevec i) x)))))
  24     (sb-md5:md5sum-sequence fillvec)))
  25
  26 (eval-when (:compile-toplevel :load-toplevel :execute)
  27 (defun tests-for-test-suite (basename index string expected-result)
  28   (loop for (test-kind testfun) in '(("ONE-SHOT" one-shot-test)
  29                                      ("INCREMENTAL" incremental-test)
  30                                      ("FILL-POINTER" fill-pointer-test))
  31      collect `(deftest ,(intern (format nil "~A.~A.~A" basename test-kind index))
  32                   (string= (byte-array-to-hex-string (funcall ',testfun ,string))
  33                            ,expected-result)
  34                 t) into test-forms
  35        finally (return `(progn ,@test-forms))))
  36 ) ; EVAL-WHEN
  37
  38 (macrolet
  39     ((define-rfc1321-tests (test-list)
  40          `(progn
  41            ,@(loop for i upfrom 0
  42                    for (string . expected-result) in test-list
  43                    collect (tests-for-test-suite "SB-MD5.RFC1321" i string expected-result)))))
  44   (define-rfc1321-tests
  45       (("" . "d41d8cd98f00b204e9800998ecf8427e")
  46        ("a" ."0cc175b9c0f1b6a831c399e269772661")
  47        ("abc" . "900150983cd24fb0d6963f7d28e17f72")
  48        ("message digest" . "f96b697d7cb7938d525a2f31aaf161d0")
  49        ("abcdefghijklmnopqrstuvwxyz" . "c3fcd3d76192e4007dfb496cca67e13b")
  50        ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" . "d174ab98d277d9f5a5611c2c9f419d9f")
  51        ("12345678901234567890123456789012345678901234567890123456789012345678901234567890" . "57edf4a22be3c955ac49da2e2107b67a"))))
  52
  53 (macrolet
  54     ((define-other-tests (test-list)
  55          `(progn
  56            ,@(loop for i upfrom 0
  57                    for (string . expected-result) in test-list
  58                    collect (tests-for-test-suite "SB-MD5.OTHER" i string expected-result)))))
  59   (define-other-tests
  60       (;; From padding bug report by Edi Weitz
  61        ("1631901HERR BUCHHEISTERCITROEN NORD1043360796beckenbauer" . "d734945e5930bb28859ccd13c830358b")
  62        ;; Test padding for strings from 0 to 69*8 bits in size.
  63        ("" . "d41d8cd98f00b204e9800998ecf8427e")
  64        ("a" . "0cc175b9c0f1b6a831c399e269772661")
  65        ("aa" . "4124bc0a9335c27f086f24ba207a4912")
  66        ("aaa" . "47bce5c74f589f4867dbd57e9ca9f808")
  67        ("aaaa" . "74b87337454200d4d33f80c4663dc5e5")
  68        ("aaaaa" . "594f803b380a41396ed63dca39503542")
  69        ("aaaaaa" . "0b4e7a0e5fe84ad35fb5f95b9ceeac79")
  70        ("aaaaaaa" . "5d793fc5b00a2348c3fb9ab59e5ca98a")
  71        ("aaaaaaaa" . "3dbe00a167653a1aaee01d93e77e730e")
  72        ("aaaaaaaaa" . "552e6a97297c53e592208cf97fbb3b60")
  73        ("aaaaaaaaaa" . "e09c80c42fda55f9d992e59ca6b3307d")
  74        ("aaaaaaaaaaa" . "d57f21e6a273781dbf8b7657940f3b03")
  75        ("aaaaaaaaaaaa" . "45e4812014d83dde5666ebdf5a8ed1ed")
  76        ("aaaaaaaaaaaaa" . "c162de19c4c3731ca3428769d0cd593d")
  77        ("aaaaaaaaaaaaaa" . "451599a5f9afa91a0f2097040a796f3d")
  78        ("aaaaaaaaaaaaaaa" . "12f9cf6998d52dbe773b06f848bb3608")
  79        ("aaaaaaaaaaaaaaaa" . "23ca472302f49b3ea5592b146a312da0")
  80        ("aaaaaaaaaaaaaaaaa" . "88e42e96cc71151b6e1938a1699b0a27")
  81        ("aaaaaaaaaaaaaaaaaa" . "2c60c24e7087e18e45055a33f9a5be91")
  82        ("aaaaaaaaaaaaaaaaaaa" . "639d76897485360b3147e66e0a8a3d6c")
  83        ("aaaaaaaaaaaaaaaaaaaa" . "22d42eb002cefa81e9ad604ea57bc01d")
  84        ("aaaaaaaaaaaaaaaaaaaaa" . "bd049f221af82804c5a2826809337c9b")
  85        ("aaaaaaaaaaaaaaaaaaaaaa" . "ff49cfac3968dbce26ebe7d4823e58bd")
  86        ("aaaaaaaaaaaaaaaaaaaaaaa" . "d95dbfee231e34cccb8c04444412ed7d")
  87        ("aaaaaaaaaaaaaaaaaaaaaaaa" . "40edae4bad0e5bf6d6c2dc5615a86afb")
  88        ("aaaaaaaaaaaaaaaaaaaaaaaaa" . "a5a8bfa3962f49330227955e24a2e67c")
  89        ("aaaaaaaaaaaaaaaaaaaaaaaaaa" . "ae791f19bdf77357ff10bb6b0e97e121")
  90        ("aaaaaaaaaaaaaaaaaaaaaaaaaaa" . "aaab9c59a88bf0bdfcb170546c5459d6")
  91        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b0f0545856af1a340acdedce23c54b97")
  92        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "f7ce3d7d44f3342107d884bfa90c966a")
  93        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "59e794d45697b360e18ba972bada0123")
  94        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "3b0845db57c200be6052466f87b2198a")
  95        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "5eca9bd3eb07c006cd43ae48dfde7fd3")
  96        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b4f13cb081e412f44e99742cb128a1a5")
  97        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "4c660346451b8cf91ef50f4634458d41")
  98        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "11db24dc3f6c2145701db08625dd6d76")
  99        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "80dad3aad8584778352c68ab06250327")
 100        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "1227fe415e79db47285cb2689c93963f")
 101        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "8e084f489f1bdf08c39f98ff6447ce6d")
 102        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "08b2f2b0864bac1ba1585043362cbec9")
 103        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "4697843037d962f62a5a429e611e0f5f")
 104        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "10c4da18575c092b486f8ab96c01c02f")
 105        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "af205d729450b663f48b11d839a1c8df")
 106        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "0d3f91798fac6ee279ec2485b25f1124")
 107        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "4c3c7c067634daec9716a80ea886d123")
 108        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "d1e358e6e3b707282cdd06e919f7e08c")
 109        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "8c6ded4f0af86e0a7e301f8a716c4363")
 110        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "4c2d8bcb02d982d7cb77f649c0a2dea8")
 111        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "bdb662f765cd310f2a547cab1cfecef6")
 112        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "08ff5f7301d30200ab89169f6afdb7af")
 113        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "6eb6a030bcce166534b95bc2ab45d9cf")
 114        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "1bb77918e5695c944be02c16ae29b25e")
 115        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b6fe77c19f0f0f4946c761d62585bfea")
 116        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "e9e7e260dce84ffa6e0e7eb5fd9d37fc")
 117        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "eced9e0b81ef2bba605cbc5e2e76a1d0")
 118        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "ef1772b6dff9a122358552954ad0df65")
 119        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "3b0c8ac703f828b04c6c197006d17218")
 120        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "652b906d60af96844ebd21b674f35e93")
 121        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "dc2f2f2462a0d72358b2f99389458606")
 122        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "762fc2665994b217c52c3c2eb7d9f406")
 123        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "cc7ed669cf88f201c3297c6a91e1d18d")
 124        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "cced11f7bbbffea2f718903216643648")
 125        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "24612f0ce2c9d2cf2b022ef1e027a54f")
 126        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "b06521f39153d618550606be297466d5")
 127        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "014842d480b571495a4a0363793f7367")
 128        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "c743a45e0d2e6a95cb859adae0248435")
 129        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "def5d97e01e1219fb2fc8da6c4d6ba2f")
 130        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "92cb737f8687ccb93022fdb411a77cca")
 131        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "a0d1395c7fb36247bfe2d49376d9d133")
 132        ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" . "ab75504250558b788f99d1ebd219abf2"))))
 133
 134 (deftest sb-md5.md5sum-file.0
 135     (let ((file
 136            (loop with ret
 137                  for filename = (format nil "md5-test-~6,'0D" (random 100000))
 138                  do (with-open-file (stream filename :direction :output
 139                                             :if-exists nil
 140                                             :if-does-not-exist :create)
 141                       (when stream
 142                         (setf ret stream)))
 143                  when ret return ret)))
 144       (unwind-protect
 145           (string= (format nil "~(~{~2,'0X~}~)"
 146                            (coerce (md5sum-file file) 'list))
 147                    "d41d8cd98f00b204e9800998ecf8427e")
 148         (delete-file file)))
 149       t)
 150
 151 (deftest sb-md5.md5sum-sequence.error.0
 152     (handler-case (md5sum-sequence "foo")
 153       (type-error () :good))
 154   :good)