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

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

add message-digest-result-form, dep message-digest-default-result-type. per alvarom@… email Chicken 4.8.0.5 has prob w/ sym consts.

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