[Pkg-gnupg-commit] [gnupg2] 29/160: gpgscm: Use native string searching functions.
Daniel Kahn Gillmor
dkg at fifthhorseman.net
Fri Jul 15 09:36:33 UTC 2016
This is an automated email from the git hooks/post-receive script.
dkg pushed a commit to branch upstream
in repository gnupg2.
commit 5fbbc4b334a73150e709a4802cac99abd8ada61d
Author: Justus Winter <justus at g10code.com>
Date: Tue Jun 21 12:12:56 2016 +0200
gpgscm: Use native string searching functions.
* tests/gpgscm/ffi-private.h: Handle character arguments.
* tests/gpgscm/ffi.c (do_string_index): New function.
(do_string_rindex): Likewise.
(do_string_contains): Likewise.
(ffi_init): Define new functions.
* tests/gpgscm/ffi.scm (ffi-define): New macro.
* tests/gpgscm/lib.scm (string-index): Use native function,
demonstrate behavior.
(string-rindex): Likewise.
(string-contains?): Likewise.
Demonstrate behavior of various other functions.
(read-all): Rework so that it can handle large files.
Signed-off-by: Justus Winter <justus at g10code.com>
---
tests/gpgscm/ffi-private.h | 2 ++
tests/gpgscm/ffi.c | 69 +++++++++++++++++++++++++++++++++++++
tests/gpgscm/ffi.scm | 4 +++
tests/gpgscm/lib.scm | 86 +++++++++++++++++++++++-----------------------
4 files changed, 118 insertions(+), 43 deletions(-)
diff --git a/tests/gpgscm/ffi-private.h b/tests/gpgscm/ffi-private.h
index 5467dac..849d1b7 100644
--- a/tests/gpgscm/ffi-private.h
+++ b/tests/gpgscm/ffi-private.h
@@ -33,6 +33,7 @@ int ffi_bool_value (scheme *sc, pointer p);
#define CONVERSION_number(SC, X) (SC)->vptr->ivalue (X)
#define CONVERSION_string(SC, X) (SC)->vptr->string_value (X)
+#define CONVERSION_character(SC, X) (SC)->vptr->charvalue (X)
#define CONVERSION_list(SC, X) (X)
#define CONVERSION_bool(SC, X) ffi_bool_value ((SC), (X))
#define CONVERSION_path(SC, X) (((SC)->vptr->is_string (X) \
@@ -41,6 +42,7 @@ int ffi_bool_value (scheme *sc, pointer p);
#define IS_A_number(SC, X) (SC)->vptr->is_number (X)
#define IS_A_string(SC, X) (SC)->vptr->is_string (X)
+#define IS_A_character(SC, X) (SC)->vptr->is_character (X)
#define IS_A_list(SC, X) (SC)->vptr->is_list ((SC), X)
#define IS_A_bool(SC, X) ((X) == (SC)->F || (X) == (SC)->T)
#define IS_A_path(SC, X) ((SC)->vptr->is_string (X) \
diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index babf1e1..fe418fc 100644
--- a/tests/gpgscm/ffi.c
+++ b/tests/gpgscm/ffi.c
@@ -939,6 +939,72 @@ do_splice (scheme *sc, pointer args)
FFI_RETURN (sc);
}
+static pointer
+do_string_index (scheme *sc, pointer args)
+{
+ FFI_PROLOG ();
+ char *haystack;
+ char needle;
+ ssize_t offset = 0;
+ char *position;
+ FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
+ FFI_ARG_OR_RETURN (sc, char, needle, character, args);
+ if (args != sc->NIL)
+ {
+ FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args);
+ if (offset < 0)
+ return ffi_sprintf (sc, "offset must be positive");
+ if (offset > strlen (haystack))
+ return ffi_sprintf (sc, "offset exceeds haystack");
+ }
+ FFI_ARGS_DONE_OR_RETURN (sc, args);
+
+ position = strchr (haystack+offset, needle);
+ if (position)
+ FFI_RETURN_INT (sc, position - haystack);
+ else
+ FFI_RETURN_POINTER (sc, sc->F);
+}
+
+static pointer
+do_string_rindex (scheme *sc, pointer args)
+{
+ FFI_PROLOG ();
+ char *haystack;
+ char needle;
+ ssize_t offset = 0;
+ char *position;
+ FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
+ FFI_ARG_OR_RETURN (sc, char, needle, character, args);
+ if (args != sc->NIL)
+ {
+ FFI_ARG_OR_RETURN (sc, ssize_t, offset, number, args);
+ if (offset < 0)
+ return ffi_sprintf (sc, "offset must be positive");
+ if (offset > strlen (haystack))
+ return ffi_sprintf (sc, "offset exceeds haystack");
+ }
+ FFI_ARGS_DONE_OR_RETURN (sc, args);
+
+ position = strrchr (haystack+offset, needle);
+ if (position)
+ FFI_RETURN_INT (sc, position - haystack);
+ else
+ FFI_RETURN_POINTER (sc, sc->F);
+}
+
+static pointer
+do_string_contains (scheme *sc, pointer args)
+{
+ FFI_PROLOG ();
+ char *haystack;
+ char *needle;
+ FFI_ARG_OR_RETURN (sc, char *, haystack, string, args);
+ FFI_ARG_OR_RETURN (sc, char *, needle, string, args);
+ FFI_ARGS_DONE_OR_RETURN (sc, args);
+ FFI_RETURN_POINTER (sc, strstr (haystack, needle) ? sc->T : sc->F);
+}
+
gpg_error_t
ffi_list2argv (scheme *sc, pointer list, char ***argv, size_t *len)
@@ -1134,6 +1200,9 @@ ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
/* Test helper functions. */
ffi_define_function (sc, file_equal);
ffi_define_function (sc, splice);
+ ffi_define_function (sc, string_index);
+ ffi_define_function (sc, string_rindex);
+ ffi_define_function_name (sc, "string-contains?", string_contains);
/* User interface. */
ffi_define_function (sc, flush_stdio);
diff --git a/tests/gpgscm/ffi.scm b/tests/gpgscm/ffi.scm
index d0b8a99..7c2f93a 100644
--- a/tests/gpgscm/ffi.scm
+++ b/tests/gpgscm/ffi.scm
@@ -38,3 +38,7 @@
(write (cons (string->symbol name) args) args')
(throw (string-append
(get-output-string args') ": " message))))
+
+;; Pseudo-definitions for foreign functions. Evaluates to no code,
+;; but serves as documentation.
+(macro (ffi-define form))
diff --git a/tests/gpgscm/lib.scm b/tests/gpgscm/lib.scm
index 871cc8f..48f53ea 100644
--- a/tests/gpgscm/lib.scm
+++ b/tests/gpgscm/lib.scm
@@ -55,48 +55,50 @@
(string-length s)))))
(assert (string-suffix? "Scheme" "eme"))
-;; Locate the first occurrence of needle in haystack.
-(define (string-index haystack needle)
- (define (index i haystack needle)
- (if (= (length haystack) 0)
- #f
- (if (char=? (car haystack) needle)
- i
- (index (+ i 1) (cdr haystack) needle))))
- (index 0 (string->list haystack) needle))
-
-;; Locate the last occurrence of needle in haystack.
-(define (string-rindex haystack needle)
- (let ((rindex (string-index (list->string (reverse (string->list haystack)))
- needle)))
- (if rindex (- (string-length haystack) rindex 1) #f)))
+;; Locate the first occurrence of needle in haystack starting at offset.
+(ffi-define (string-index haystack needle [offset]))
+(assert (= 2 (string-index "Hallo" #\l)))
+(assert (= 3 (string-index "Hallo" #\l 3)))
+(assert (equal? #f (string-index "Hallo" #\.)))
+
+;; Locate the last occurrence of needle in haystack starting at offset.
+(ffi-define (string-rindex haystack needle [offset]))
+(assert (= 3 (string-rindex "Hallo" #\l)))
+(assert (equal? #f (string-rindex "Hallo" #\a 2)))
+(assert (equal? #f (string-rindex "Hallo" #\.)))
;; Split haystack at delimiter at most n times.
(define (string-splitn haystack delimiter n)
- (define (split acc haystack delimiter n)
- (if (= (string-length haystack) 0)
- (reverse acc)
- (let ((i (string-index haystack delimiter)))
- (if (not (or (eq? i #f) (= 0 n)))
- (split (cons (substring haystack 0 i) acc)
- (substring haystack (+ i 1) (string-length haystack))
- delimiter (- n 1))
- (split (cons haystack acc) "" delimiter 0)
- ))))
- (split '() haystack delimiter n))
+ (let ((length (string-length haystack)))
+ (define (split acc delimiter offset n)
+ (if (>= offset length)
+ (reverse acc)
+ (let ((i (string-index haystack delimiter offset)))
+ (if (or (eq? i #f) (= 0 n))
+ (reverse (cons (substring haystack offset length) acc))
+ (split (cons (substring haystack offset i) acc)
+ delimiter (+ i 1) (- n 1))))))
+ (split '() delimiter 0 n)))
+(assert (= 2 (length (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))))
;; Split haystack at delimiter.
(define (string-split haystack delimiter)
(string-splitn haystack delimiter -1))
+(assert (= 3 (length (string-split "foo:bar:baz" #\:))))
+(assert (string=? "foo" (car (string-split "foo:bar:baz" #\:))))
+(assert (string=? "bar" (cadr (string-split "foo:bar:baz" #\:))))
+(assert (string=? "baz" (caddr (string-split "foo:bar:baz" #\:))))
;; Trim the prefix of S containing only characters that make PREDICATE
-;; true. For example (string-ltrim char-whitespace? " foo") =>
-;; "foo".
+;; true.
(define (string-ltrim predicate s)
(let loop ((s' (string->list s)))
(if (predicate (car s'))
(loop (cdr s'))
(list->string s'))))
+(assert (string=? "foo" (string-ltrim char-whitespace? " foo")))
;; Trim the suffix of S containing only characters that make PREDICATE
;; true.
@@ -105,20 +107,18 @@
(if (predicate (car s'))
(loop (cdr s'))
(list->string (reverse s')))))
+(assert (string=? "foo" (string-rtrim char-whitespace? "foo ")))
;; Trim both the prefix and suffix of S containing only characters
;; that make PREDICATE true.
(define (string-trim predicate s)
(string-ltrim predicate (string-rtrim predicate s)))
+(assert (string=? "foo" (string-trim char-whitespace? " foo ")))
-(define (string-contains? s contained)
- (let loop ((offset 0))
- (if (<= (+ offset (string-length contained)) (string-length s))
- (if (string=? (substring s offset (+ offset (string-length contained)))
- contained)
- #t
- (loop (+ 1 offset)))
- #f)))
+;; Check if needle is contained in haystack.
+(ffi-define (string-contains? haystack needle))
+(assert (string-contains? "Hallo" "llo"))
+(assert (not (string-contains? "Hallo" "olla")))
(define (echo . msg)
(for-each (lambda (x) (display x) (display " ")) msg)
@@ -154,10 +154,10 @@
;; Read everything from port P.
(define (read-all . p)
- (list->string
- (let f ()
- (let ((c (apply peek-char p)))
- (cond
- ((eof-object? c) '())
- (else (apply read-char p)
- (cons c (f))))))))
+ (let loop ((acc (open-output-string)))
+ (let ((c (apply peek-char p)))
+ (cond
+ ((eof-object? c) (get-output-string acc))
+ (else
+ (write-char (apply read-char p) acc)
+ (loop acc))))))
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git
More information about the Pkg-gnupg-commit
mailing list