[Pkg-gnupg-commit] [gnupg2] 100/292: gpgscm: Improve path handling.

[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 dff266059813d22d1e2ba7e77279999cd41ceb75
Author: Justus Winter <justus at g10code.com>
Date:   Fri Oct 7 12:53:25 2016 +0200

    gpgscm: Improve path handling.
    
    * tests/gpgscm/ffi.c (ffi_init): New Scheme variable '*win32*'.
    * tests/gpgscm/tests.scm (canonical-path): Correctly handle paths with
    drive letter on Windows.  Use 'path-join'.
    (path-expand): Use 'path-join'.
    
    Signed-off-by: Justus Winter <justus at g10code.com>
---
 tests/gpgscm/ffi.c     |  9 +++++++++
 tests/gpgscm/tests.scm | 12 +++++++++---
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index 44db6bb..a0fbe2e 100644
--- a/tests/gpgscm/ffi.c
+++ b/tests/gpgscm/ffi.c
@@ -1276,6 +1276,15 @@ ffi_init (scheme *sc, const char *argv0, const char *scriptname,
   ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ':'));
 #endif
 
+  ffi_define (sc, "*win32*",
+#if _WIN32
+              sc->T
+#else
+              sc->F
+#endif
+              );
+
+
   ffi_define (sc, "*stdin*",
               sc->vptr->mk_port_from_file (sc, stdin, port_input));
   ffi_define (sc, "*stdout*",
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 71ca369..8986a70 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -181,9 +181,15 @@
 (assert (string=? (path-join "" "bar" "baz") "bar/baz"))
 
 (define (canonical-path path)
-  (if (char=? #\/ (string-ref path 0))
+  (if (or (char=? #\/ (string-ref path 0))
+	  (and *win32* (char=? #\\ (string-ref path 0)))
+	  (and *win32*
+	       (char-alphabetic? (string-ref path 0))
+	       (char=? #\: (string-ref path 1))
+	       (or (char=? #\/ (string-ref path 2))
+		   (char=? #\\ (string-ref path 2)))))
       path
-      (string-append (getcwd) "/" path)))
+      (path-join (getcwd) path)))
 
 (define (in-srcdir . names)
   (canonical-path (apply path-join (cons (getenv "srcdir") names))))
@@ -194,7 +200,7 @@
   (let loop ((path paths))
     (if (null? path)
 	(throw "Could not find" name "in" paths)
-	(let* ((qualified-name (string-append (car path) "/" name))
+	(let* ((qualified-name (path-join (car path) name))
 	       (file-exists (call-with-input-file qualified-name
 			      (lambda (x) #t))))
 	  (if file-exists

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