ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pk-crypto: Add 'canonical-sexp-length' and related procedures.

Browse source 
* guix/pk-crypto.scm (canonical-sexp-length, canonical-sexp-null?,
  canonical-sexp-list?): New procedures.
* tests/pk-crypto.scm ("canonical-sexp-length", "canonical-sexp-list?"):
  New tests.
This commit is contained in:
Ludovic Courtès 2013-12-28 15:47:35 +01:00
parent a2cbbb743d
commit 363ae1da82
2 changed files with 32 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
guix/pk-crypto.scm
View file

@ -32,6 +32,9 @@ (define-module (guix pk-crypto)
canonical-sexp-cdr
canonical-sexp-nth
canonical-sexp-nth-data
canonical-sexp-length
canonical-sexp-null?
canonical-sexp-list?
bytevector->hash-data
hash-data->bytevector
sign
@ -156,6 +159,14 @@ (define (dereference-size_t p)
0 (native-endianness)
(sizeof size_t)))
(define canonical-sexp-length
(let* ((ptr (libgcrypt-func "gcry_sexp_length"))
(proc (pointer->procedure int ptr '(*))))
(lambda (sexp)
"Return the length of SEXP if it's a list (including the empty list);
return zero if SEXP is an atom."
(proc (canonical-sexp->pointer sexp)))))
(define token-string?
(let ((token-cs (char-set-union char-set:digit
char-set:letter
@ -263,4 +274,13 @@ (define find-sexp-token
#f
(pointer->canonical-sexp res))))))
(define-inlinable (canonical-sexp-null? sexp)
"Return #t if SEXP is the empty-list sexp."
(null-pointer? (canonical-sexp->pointer sexp)))
(define (canonical-sexp-list? sexp)
"Return #t if SEXP is a list."
(or (canonical-sexp-null? sexp)
(> (canonical-sexp-length sexp) 0)))
;;; pk-crypto.scm ends here

12
tests/pk-crypto.scm
View file

@ -82,6 +82,18 @@ (define %key-pair
(gc)
(test-equal "canonical-sexp-length"
'(0 1 2 4 0 0)
(map (compose canonical-sexp-length string->canonical-sexp)
'("()" "(a)" "(a b)" "(a #616263# b #C001#)" "a" "#123456#")))
(test-equal "canonical-sexp-list?"
'(#t #f #t #f)
(map (compose canonical-sexp-list? string->canonical-sexp)
'("()" "\"abc\"" "(a b c)" "#123456#")))
(gc)
(test-equal "canonical-sexp-car + cdr"
'("(b \n (c xyz)\n )")
(let ((lst (string->canonical-sexp "(a (b (c xyz)))")))