Honor $TMPDIR in the test suite.

diff --git a/NEWS b/NEWS
index fa7d5d02b338ea35a976ce6ccaa14ec27a0370bf..0e3dd0bfc478321480499c4af30ed96bb13d9100 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,7 @@ lead to a stack overflow.
 ** Fixed build issue with DEC/Compaq/HP's compiler
 ** Fixed `scm_from_complex_double' build issue on FreeBSD
 ** Fixed `alloca' build issue on FreeBSD 6
+** Make sure all tests honor `$TMPDIR'
 
 * Changes to the distribution
 

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index 15fc016ba0325f102589c4e5bb58e08c842267ec..c119a88dcac1928dcf7b8f2ac2d164832a1a6249 100644 (file)
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -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>
 
        * tests/srfi-37.test (short options without arguments): New

diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c
index e2971beeb0c921164bd3441a5b62cae69b3224ce..ee08a8c08d349ceeb94941f56e93344e5cbe401a 100644 (file)
--- a/test-suite/standalone/test-unwind.c
+++ b/test-suite/standalone/test-unwind.c
@@ -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 <stdlib.h>
 #include <stdio.h>
 #include <unistd.h>
 
+#ifdef HAVE_STRING_H
+# include <string.h>
+#endif
+
+
 void set_flag (void *data);
 void func1 (void);
 void func2 (void);
@@ -170,7 +217,17 @@ delete_file (void *data)
 void
 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)
     exit (1);
@@ -205,6 +262,7 @@ check_ports ()
       }
   }
   scm_dynwind_end ();
+#undef FILENAME_TEMPLATE
 }
 
 void

diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test
index f5fc2be890dd8ef589b01105774c4de397b3a0ef..4bfc4155754755056c0bdea8f61ef11cee0bd67e 100644 (file)
--- a/test-suite/tests/socket.test
+++ b/test-suite/tests/socket.test
@@ -1,6 +1,6 @@
 ;;;; 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
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -174,6 +174,15 @@
 ;;; 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)
     (with-test-prefix "AF_UNIX/SOCK_DGRAM"
 
@@ -181,7 +190,7 @@
 
       (let ((server-socket (socket AF_UNIX SOCK_DGRAM 0))
            (server-bound? #f)
-           (path (tmpnam)))
+           (path (temp-file-path)))
 
        (pass-if "bind"
          (catch 'system-error
@@ -196,7 +205,7 @@
 
        (pass-if "bind/sockaddr"
          (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
-                (path (tmpnam))
+                (path (temp-file-path))
                 (sockaddr (make-socket-address AF_UNIX path)))
            (catch 'system-error
              (lambda ()
@@ -233,7 +242,7 @@
            (server-bound? #f)
            (server-listening? #f)
            (server-pid #f)
-           (path (tmpnam)))
+           (path (temp-file-path)))
 
        (pass-if "bind"
          (catch 'system-error
@@ -248,7 +257,7 @@
 
        (pass-if "bind/sockaddr"
          (let* ((sock (socket AF_UNIX SOCK_STREAM 0))
-                (path (tmpnam))
+                (path (temp-file-path))
                 (sockaddr (make-socket-address AF_UNIX path)))
            (catch 'system-error
              (lambda ()