mirror of
git://git.gnupg.org/gnupg.git
synced 2025-01-03 12:11:33 +01: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:
parent
5afbfdfd59
commit
dff2660598
@ -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*",
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user