source: project/release/5/message-digest-primitive/trunk/tests/message-digest-primitive-test.scm

Last change on this file was 36724, checked in by Kon Lovett, 2 years ago

add init & update test, add mem bug (?) test
-This line, and those below, will be ignored--

M message-digest-primitive/trunk/tests/message-digest-primitive-test.scm

File size: 7.4 KB
Line 
1;;;;message-digest-primitive-test.scm  -*- Scheme -*-
2;;;;Kon Lovett, Jul '18
3
4(import test)
5
6(test-begin "Message Digest Primitive")
7
8;;;
9
10(import message-digest-primitive)
11
12;;
13
14(import (chicken blob))
15
16;;
17
18(define (ashexstr s)
19        (apply string-append
20                (map
21                        (lambda (c) (number->string (char->integer c) 16))
22                        (string->list s))) )
23
24(define simple-src "ab cd")
25(define simple-res (ashexstr simple-src))
26
27(define-constant DIGEST-LENGTH 5)
28(define-constant CONTEXT-SIZE 10)
29(define-constant BLOCK-LENGTH 64)
30
31(define-constant BLOCK-LENGTH-DEFAULT 4)
32
33(define SHORT-TEST-FILE-NAME "alpha.txt")
34(define SHORT-TEST-FILE-LENGTH 26)
35
36(define just-once
37  (let ((x #t))
38    (lambda ()
39      (let (
40        (res (and x simple-src)) )
41        (set! x #f)
42        res ) ) ) )
43
44;FIXME add (mock-*-primitive ...) that wraps the supplied phase procedures
45
46;;
47
48(test-group "Make Primitive"
49
50        (define the-ctx #f)
51
52  (define (init ctx)
53    (set! the-ctx ctx) )
54
55  (define (update ctx bytes count)
56    (assert (eq? ctx the-ctx))
57    (assert (not (not bytes)))
58    (assert (< 0 count))
59    (void) )
60
61  (define (final ctx result)
62    (assert (eq? ctx the-ctx))
63    (assert (not (not result)))
64    (void) )
65
66  (let (
67    (mdp (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final)) )
68    (test-assert (message-digest-primitive? mdp))
69    (test CONTEXT-SIZE (message-digest-primitive-context-info mdp))
70    (test DIGEST-LENGTH (message-digest-primitive-digest-length mdp))
71    (test init (message-digest-primitive-init mdp))
72    (test update (message-digest-primitive-update mdp))
73    (test final (message-digest-primitive-final mdp))
74    (test BLOCK-LENGTH-DEFAULT (message-digest-primitive-block-length mdp))
75    (test-assert (symbol? (message-digest-primitive-name mdp))) )
76
77  ;;don't bother testing the non-optional arguments again
78
79  (let (
80    (mdp
81      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final #:name 'foo)) )
82    (test BLOCK-LENGTH-DEFAULT (message-digest-primitive-block-length mdp))
83    (test 'foo (message-digest-primitive-name mdp)) )
84
85  (let (
86    (mdp
87      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final #:block-length BLOCK-LENGTH)) )
88    (test BLOCK-LENGTH (message-digest-primitive-block-length mdp))
89    (test-assert (symbol? (message-digest-primitive-name mdp))) )
90
91  (let (
92    (mdp
93      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final #:block-length BLOCK-LENGTH #:name 'foo)) )
94    (test BLOCK-LENGTH (message-digest-primitive-block-length mdp))
95    (test 'foo (message-digest-primitive-name mdp)) )
96)
97
98;These also test the update-string proc
99(test-group "Proper Phase Arguments (Def Alloc)"
100
101        (define the-ctx #f)
102
103  (define (init ctx)
104    ;(printf "  Init Ctx: ~S~%" ctx)
105    (set! the-ctx ctx)
106    (assert (pointer? ctx)) )
107
108  (define (update ctx bytes count)
109        ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count)
110    (assert (eq? ctx the-ctx))
111    (assert (not (not bytes)))
112    (assert (< 0 count))
113    (assert (<= count CONTEXT-SIZE))  ;So no mem overflow
114    (assert (pointer? ctx))
115    (assert (blob? bytes))
116    (assert (<= count (blob-size bytes)))
117    (move-memory! bytes ctx count) )
118
119  (define (final ctx result)
120    ;(printf " Final Ctx: ~S Result: ~S~%" ctx result)
121    (assert (eq? ctx the-ctx))
122    (assert (not (not result)))
123    (assert (pointer? ctx))
124    (assert (or (blob? result) (string? result)))
125    ;So no mem overflow
126    (assert (<= DIGEST-LENGTH (if (blob? result) (blob-size result) (string-length result))))
127    (move-memory! ctx result DIGEST-LENGTH) )
128
129  (let* (
130    (mdp (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final))
131    (ctx (make-message-digest-primitive-context mdp)) )
132    (test-assert "allocated context" ctx)
133    ;FIXME Add Life-Cycle Tests
134    )
135)
136
137(test-group "Proper Phase Arguments (Own Alloc)"
138
139        (define the-ctx #f)
140
141  (define (make-context)
142    (make-blob CONTEXT-SIZE) )
143
144  (define (init ctx)
145    ;(printf "  Init Ctx: ~S~%" ctx)
146    (set! the-ctx ctx)
147    (assert (blob? ctx)) )
148
149  (define (update ctx bytes count)
150    ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count) (flush-output)
151    (assert (eq? ctx the-ctx))
152    (assert (not (not bytes)))
153    (assert (< 0 count))
154    (assert (<= count CONTEXT-SIZE))  ;So no mem overflow
155    (assert (blob? ctx))
156    (assert (blob? bytes))
157    (assert (<= count (blob-size bytes)))
158    (move-memory! bytes ctx count) )
159
160  (define (final ctx result)
161    ;(printf " Final Result Size: ~S Ctx: ~S Result: ~S~%" (blob-size result) ctx result) (flush-output)
162    (assert (eq? ctx the-ctx))
163    (assert (not (not result)))
164    (assert (blob? ctx))
165    (assert (blob? result))
166    (assert (<= (blob-size result) DIGEST-LENGTH))  ;So no mem overflow
167    (move-memory! ctx result DIGEST-LENGTH) )
168
169  (let* (
170    (mdp (make-message-digest-primitive make-context DIGEST-LENGTH init update final))
171    (ctx (make-message-digest-primitive-context mdp)) )
172    (test-assert "allocated context" ctx)
173    ;FIXME Add Life-Cycle Tests
174    )
175)
176
177;uses foreign
178#+compiling
179(begin
180  (import (chicken foreign) (chicken memory))
181  (test-group "Raw => Cooked"
182
183    (define the-ctx #f)
184
185    (define (init ctx)
186      ;(printf "  Init Ctx: ~S~%" ctx)
187      (set! the-ctx ctx)
188      (assert (pointer? ctx)) )
189
190    (define raw-update
191      (foreign-lambda* void ((c-pointer pctx) (c-pointer pdat) (unsigned-int n))
192        "memmove( pctx, pdat, n );"))
193
194    (define (final ctx result)
195      ;(printf " Final Ctx: ~S Result: ~S~%" ctx result)
196      (assert (eq? ctx the-ctx))
197      (assert (not (not result)))
198      (assert (pointer? ctx))
199      (assert (or (blob? result) (string? result)))
200      ;So no mem overflow
201      (assert (<= DIGEST-LENGTH (if (blob? result) (blob-size result) (string-length result))))
202      (move-memory! ctx result DIGEST-LENGTH) )
203
204    (let* (
205      (mdp (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init #f final #:raw-update raw-update))
206      (ctx (make-message-digest-primitive-context mdp)) )
207      (test-assert "allocated context" (pointer? ctx))
208      (test-assert "initialize" ((message-digest-primitive-init mdp) ctx))
209      (test "initialize worked" the-ctx ctx)
210      (test-assert "generated update" (procedure? (message-digest-primitive-update mdp)))
211      (test-assert "update" ((message-digest-primitive-update mdp) ctx "foobar" 3))
212      (test "update worked" #\f (integer->char (pointer-u8-ref ctx)))
213      ;FIXME bugs in chicken memory ?
214      (test-assert "BUG?: @ptr != @(ptr + 0)" (not (equal? (pointer->address ctx) (pointer->address (pointer+ ctx 0)))))
215      ;
216      ;(print "@+0: " (+ (pointer->address ctx) 0))
217      ;(print "@+0<->: " (pointer->address (address->pointer (+ (pointer->address ctx) 0))))
218      ;
219      ;Error: segmentation violation
220      ;(test-assert (pointer-u8-ref (address->pointer (+ (pointer->address ctx) 0))))
221      ;
222      ;(test "f[oo]" #\f (integer->char (pointer-u8-ref (address->pointer (+ (pointer->address ctx) 0)))))
223      ;
224      ;(print (pointer->address ctx))
225      ;(print (pointer->address (pointer+ ctx 0)))
226      ;(print (pointer->address (pointer+ ctx 1)))
227      ;(print (pointer->address (pointer+ ctx 2)))
228      ;
229      ;(test "f[oo]" #\f (integer->char (pointer-u8-ref (pointer+ ctx 0))))
230      ;(test "fo[o]" #\o (integer->char (pointer-u8-ref (pointer+ ctx 1))))
231      ;(test "foo[]" #\o (integer->char (pointer-u8-ref (pointer+ ctx 2))))
232    )
233  )
234)
235
236;;;
237
238(test-end "Message Digest Primitive")
239
240(test-exit)
Note: See TracBrowser for help on using the repository browser.