[Pkg-gnupg-commit] [gnupg2] 32/116: tests, w32: Fix locating the components.

[Daniel Kahn Gillmor]

This is an automated email from the git hooks/post-receive script.

dkg pushed a commit to branch master
in repository gnupg2.

commit 28e149609da44fab600f6a11b385d1c8ca8e7eb9
Author: Justus Winter <justus at g10code.com>
Date:   Wed Jan 4 16:54:41 2017 +0100

    tests,w32: Fix locating the components.
    
    * tests/openpgp/defs.scm (percent-decode): New function.
    (bin-prefix): New variable.
    (installed?): Likewise.
    (tool-hardcoded): Use the new variables.
    (gpg-conf): Use the new function to decode the values.
    (gpg-components): Do not use '--build-prefix' when 'installed?'.
    
    Signed-off-by: Justus Winter <justus at g10code.com>
---
 tests/openpgp/defs.scm | 38 +++++++++++++++++++++++++++++---------
 1 file changed, 29 insertions(+), 9 deletions(-)

diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
index 3280d7c..863d128 100644
--- a/tests/openpgp/defs.scm
+++ b/tests/openpgp/defs.scm
@@ -81,6 +81,21 @@
 	default
 	value)))
 
+(define (percent-decode s)
+  (define (decode c)
+    (if (and (> (length c) 2) (char=? #\% (car c)))
+	(integer->char (string->number (string #\# #\x (cadr c) (caddr c))))
+	#f))
+  (let loop ((i 0) (c (string->list s)) (r (make-string (string-length s))))
+    (if (null? c)
+	(substring r 0 i)
+	(let ((decoded (decode c)))
+	  (string-set! r i (if decoded decoded (car c)))
+	  (loop (+ 1 i) (if decoded (cdddr c) (cdr c)) r)))))
+(assert (equal? (percent-decode "") ""))
+(assert (equal? (percent-decode "%61") "a"))
+(assert (equal? (percent-decode "foob%61r") "foobar"))
+
 (define tools
   '((gpgv "GPGV" "g10/gpgv")
     (gpg-connect-agent "GPG_CONNECT_AGENT" "tools/gpg-connect-agent")
@@ -91,25 +106,30 @@
     (gpg-zip "GPGZIP" "tools/gpg-zip")
     (pinentry "PINENTRY" "tests/openpgp/fake-pinentry")))
 
+(define bin-prefix (getenv "BIN_PREFIX"))
+(define installed? (not (string=? "" bin-prefix)))
+
 (define (tool-hardcoded which)
-  (let ((t (assoc which tools))
-	(prefix (getenv "BIN_PREFIX")))
+  (let ((t (assoc which tools)))
     (getenv' (cadr t)
-	     (qualify (if (string=? prefix "")
-			  (string-append (getenv "objdir") "/" (caddr t))
-			  (string-append prefix "/" (basename (caddr t))))))))
+	     (qualify (if installed?
+			  (string-append bin-prefix "/" (basename (caddr t)))
+			  (string-append (getenv "objdir") "/" (caddr t)))))))
 
 (define (gpg-conf . args)
   (let ((s (call-popen `(,(tool-hardcoded 'gpgconf) , at args) "")))
-    (map (lambda (line) (string-split line #\:))
+    (map (lambda (line) (map percent-decode (string-split line #\:)))
 	 (string-split-newlines s))))
 (define :gc:c:name car)
 (define :gc:c:description cadr)
 (define :gc:c:pgmname caddr)
 
-(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t)
-(define gpg-components (gpg-conf '--build-prefix (getenv "objdir")
-				 '--list-components))
+(unless installed?
+	(setenv "GNUPG_BUILDDIR" (getenv "objdir") #t))
+(define gpg-components (apply gpg-conf
+			`(,@(if installed? '()
+				(list '--build-prefix (getenv "objdir")))
+			  --list-components)))
 
 (define (tool which)
   (case which

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git