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

@ -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*",

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