Changeset 35320 in project


Ignore:
Timestamp:
03/22/18 04:07:44 (5 weeks ago)
Author:
kon
Message:

use csi+csc test runner, add types

Location:
release/4/ripemd/trunk
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/ripemd/trunk/ripemd.scm

    r34381 r35320  
    33;;;; Kon Lovett, Aug '10
    44
     5;; Issues
     6
    57(module ripemd
    68
     
    1113(import scheme chicken foreign)
    1214(use message-digest-primitive)
     15
     16;;;
     17
     18(define-type message-digest-primitive (struct message-digest-primitive))
    1319
    1420;;;
     
    143149(define init128
    144150  (foreign-lambda* void ((c-pointer ctx)) "ripemdX_init( &MDinit128, ctx );"))
     151
    145152(define update128
    146153  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer obj) (int len))
    147154    "ripemdX_update( &compress128, ctx, obj, len );"))
     155
    148156(define final128
    149157  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer result))
    150158    "ripemdX_final( &MDfinish128, result, ctx, RMD128hshsiz );"))
     159
    151160(define raw-update128
    152161  (foreign-lambda* void ((c-pointer ctx) (c-pointer obj) (int len))
    153162    "ripemdX_update( &compress128, ctx, obj, len );"))
    154163
     164;;
     165
     166(: ripemd128-primitive (-> message-digest-primitive))
     167;
    155168(define ripemd128-primitive
    156169  (let ((the-prim #f))
    157170    (lambda ()
    158       (or the-prim
    159           (begin
    160             (set! the-prim
    161                   (make-message-digest-primitive
    162                     context-size128 digest-length128
    163                     init128 update128 final128
    164                     block-length128 'ripemd128-primitive
    165                     raw-update128))
    166             the-prim ) ) ) ) )
     171      (or
     172        the-prim
     173        (begin
     174          (set!
     175            the-prim
     176            (make-message-digest-primitive
     177              context-size128 digest-length128
     178              init128 update128 final128
     179              block-length128 'ripemd128-primitive
     180              raw-update128))
     181          the-prim ) ) ) ) )
    167182
    168183;;;
     
    175190  (foreign-lambda* void ((c-pointer ctx))
    176191    "ripemdX_init( &MDinit160, ctx );"))
     192
    177193(define update160
    178194  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer obj) (int len))
    179195    "ripemdX_update( &compress160, ctx, obj, len );"))
     196
    180197(define final160
    181198  (foreign-lambda* void ((c-pointer ctx) (scheme-pointer result))
    182199    "ripemdX_final( &MDfinish160, result, ctx, RMD160hshsiz );"))
     200
    183201(define raw-update160
    184202  (foreign-lambda* void ((c-pointer ctx) (c-pointer obj) (int len))
    185203    "ripemdX_update( &compress160, ctx, obj, len );"))
    186204
     205;;
     206
     207(: ripemd160-primitive (-> message-digest-primitive))
     208;
    187209(define ripemd160-primitive
    188210  (let ((the-prim #f))
    189211    (lambda ()
    190       (or the-prim
    191           (begin
    192             (set! the-prim
    193                   (make-message-digest-primitive
    194                     context-size160 digest-length160
    195                     init160 update160 final160
    196                     block-length160 'ripemd160-primitive
    197                     raw-update160))
    198             the-prim ) ) ) ) )
     212      (or
     213        the-prim
     214        (begin
     215          (set!
     216            the-prim
     217            (make-message-digest-primitive
     218              context-size160 digest-length160
     219              init160 update160 final160
     220              block-length160 'ripemd160-primitive
     221              raw-update160))
     222          the-prim ) ) ) ) )
    199223
    200224) ;module ripemd
  • release/4/ripemd/trunk/ripemd.setup

    r34381 r35320  
    55(verify-extension-name "ripemd")
    66
    7 (setup-shared-extension-module 'ripemd (extension-version "1.2.0")
     7(setup-shared-extension-module 'ripemd (extension-version "1.3.0")
     8        #:types? #t
    89  #:compile-options '(
    910    -fixnum-arithmetic
  • release/4/ripemd/trunk/tests/run.scm

    r26397 r35320  
    1 (use ripemd message-digest test)
    2 (use srfi-13)
    31
    4 (define (ripemd128-digest obj)
    5   (message-digest-object (ripemd128-primitive) obj 'hex) )
     2(define EGG-NAME "ripemd")
    63
    7 (define (ripemd160-digest obj)
    8   (message-digest-object (ripemd160-primitive) obj 'hex) )
     4;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    95
    10 (test-begin "RIPE-MD")
     6(use files)
    117
    12 (test-group "128 bits"
    13   (test "cdf26213a150dc3ecb610f18f6b38b46" (ripemd128-digest ""))
    14   (test "86be7afa339d0fc7cfc785e72f578d33" (ripemd128-digest "a"))
    15   (test "c14a12199c66e4ba84636b0f69144c77" (ripemd128-digest "abc"))
    16   (test "9e327b3d6e523062afc1132d7df9d1b8" (ripemd128-digest "message digest"))
    17   (test "fd2aa607f71dc8f510714922b371834e" (ripemd128-digest "abcdefghijklmnopqrstuvwxyz"))
    18   (test "a1aa0689d0fafa2ddc22e88b49133a06" (ripemd128-digest "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"))
    19   (test "d1e959eb179c911faea4624c60c5c702" (ripemd128-digest "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))
    20   (test "3f45ef194732c2dbb2c4a2c769795fa3" (ripemd128-digest "12345678901234567890123456789012345678901234567890123456789012345678901234567890"))
    21 )
     8;no -disable-interrupts
     9(define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    2210
    23 (test-group "160 bits"
    24         ;See http://www.cosic.esat.kuleuven.be/nessie/
    25         (test-group "NESSIE Strings"
    26                 (test "S1.0" "9c1185a5c5e9fc54612808977ee8f548b2258d31" (message-digest-string (ripemd160-primitive) ""))
    27                 (test "S1.1" "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe" (message-digest-string (ripemd160-primitive) "a"))
    28                 (test "S1.2" "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc" (message-digest-string (ripemd160-primitive) "abc"))
    29                 (test "S1.3" "5d0689ef49d2fae572b881b123a85ffa21595f36" (message-digest-string (ripemd160-primitive) "message digest"))
    30                 (test "S1.4" "f71c27109c692c1b56bbdceb5b9d2865b3708dbc" (message-digest-string (ripemd160-primitive) "abcdefghijklmnopqrstuvwxyz"))
    31                 (test "S1.5" "12a053384a9c0c88e405a06c27dcf49ada62eb2b" (message-digest-string (ripemd160-primitive) "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"))
    32                 (test "S1.6" "b0e20b6e3116640286ed3a87a5713079b21f5189" (message-digest-string (ripemd160-primitive) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))
    33                 (let ((tstr "1234567890"))
    34                         (test "S1.7" "9b752e45573d4b39f4dbd3323cab82bf63326bfb" (message-digest-string (ripemd160-primitive) (xsubstring tstr 0 (* 8 (string-length tstr))))) )
    35         )
     11(define *args* (argv))
    3612
    37         (test-group "byte-vector"
    38                 (test "9c1185a5c5e9fc54612808977ee8f548b2258d31" (ripemd160-digest (string->blob "")))
    39                 (test "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe" (ripemd160-digest (string->blob "a")))
    40         )
    41 )
     13(define (test-name #!optional (eggnam EGG-NAME))
     14  (string-append eggnam "-test") )
    4215
    43 (test-end)
     16(define (egg-name #!optional (def EGG-NAME))
     17  (cond
     18    ((<= 4 (length *args*))
     19      (cadddr *args*) )
     20    (def
     21      def )
     22    (else
     23      (error 'test "cannot determine egg-name") ) ) )
    4424
    45 (test-exit)
     25;;;
     26
     27(set! EGG-NAME (egg-name))
     28
     29(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
     30  (let ((tstnam (test-name eggnam)))
     31    (print "*** csi ***")
     32    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
     33    (newline)
     34    (print "*** csc (" cscopts ") ***")
     35    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
     36    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     37
     38(define (run-tests eggnams #!optional (cscopts *csc-options*))
     39  (for-each (cut run-test <> cscopts) eggnams) )
     40
     41;;;
     42
     43(run-test)
Note: See TracChangeset for help on using the changeset viewer.