source: project/release/4/message-digest/trunk/tests/run.scm @ 34373

Last change on this file since 34373 was 34373, checked in by Kon Lovett, 3 years ago

add raw-update to prim, use raw-update for mmapped/in-mem file md

File size: 10.3 KB
Line 
1;;;; message-digest-test.scm
2
3;; Issues
4;;
5;; - Needs many more tests, especially the entire input-port & procedure source stuff.
6
7(use test)
8(use message-digest message-digest-port)
9(use files lolevel srfi-4)
10(use setup-api)
11
12;;
13
14(define (ashexstr s)
15        (apply string-append
16                (map
17                        (lambda (c) (number->string (char->integer c) 16))
18                        (string->list s))) )
19
20(define simple-src "ab cd")
21(define simple-res (ashexstr simple-src))
22
23(define digest-length 5)
24(define context-size 10)
25(define block-length 64)
26
27(define-constant BLOCK-LENGTH-DEFAULT 4)
28
29(define short-test-filename "alpha.txt")
30
31;;
32
33(test-begin "Message Digest")
34
35;
36(test 'hex-string (message-digest-result-form 'hex))
37
38;Tests defaults
39(test-group "Chunk Read (port)"
40  (let ((siz (message-digest-chunk-size))
41        (in (open-input-file short-test-filename)))
42    (let ((rdr ((message-digest-chunk-port-read-maker) in)))
43      (let ((res (rdr)))
44        (test-assert "First chunk type" (blob? res))
45        (test "First chunk size" 26 (blob-size res)) )
46      (test-assert "No more chunk" (not (rdr))) )
47    (close-input-port in) )
48)
49
50(test-group "Make Primitive"
51
52  (define (init ctx) (void))
53  (define (update ctx bytes count) (void))
54  (define (final ctx result) (void))
55
56  (let ((mdp (make-message-digest-primitive context-size digest-length init update final)))
57    (test-assert (message-digest-primitive? mdp))
58    (test context-size (message-digest-primitive-context-info mdp))
59    (test digest-length (message-digest-primitive-digest-length mdp))
60    (test init (message-digest-primitive-init mdp))
61    (test update (message-digest-primitive-update mdp))
62    (test final (message-digest-primitive-final mdp))
63    (test BLOCK-LENGTH-DEFAULT (message-digest-primitive-block-length mdp))
64    (test-assert (symbol? (message-digest-primitive-name mdp))) )
65
66  ;; don't bother testing the non-optional arguments again
67
68  (let ((mdp (make-message-digest-primitive context-size digest-length init update final 'foo)))
69    (test BLOCK-LENGTH-DEFAULT (message-digest-primitive-block-length mdp))
70    (test 'foo (message-digest-primitive-name mdp)) )
71
72  (let ((mdp (make-message-digest-primitive context-size digest-length init update final block-length)))
73    (test block-length (message-digest-primitive-block-length mdp))
74    (test-assert (symbol? (message-digest-primitive-name mdp))) )
75
76  (let ((mdp (make-message-digest-primitive context-size digest-length init update final block-length 'foo)))
77    (test block-length (message-digest-primitive-block-length mdp))
78    (test 'foo (message-digest-primitive-name mdp)) )
79)
80
81;These also test the update-string proc
82(test-group "Proper Phase Arguments (Def Alloc)"
83
84        (define the-ctx #f)
85
86  (define (init ctx)
87    ;(printf "  Init Ctx: ~S~%" ctx)
88    (assert (pointer? ctx))
89    (set! the-ctx ctx) )
90
91  (define (update ctx bytes count)
92        ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count)
93    (assert (pointer? ctx))
94    (assert (eq? ctx the-ctx))
95    (assert (blob? bytes))
96    (assert (<= count (blob-size bytes)))
97    (assert (>= context-size count))  ; So no mem overflow
98    (move-memory! bytes ctx count) )
99
100  (define (final ctx result)
101    ;(printf " Final Ctx: ~S Result: ~S~%" ctx result)
102    (assert (pointer? ctx))
103    (assert (eq? ctx the-ctx))
104    (assert (blob? result))
105    (assert (= digest-length (blob-size result)))  ; So no mem overflow
106    (move-memory! ctx result digest-length) )
107
108  (let ((mdp (make-message-digest-primitive context-size digest-length init update final)))
109    (let ((md (initialize-message-digest mdp)))
110      (test-assert (message-digest? md))
111      (test-assert (message-digest-update-string md simple-src))
112      (test simple-res (finalize-message-digest md)) ) )
113)
114
115(test-group "Proper Phase Arguments (Own Alloc)"
116
117        (define the-ctx #f)
118
119  (define (make-context) (make-blob context-size))
120
121  (define (init ctx)
122    #;(printf "  Init Ctx: ~S~%" ctx)
123    (assert (blob? ctx))
124    (set! the-ctx ctx) )
125
126  (define (update ctx bytes count)
127    ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count) (flush-output)
128    (assert (blob? ctx))
129    (assert (eq? ctx the-ctx))
130    (assert (blob? bytes))
131    (assert (<= count (blob-size bytes)))
132    (assert (>= context-size count))  ; So no mem overflow
133    (move-memory! bytes ctx count) )
134
135  (define (final ctx result)
136    ;(printf " Final Result Size: ~S Ctx: ~S Result: ~S~%" (blob-size result) ctx result) (flush-output)
137    (assert (blob? ctx))
138    (assert (eq? ctx the-ctx))
139    (assert (blob? result))
140    (assert (= digest-length (blob-size result)))  ; So no mem overflow
141    (move-memory! ctx result digest-length) )
142
143  (let ((mdp (make-message-digest-primitive make-context digest-length init update final)))
144    (let ((md (initialize-message-digest mdp)))
145      (test-assert (message-digest? md))
146      (test-assert (message-digest-update-string md simple-src))
147      (test simple-res (finalize-message-digest md)) ) )
148)
149
150(let ()
151
152  (define (make-context)
153    ;Init to 0 necessary since digest-length is possibly > than
154    ;the input size! (Actually just needs to be a known value,
155    ;`(integer->char #xff)' would work as well.)
156    (string->blob (make-string context-size #\nul)) )
157
158  (define (init ctx) (void))
159
160  (define (update ctx bytes count)
161    ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count) (flush-output)
162    (assert (>= context-size count))  ; So no mem overflow
163    (move-memory! bytes ctx count) )
164
165  (define (final ctx result)
166    ;(printf " Final Result Size: ~S Ctx: ~S Result: ~S~%" (blob-size result) ctx result) (flush-output)
167    (assert (= digest-length (blob-size result)))  ; So no mem overflow
168    (move-memory! ctx result digest-length) )
169
170  (define mdp (make-message-digest-primitive make-context digest-length init update final))
171
172  (test-group "u8vector Source"
173    (let ((md (initialize-message-digest mdp)))
174      (test-assert (message-digest-update-u8vector md (u8vector 1 2 3 4 5)))
175      (test "0102030405" (finalize-message-digest md)) )
176  )
177
178  (test-group "u8 Source"
179    (let ((md (initialize-message-digest mdp)))
180      (test-assert (message-digest-update-u8 md #xA2))
181      (test "a200000000" (finalize-message-digest md)) )
182  )
183
184  (test-group "u16-le Source"
185    (let ((md (initialize-message-digest mdp)))
186      (test-assert (message-digest-update-u16-le md #xA2B2))
187      (test "b2a2000000" (finalize-message-digest md)) )
188  )
189
190  (test-group "u32-be Source"
191    (let ((md (initialize-message-digest mdp)))
192      (test-assert (message-digest-update-u32-be md 1073741823))
193      (test "3fffffff00" (finalize-message-digest md)) )
194  )
195
196  (when (version>=? (chicken-version) "4.6.4")
197          (test-group "u32-be Source"
198                        (let ((md (initialize-message-digest mdp)))
199                                (test-assert (message-digest-update-u32-be md #xA2B2C2D2))
200                                (test "a2b2c2d200" (finalize-message-digest md)) )
201                ) )
202
203  (when (version>=? (chicken-version) "4.8.1")
204                (test-group "u64-be Source"
205                        (let ((md (initialize-message-digest mdp)))
206                                (test-assert (message-digest-update-u64-be md #xAB54A98CEB1F0AD2))
207                                (test
208                                  (substring "ab54a98ceb1f0ad2" 0 (fx* 2 (fxmin 8 digest-length)))
209                                  (finalize-message-digest md)) )
210                ) )
211
212  (test-group "char-u8 Source"
213    (let ((md (initialize-message-digest mdp)))
214      (test-assert (message-digest-update-char-u8 md #\space))
215      (test "2000000000" (finalize-message-digest md)) )
216  )
217
218  (test-group "char-be Source"
219    (let ((md (initialize-message-digest mdp)))
220      (test-assert (message-digest-update-char-be md #\u0003BB))
221      (test "000003bb00" (finalize-message-digest md)) )
222  )
223
224  (test-group "char-le Source"
225    (let ((md (initialize-message-digest mdp)))
226      (test-assert (message-digest-update-char-le md #\u0003BB))
227      (test "bb03000000" (finalize-message-digest md)) )
228  )
229
230  (test-group "Procedure Source"
231    (define just-once
232      (let ((x #t))
233        (lambda ()
234          (let ((res (and x simple-src)))
235            (set! x #f)
236            res ) ) ) )
237    (let ((md (initialize-message-digest mdp)))
238      (test-assert (message-digest-update-procedure md just-once))
239      (test simple-res (finalize-message-digest md)) )
240  )
241
242  (test-group "Port"
243    (let ((port (open-output-digest mdp)))
244      (test-assert (output-port? port))
245      (display simple-src port) ;cannot be readable!
246      (test simple-res (get-output-digest port))
247      (test-assert (port-closed? port)) )
248  )
249)
250
251#; ;REMOVED
252(begin
253        (use message-digest-old)
254
255  (define (make-context)
256    (string->blob (make-string context-size #\nul)) )
257
258  (define (init ctx) (void))
259
260  (define (update ctx bytes count)
261    (assert (>= context-size count))  ; So no mem overflow
262    (move-memory! bytes ctx count) )
263
264  (define (final ctx result)
265    (assert (= digest-length (blob-size result)))  ; So no mem overflow
266    (move-memory! ctx result digest-length) )
267
268  (test-group "Primitive Apply (DEPRECATED)"
269    (let ((mdp (make-message-digest-primitive context-size digest-length init update final)))
270      (let ((res (message-digest-primitive-apply mdp simple-src)))
271        (test-assert (string? res))
272        (test simple-res (byte-string->hexadecimal res)) ) )
273  )
274
275  (test-group "Make (DEPRECATED)"
276    (test simple-src (make-binary-message-digest simple-src make-context digest-length init update final))
277    (test simple-res (make-message-digest simple-src make-context digest-length init update final))
278  )
279)
280
281;
282(test-group "Chunk Read (fileno)"
283
284  (define (init ctx)
285    ;(printf "  Init Ctx: ~S~%" ctx)
286    (assert (pointer? ctx)) )
287
288  (define (update ctx bytes count)
289        ;(printf "Update Ctx: ~S Count: ~S Bytes: ~S~%" ctx count bytes)
290    (assert (pointer? ctx))
291    (assert (not (not bytes)))
292    (assert (<= context-size count))
293    (move-memory! bytes ctx (min context-size count)) )
294
295  (define (raw-update ctx bytes count)
296        ;(printf "Raw-Update Ctx: ~S Count: ~S Bytes: ~S~%" ctx count bytes)
297    (assert (pointer? ctx))
298    (assert (not (not bytes)))
299    (assert (<= context-size count))
300    (move-memory! bytes ctx (min context-size count)) )
301
302  (define (final ctx result)
303    ;(printf " Final Ctx: ~S Length: ~S Result: ~S~%" ctx digest-length result)
304    (assert (pointer? ctx))
305    (assert (not (not result)))
306    (assert (<= 0 digest-length))
307    (move-memory! ctx result digest-length) )
308
309  (let ((mdp (make-message-digest-primitive context-size digest-length init update final raw-update)))
310    (test "6162636465" (message-digest-file mdp short-test-filename 'hex-string)) )
311)
312
313(test-end)
314
315(test-exit)
Note: See TracBrowser for help on using the repository browser.