1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-07-02 22:46:30 +02:00

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@g10code.com>
This commit is contained in:
Justus Winter 2016-10-07 12:53:25 +02:00
parent 5afbfdfd59
commit dff2660598
2 changed files with 18 additions and 3 deletions

View file

@ -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