1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: test.lisp
;;;; Purpose: Regression tests for cl-base64
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jan 2003
;;;;
;;;; $Id$
;;;; *************************************************************************
(in-package #:cl-user)
(defpackage #:cl-base64/test
(:use #:cl #:kmrcl #:cl-base64 #:ptester))
(in-package #:cl-base64/test)
(defun test-valid-input (exp input)
(test exp (base64-string-to-usb8-array input) :test #'equalp))
(defun test-broken-input (arg)
(let ((.hole. (make-broadcast-stream)))
(test-error (base64-string-to-usb8-array arg)
:condition-type 'base64-error
:include-subtypes t)
(test-error (base64-string-to-string arg)
:condition-type 'base64-error
:include-subtypes t)
(test-error (base64-string-to-integer arg)
:condition-type 'base64-error
:include-subtypes t)
(test-error (base64-string-to-stream arg :stream .hole.)
:condition-type 'base64-error
:include-subtypes t)
(test-error (with-input-from-string (in arg)
(base64-stream-to-usb8-array in))
:condition-type 'base64-error
:include-subtypes t)
(test-error (with-input-from-string (in arg)
(base64-stream-to-string in))
:condition-type 'base64-error
:include-subtypes t)
(test-error (with-input-from-string (in arg)
(base64-stream-to-stream in :stream .hole.))
:condition-type 'base64-error
:include-subtypes t)
(test-error (with-input-from-string (in arg)
(base64-stream-to-integer in))
:condition-type 'base64-error
:include-subtypes t)))
(defun test-valid ()
(test-valid-input #(0) "AA==")
(test-valid-input #(0 0) "AAA=")
(test-valid-input #(0 0 0) "AAAA")
(test-valid-input #(0) " A A = = ")
(test-valid-input #(0 0) " A A A = ")
(test-valid-input #(0 0 0) " A A A A "))
(defun test-broken-1 ()
(test-broken-input "A")
(test-broken-input "AA")
(test-broken-input "AAA")
(test-broken-input "AA=")
(test-broken-input "A==")
(test-broken-input "A===")
(test-broken-input "AA===")
(test-broken-input "AAA===")
(test-broken-input "AAA==")
(test-broken-input "A=A")
(test-broken-input "AA=A")
(test-broken-input "AAA=A")
(test-broken-input "A==A"))
(defun test-broken-2 ()
(flet ((test-invalid-char (char)
(test-broken-input (format nil "~C" char))
(test-broken-input (format nil "A~C" char))
(test-broken-input (format nil "AA~C" char))
(test-broken-input (format nil "AAA~C" char))
(test-broken-input (format nil "AAAA~C" char))
(test-broken-input (format nil "AAA=~C" char))
(test-broken-input (format nil "AA==~C" char))))
(test-invalid-char #\$)
(test-invalid-char (code-char 0))
(test-invalid-char (code-char 256))))
(defun do-tests (&key ((:break-on-failures *break-on-test-failures*) nil))
(with-tests (:name "cl-base64 tests")
(test-valid)
(test-broken-1)
(test-broken-2)
(do* ((length 0 (+ 3 length))
(string (make-string length) (make-string length))
(usb8 (make-usb8-array length) (make-usb8-array length))
(integer (random (expt 10 length)) (random (expt 10 length))))
((>= length 300))
(dotimes (i length)
(declare (fixnum i))
(let ((code (random 256)))
(setf (schar string i) (code-char code))
(setf (aref usb8 i) code)))
(do* ((columns 0 (+ columns 4)))
((> columns length))
;; Test against cl-base64 routines
(test integer (base64-string-to-integer
(integer-to-base64-string integer :columns columns)))
(test string (base64-string-to-string
(string-to-base64-string string :columns columns))
:test #'string=)
(test usb8 (base64-string-to-usb8-array
(usb8-array-to-base64-string usb8))
:test #'equalp)
;; Test against AllegroCL built-in routines
#+allegro
(progn
(test integer (excl:base64-string-to-integer
(integer-to-base64-string integer :columns columns)))
(test integer (base64-string-to-integer
(excl:integer-to-base64-string integer)))
(test (string-to-base64-string string :columns columns)
(excl:usb8-array-to-base64-string usb8
(if (zerop columns)
nil
columns))
:test #'string=)
(test string (base64-string-to-string
(excl:usb8-array-to-base64-string
usb8
(if (zerop columns)
nil
columns)))
:test #'string=)))))
t)
(defun time-routines (&key (iterations nil)
(length 256)
(padding 0))
(assert (zerop (rem length 4)) (length))
(assert (<= 0 padding 2) (padding))
(let* ((str (make-string length :initial-element #\q))
(usb8 (map '(simple-array (unsigned-byte 8) (*)) #'char-code str))
(int 12345678901234567890)
(n (or iterations (ceiling (* 32 1024 1024) length))))
(loop for i downfrom (1- length)
repeat padding
do (setf (aref str i) #\=))
(time-iterations 50000 (integer-to-base64-string int))
(time-iterations n (string-to-base64-string str))
(time-iterations n (usb8-array-to-base64-string usb8))
(let ((displaced (make-array (length str)
:displaced-to str
:element-type (array-element-type str)))
(base (coerce str 'simple-base-string)))
(time-iterations n (base64-string-to-usb8-array displaced))
(time-iterations n (base64-string-to-usb8-array str))
(time-iterations n (base64-string-to-usb8-array base)))
#+allegro
(progn
(time-iterations n (excl:integer-to-base64-string int))
(time-iterations n (excl:usb8-array-to-base64-string usb8)))))
;;#+run-test (test-base64)
|
