mirror of
git://git.gnupg.org/gnupg.git
synced 2024-12-22 10:19:57 +01:00
gpgscm: Improve library functions.
* tests/gpgscm/tests.scm (absolute-path?): New function. (canonical-path): Use the new function. * tests/gpgscm/lib.scm (string-split-pln): New function. (string-indexp, string-splitp): Likewise. (string-splitn): Express using the above function. (string-ltrim, string-rtrim): Fix corner case. (list->string-reversed): New function. (read-line): Fix performance. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
ab3cdeb441
commit
e3876f16eb
@ -86,18 +86,47 @@
|
|||||||
(assert (equal? #f (string-rindex "Hallo" #\a 2)))
|
(assert (equal? #f (string-rindex "Hallo" #\a 2)))
|
||||||
(assert (equal? #f (string-rindex "Hallo" #\.)))
|
(assert (equal? #f (string-rindex "Hallo" #\.)))
|
||||||
|
|
||||||
;; Split haystack at delimiter at most n times.
|
;; Split HAYSTACK at each character that makes PREDICATE true at most
|
||||||
(define (string-splitn haystack delimiter n)
|
;; N times.
|
||||||
|
(define (string-split-pln haystack predicate lookahead n)
|
||||||
(let ((length (string-length haystack)))
|
(let ((length (string-length haystack)))
|
||||||
(define (split acc delimiter offset n)
|
(define (split acc offset n)
|
||||||
(if (>= offset length)
|
(if (>= offset length)
|
||||||
(reverse acc)
|
(reverse acc)
|
||||||
(let ((i (string-index haystack delimiter offset)))
|
(let ((i (lookahead haystack offset)))
|
||||||
(if (or (eq? i #f) (= 0 n))
|
(if (or (eq? i #f) (= 0 n))
|
||||||
(reverse (cons (substring haystack offset length) acc))
|
(reverse (cons (substring haystack offset length) acc))
|
||||||
(split (cons (substring haystack offset i) acc)
|
(split (cons (substring haystack offset i) acc)
|
||||||
delimiter (+ i 1) (- n 1))))))
|
(+ i 1) (- n 1))))))
|
||||||
(split '() delimiter 0 n)))
|
(split '() 0 n)))
|
||||||
|
|
||||||
|
(define (string-indexp haystack offset predicate)
|
||||||
|
(cond
|
||||||
|
((= (string-length haystack) offset)
|
||||||
|
#f)
|
||||||
|
((predicate (string-ref haystack offset))
|
||||||
|
offset)
|
||||||
|
(else
|
||||||
|
(string-indexp haystack (+ 1 offset) predicate))))
|
||||||
|
|
||||||
|
;; Split HAYSTACK at each character that makes PREDICATE true at most
|
||||||
|
;; N times.
|
||||||
|
(define (string-splitp haystack predicate n)
|
||||||
|
(string-split-pln haystack predicate
|
||||||
|
(lambda (haystack offset)
|
||||||
|
(string-indexp haystack offset predicate))
|
||||||
|
n))
|
||||||
|
(assert (equal? '("a" "b") (string-splitp "a b" char-whitespace? -1)))
|
||||||
|
(assert (equal? '("a" "b") (string-splitp "a\tb" char-whitespace? -1)))
|
||||||
|
(assert (equal? '("a" "" "b") (string-splitp "a \tb" char-whitespace? -1)))
|
||||||
|
|
||||||
|
;; Split haystack at delimiter at most n times.
|
||||||
|
(define (string-splitn haystack delimiter n)
|
||||||
|
(string-split-pln haystack
|
||||||
|
(lambda (c) (char=? c delimiter))
|
||||||
|
(lambda (haystack offset)
|
||||||
|
(string-index haystack delimiter offset))
|
||||||
|
n))
|
||||||
(assert (= 2 (length (string-splitn "foo:bar:baz" #\: 1))))
|
(assert (= 2 (length (string-splitn "foo:bar:baz" #\: 1))))
|
||||||
(assert (string=? "foo" (car (string-splitn "foo:bar:baz" #\: 1))))
|
(assert (string=? "foo" (car (string-splitn "foo:bar:baz" #\: 1))))
|
||||||
(assert (string=? "bar:baz" (cadr (string-splitn "foo:bar:baz" #\: 1))))
|
(assert (string=? "bar:baz" (cadr (string-splitn "foo:bar:baz" #\: 1))))
|
||||||
@ -122,25 +151,32 @@
|
|||||||
;; Trim the prefix of S containing only characters that make PREDICATE
|
;; Trim the prefix of S containing only characters that make PREDICATE
|
||||||
;; true.
|
;; true.
|
||||||
(define (string-ltrim predicate s)
|
(define (string-ltrim predicate s)
|
||||||
|
(if (string=? s "")
|
||||||
|
""
|
||||||
(let loop ((s' (string->list s)))
|
(let loop ((s' (string->list s)))
|
||||||
(if (predicate (car s'))
|
(if (predicate (car s'))
|
||||||
(loop (cdr s'))
|
(loop (cdr s'))
|
||||||
(list->string s'))))
|
(list->string s')))))
|
||||||
|
(assert (string=? "" (string-ltrim char-whitespace? "")))
|
||||||
(assert (string=? "foo" (string-ltrim char-whitespace? " foo")))
|
(assert (string=? "foo" (string-ltrim char-whitespace? " foo")))
|
||||||
|
|
||||||
;; Trim the suffix of S containing only characters that make PREDICATE
|
;; Trim the suffix of S containing only characters that make PREDICATE
|
||||||
;; true.
|
;; true.
|
||||||
(define (string-rtrim predicate s)
|
(define (string-rtrim predicate s)
|
||||||
|
(if (string=? s "")
|
||||||
|
""
|
||||||
(let loop ((s' (reverse (string->list s))))
|
(let loop ((s' (reverse (string->list s))))
|
||||||
(if (predicate (car s'))
|
(if (predicate (car s'))
|
||||||
(loop (cdr s'))
|
(loop (cdr s'))
|
||||||
(list->string (reverse s')))))
|
(list->string (reverse s'))))))
|
||||||
|
(assert (string=? "" (string-rtrim char-whitespace? "")))
|
||||||
(assert (string=? "foo" (string-rtrim char-whitespace? "foo ")))
|
(assert (string=? "foo" (string-rtrim char-whitespace? "foo ")))
|
||||||
|
|
||||||
;; Trim both the prefix and suffix of S containing only characters
|
;; Trim both the prefix and suffix of S containing only characters
|
||||||
;; that make PREDICATE true.
|
;; that make PREDICATE true.
|
||||||
(define (string-trim predicate s)
|
(define (string-trim predicate s)
|
||||||
(string-ltrim predicate (string-rtrim predicate s)))
|
(string-ltrim predicate (string-rtrim predicate s)))
|
||||||
|
(assert (string=? "" (string-trim char-whitespace? "")))
|
||||||
(assert (string=? "foo" (string-trim char-whitespace? " foo ")))
|
(assert (string=? "foo" (string-trim char-whitespace? " foo ")))
|
||||||
|
|
||||||
;; Check if needle is contained in haystack.
|
;; Check if needle is contained in haystack.
|
||||||
@ -162,19 +198,34 @@
|
|||||||
(apply read-char p)
|
(apply read-char p)
|
||||||
'()))))))
|
'()))))))
|
||||||
|
|
||||||
|
(define (list->string-reversed lst)
|
||||||
|
(let* ((len (length lst))
|
||||||
|
(str (make-string len)))
|
||||||
|
(let loop ((i (- len 1))
|
||||||
|
(l lst))
|
||||||
|
(if (< i 0)
|
||||||
|
(begin
|
||||||
|
(assert (null? l))
|
||||||
|
str)
|
||||||
|
(begin
|
||||||
|
(string-set! str i (car l))
|
||||||
|
(loop (- i 1) (cdr l)))))))
|
||||||
|
|
||||||
;; Read a line from port P.
|
;; Read a line from port P.
|
||||||
(define (read-line . p)
|
(define (read-line . p)
|
||||||
(list->string
|
(let loop ((acc '()))
|
||||||
(let f ()
|
|
||||||
(let ((c (apply peek-char p)))
|
(let ((c (apply peek-char p)))
|
||||||
(cond
|
(cond
|
||||||
((eof-object? c) '())
|
((eof-object? c)
|
||||||
|
(if (null? acc)
|
||||||
|
c ;; #eof
|
||||||
|
(list->string-reversed acc)))
|
||||||
((char=? c #\newline)
|
((char=? c #\newline)
|
||||||
(apply read-char p)
|
(apply read-char p)
|
||||||
'())
|
(list->string-reversed acc))
|
||||||
(else
|
(else
|
||||||
(apply read-char p)
|
(apply read-char p)
|
||||||
(cons c (f))))))))
|
(loop (cons c acc)))))))
|
||||||
|
|
||||||
;; Read everything from port P.
|
;; Read everything from port P.
|
||||||
(define (read-all . p)
|
(define (read-all . p)
|
||||||
|
@ -186,16 +186,19 @@
|
|||||||
(assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
|
(assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
|
||||||
(assert (string=? (path-join "" "bar" "baz") "bar/baz"))
|
(assert (string=? (path-join "" "bar" "baz") "bar/baz"))
|
||||||
|
|
||||||
(define (canonical-path path)
|
;; Is PATH an absolute path?
|
||||||
(if (or (char=? #\/ (string-ref path 0))
|
(define (absolute-path? path)
|
||||||
|
(or (char=? #\/ (string-ref path 0))
|
||||||
(and *win32* (char=? #\\ (string-ref path 0)))
|
(and *win32* (char=? #\\ (string-ref path 0)))
|
||||||
(and *win32*
|
(and *win32*
|
||||||
(char-alphabetic? (string-ref path 0))
|
(char-alphabetic? (string-ref path 0))
|
||||||
(char=? #\: (string-ref path 1))
|
(char=? #\: (string-ref path 1))
|
||||||
(or (char=? #\/ (string-ref path 2))
|
(or (char=? #\/ (string-ref path 2))
|
||||||
(char=? #\\ (string-ref path 2)))))
|
(char=? #\\ (string-ref path 2))))))
|
||||||
path
|
|
||||||
(path-join (getcwd) path)))
|
;; Make PATH absolute.
|
||||||
|
(define (canonical-path path)
|
||||||
|
(if (absolute-path? path) path (path-join (getcwd) path)))
|
||||||
|
|
||||||
(define (in-srcdir . names)
|
(define (in-srcdir . names)
|
||||||
(canonical-path (apply path-join (cons (getenv "srcdir") names))))
|
(canonical-path (apply path-join (cons (getenv "srcdir") names))))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user