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

Last change on this file since 36722 was 36722, checked in by kon, 9 months ago

add raw -> cooked

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