mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-18 10:10:23 +02:00
Honor $TMPDIR in the test suite.
This commit is contained in:
parent
c89ae78ba6
commit
792ebd5dc4
4 changed files with 81 additions and 6 deletions
1
NEWS
1
NEWS
|
@ -28,6 +28,7 @@ lead to a stack overflow.
|
||||||
** Fixed build issue with DEC/Compaq/HP's compiler
|
** Fixed build issue with DEC/Compaq/HP's compiler
|
||||||
** Fixed `scm_from_complex_double' build issue on FreeBSD
|
** Fixed `scm_from_complex_double' build issue on FreeBSD
|
||||||
** Fixed `alloca' build issue on FreeBSD 6
|
** Fixed `alloca' build issue on FreeBSD 6
|
||||||
|
** Make sure all tests honor `$TMPDIR'
|
||||||
|
|
||||||
* Changes to the distribution
|
* Changes to the distribution
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,10 @@
|
||||||
|
2008-03-13 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
|
||||||
|
* tests/socket.test (temp-file-path): New. Replace calls to
|
||||||
|
`tmpnam' with calls to `temp-file-path', so that `$TMPDIR' is
|
||||||
|
honored.
|
||||||
|
* standalone/test-unwind.c (check_ports): Honor `$TMPDIR'.
|
||||||
|
|
||||||
2008-03-12 Ludovic Courtès <ludo@gnu.org>
|
2008-03-12 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
|
||||||
* tests/srfi-37.test (short options without arguments): New
|
* tests/srfi-37.test (short options without arguments): New
|
||||||
|
|
|
@ -1,8 +1,55 @@
|
||||||
|
/* Copyright (C) 2004, 2005, 2008 Free Software Foundation, Inc.
|
||||||
|
*
|
||||||
|
* This library is free software; you can redistribute it and/or
|
||||||
|
* modify it under the terms of the GNU Lesser General Public
|
||||||
|
* License as published by the Free Software Foundation; either
|
||||||
|
* version 2.1 of the License, or (at your option) any later version.
|
||||||
|
*
|
||||||
|
* This library is distributed in the hope that it will be useful,
|
||||||
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
|
* Lesser General Public License for more details.
|
||||||
|
*
|
||||||
|
* You should have received a copy of the GNU Lesser General Public
|
||||||
|
* License along with this library; if not, write to the Free Software
|
||||||
|
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
*/
|
||||||
|
|
||||||
|
#if HAVE_CONFIG_H
|
||||||
|
# include <config.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* This blob per the Autoconf manual (under "Particular Functions"), updated
|
||||||
|
to match that of Gnulib. */
|
||||||
|
#ifndef alloca
|
||||||
|
# if HAVE_ALLOCA_H
|
||||||
|
# include <alloca.h>
|
||||||
|
# elif defined __GNUC__
|
||||||
|
# define alloca __builtin_alloca
|
||||||
|
# elif defined _AIX
|
||||||
|
# define alloca __alloca
|
||||||
|
# elif defined _MSC_VER
|
||||||
|
# include <malloc.h>
|
||||||
|
# define alloca _alloca
|
||||||
|
# else
|
||||||
|
# include <stddef.h>
|
||||||
|
# ifdef __cplusplus
|
||||||
|
extern "C"
|
||||||
|
# endif
|
||||||
|
void *alloca (size_t);
|
||||||
|
# endif
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <libguile.h>
|
#include <libguile.h>
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
|
|
||||||
|
#ifdef HAVE_STRING_H
|
||||||
|
# include <string.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
void set_flag (void *data);
|
void set_flag (void *data);
|
||||||
void func1 (void);
|
void func1 (void);
|
||||||
void func2 (void);
|
void func2 (void);
|
||||||
|
@ -170,7 +217,17 @@ delete_file (void *data)
|
||||||
void
|
void
|
||||||
check_ports ()
|
check_ports ()
|
||||||
{
|
{
|
||||||
char filename[] = "/tmp/check-ports.XXXXXX";
|
#define FILENAME_TEMPLATE "/check-ports.XXXXXX"
|
||||||
|
char *filename;
|
||||||
|
const char *tmpdir = getenv ("TMPDIR");
|
||||||
|
|
||||||
|
if (tmpdir == NULL)
|
||||||
|
tmpdir = "/tmp";
|
||||||
|
|
||||||
|
filename = (char *) alloca (strlen (tmpdir) +
|
||||||
|
sizeof (FILENAME_TEMPLATE) + 1);
|
||||||
|
strcpy (filename, tmpdir);
|
||||||
|
strcat (filename, FILENAME_TEMPLATE);
|
||||||
|
|
||||||
if (mktemp (filename) == NULL)
|
if (mktemp (filename) == NULL)
|
||||||
exit (1);
|
exit (1);
|
||||||
|
@ -205,6 +262,7 @@ check_ports ()
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
scm_dynwind_end ();
|
scm_dynwind_end ();
|
||||||
|
#undef FILENAME_TEMPLATE
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; socket.test --- test socket functions -*- scheme -*-
|
;;;; socket.test --- test socket functions -*- scheme -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008 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,6 +174,15 @@
|
||||||
;;; AF_UNIX sockets and `make-socket-address'
|
;;; AF_UNIX sockets and `make-socket-address'
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define (temp-file-path)
|
||||||
|
;; Return a temporary file path that honors `$TMPDIR', which `tmpnam'
|
||||||
|
;; doesn't do.
|
||||||
|
(let ((dir (or (getenv "TMPDIR") "/tmp")))
|
||||||
|
(string-append dir "/guile-test-socket-"
|
||||||
|
(number->string (current-time)) "-"
|
||||||
|
(number->string (random 100000)))))
|
||||||
|
|
||||||
|
|
||||||
(if (defined? 'AF_UNIX)
|
(if (defined? 'AF_UNIX)
|
||||||
(with-test-prefix "AF_UNIX/SOCK_DGRAM"
|
(with-test-prefix "AF_UNIX/SOCK_DGRAM"
|
||||||
|
|
||||||
|
@ -181,7 +190,7 @@
|
||||||
|
|
||||||
(let ((server-socket (socket AF_UNIX SOCK_DGRAM 0))
|
(let ((server-socket (socket AF_UNIX SOCK_DGRAM 0))
|
||||||
(server-bound? #f)
|
(server-bound? #f)
|
||||||
(path (tmpnam)))
|
(path (temp-file-path)))
|
||||||
|
|
||||||
(pass-if "bind"
|
(pass-if "bind"
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
|
@ -196,7 +205,7 @@
|
||||||
|
|
||||||
(pass-if "bind/sockaddr"
|
(pass-if "bind/sockaddr"
|
||||||
(let* ((sock (socket AF_UNIX SOCK_STREAM 0))
|
(let* ((sock (socket AF_UNIX SOCK_STREAM 0))
|
||||||
(path (tmpnam))
|
(path (temp-file-path))
|
||||||
(sockaddr (make-socket-address AF_UNIX path)))
|
(sockaddr (make-socket-address AF_UNIX path)))
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -233,7 +242,7 @@
|
||||||
(server-bound? #f)
|
(server-bound? #f)
|
||||||
(server-listening? #f)
|
(server-listening? #f)
|
||||||
(server-pid #f)
|
(server-pid #f)
|
||||||
(path (tmpnam)))
|
(path (temp-file-path)))
|
||||||
|
|
||||||
(pass-if "bind"
|
(pass-if "bind"
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
|
@ -248,7 +257,7 @@
|
||||||
|
|
||||||
(pass-if "bind/sockaddr"
|
(pass-if "bind/sockaddr"
|
||||||
(let* ((sock (socket AF_UNIX SOCK_STREAM 0))
|
(let* ((sock (socket AF_UNIX SOCK_STREAM 0))
|
||||||
(path (tmpnam))
|
(path (temp-file-path))
|
||||||
(sockaddr (make-socket-address AF_UNIX path)))
|
(sockaddr (make-socket-address AF_UNIX path)))
|
||||||
(catch 'system-error
|
(catch 'system-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue