mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Work around path name length limitations in `socket.test'.

Browse source 
* test-suite/tests/socket.test (%tmpdir, %curdir): New variables.
  Chdir to %TMPDIR.  Switch back to %CURDIR at the end.
  (temp-file-path): Return a base file name, not an absolute path.
This commit is contained in:
Ludovic Courtès 2009-11-18 15:28:56 +01:00
parent 0c1eb9b68c
commit 91cbeffc87
1 changed files with 26 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

34
test-suite/tests/socket.test
View file

@ -1,6 +1,6 @@
;;;; socket.test --- test socket functions -*- scheme -*- ;;;; socket.test --- test socket functions -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -174,13 +174,28 @@
;;; AF_UNIX sockets and `make-socket-address' ;;; AF_UNIX sockets and `make-socket-address'
;;; ;;;
(define %tmpdir
;; Honor `$TMPDIR', which tmpnam(3) doesn't do.
(or (getenv "TMPDIR") "/tmp"))
(define %curdir
;; Remember the current working directory.
(getcwd))
;; Temporarily cd to %TMPDIR. The goal is to work around path name
;; limitations, which can lead to exceptions like:
;;
;; (misc-error "scm_to_sockaddr"
;; "unix address path too long: ~A"
;; ("/tmp/nix-build-fb7bph4ifh0vr3ihigm702dzffdnapfj-guile-coverage-1.9.5.drv-0/guile-test-socket-1258553296-77619")
;; #f)
(chdir %tmpdir)
(define (temp-file-path) (define (temp-file-path)
;; Return a temporary file path that honors `$TMPDIR', which `tmpnam' ;; Return a temporary file name, assuming the current directory is %TMPDIR.
;; doesn't do. (string-append "guile-test-socket-"
(let ((dir (or (getenv "TMPDIR") "/tmp"))) (number->string (current-time)) "-"
(string-append dir "/guile-test-socket-" (number->string (random 100000))))
(number->string (current-time)) "-"
(number->string (random 100000)))))
(if (defined? 'AF_UNIX) (if (defined? 'AF_UNIX)
@ -408,4 +423,7 @@
(let ((status (cdr (waitpid server-pid)))) (let ((status (cdr (waitpid server-pid))))
(eq? 0 (status:exit-val status))))) (eq? 0 (status:exit-val status)))))
#t))) #t)))
;; Switch back to the previous directory.
(false-if-exception (chdir %curdir))