From 8270580a5a70874beeffcdd16221937db4bcdc93 Mon Sep 17 00:00:00 2001 From: Justus Winter Date: Tue, 5 Jul 2016 16:25:21 +0200 Subject: tests: Honor environment variable 'TMP'. This fixes problems with long socket names, e.g. when doing distcheck. * tests/gpgscm/tests.scm (path-join): New function. (with-temporary-working-directory): Honor 'TMP'. (make-temporary-file): Likewise. * tests/migrations/Makefile.am (TMP): Default to '/tmp'. (TESTS_ENVIRONMENT): Set 'TMP'. * tests/openpgp/Makefile.am (TMP): Default to '/tmp'. (TESTS_ENVIRONMENT): Set 'TMP'. Signed-off-by: Justus Winter --- tests/gpgscm/tests.scm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'tests/gpgscm') diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm index ebe1be5c6..272881757 100644 --- a/tests/gpgscm/tests.scm +++ b/tests/gpgscm/tests.scm @@ -160,6 +160,18 @@ (sink (open to (logior O_WRONLY O_CREAT) #o600))) (splice source sink))) +(define (path-join . components) + (let loop ((acc #f) (rest (filter (lambda (s) + (not (string=? "" s))) components))) + (if (null? rest) + acc + (loop (if (string? acc) + (string-append acc "/" (car rest)) + (car rest)) + (cdr rest))))) +(assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz")) +(assert (string=? (path-join "" "bar" "baz") "bar/baz")) + (define (canonical-path path) (if (char=? #\/ (string-ref path 0)) path @@ -222,7 +234,7 @@ (macro (with-temporary-working-directory form) (let ((result-sym (gensym)) (cwd-sym (gensym)) (tmp-sym (gensym))) `(let* ((,cwd-sym (getcwd)) - (,tmp-sym (mkdtemp "gpgscm-XXXXXX")) + (,tmp-sym (mkdtemp (path-join (getenv "TMP") "gpgscm-XXXXXX"))) (_ (chdir ,tmp-sym)) (,result-sym (begin ,@(cdr form)))) (chdir ,cwd-sym) @@ -230,9 +242,9 @@ ,result-sym))) (define (make-temporary-file . args) - (canonical-path (string-append (mkdtemp "gpgscm-XXXXXX") - "/" - (if (null? args) "a" (car args))))) + (canonical-path (path-join + (mkdtemp (path-join (getenv "TMP") "gpgscm-XXXXXX")) + (if (null? args) "a" (car args))))) (define (remove-temporary-file filename) (catch '() -- cgit v1.2.3