Changes from arch/CVS synchronization

NEWS

@@ -29,6 +29,7 @@ extensions.)
 ** `*' returns exact 0 for "(* inexact 0)"
 This follows what it always did for "(* 0 inexact)".
 ** SRFI-19: Value returned by `(current-time time-process)' was incorrect
+** `ttyname' no longer crashes when passed a non-tty argument
 ** Build problems on Solaris fixed
 ** Build problems on Mingw fixed
 

doc/ref/ChangeLog

@@ -1,3 +1,8 @@
+2007-06-07  Ludovic Courtès  <ludovic.courtes@laas.fr>
+
+	* api-control.texi (Dynamic Wind): Fixed typo.  Reported by
+	Norman Hardy.
+
 2007-05-16  Ludovic Courtès  <ludovic.courtes@laas.fr>
 
 	* posix.texi (Network Sockets and Communication): Fixed typo:

doc/ref/api-control.texi

@@ -1164,7 +1164,7 @@ lexical variables, this will be, well, inconvenient.
 
 Therefore, Guile offers the functions @code{scm_dynwind_begin} and
 @code{scm_dynwind_end} to delimit a dynamic extent.  Within this
-dynamic extent, which is calles a @dfn{dynwind context}, you can
+dynamic extent, which is called a @dfn{dynwind context}, you can
 perform various @dfn{dynwind actions} that control what happens when
 the dynwind context is entered or left.  For example, you can register
 a cleanup routine with @code{scm_dynwind_unwind_handler} that is

libguile/ChangeLog

@@ -1,3 +1,9 @@
+2007-06-07  Ludovic Courtès  <ludovic.courtes@laas.fr>
+
+	* posix.c (scm_ttyname): Check whether RESULT is NULL before
+	making a string from it (reported by Dan McMahill).  Don't call
+	`scm_from_locale_string ()' before the mutex is released.
+
 2007-03-08  Kevin Ryde  <user42@zip.com.au>
 
 	* struct.c, struct.h (scm_make_vtable): New function, providing

libguile/posix.c

@@ -834,7 +834,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
 {
   char *result;
   int fd, err;
-  SCM ret;
+  SCM ret = SCM_BOOL_F;
 
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPPORT (1, port);
@@ -843,9 +843,12 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
   fd = SCM_FPORT_FDES (port);
 
   scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex);
+
   SCM_SYSCALL (result = ttyname (fd));
   err = errno;
-  ret = scm_from_locale_string (result);
+  if (result != NULL)
+    result = strdup (result);
+
   scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
 
   if (!result)
@@ -853,6 +856,9 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
       errno = err;
       SCM_SYSERROR;
     }
+  else
+    ret = scm_take_locale_string (result);
+
   return ret;
 }
 #undef FUNC_NAME

test-suite/ChangeLog

@@ -1,3 +1,10 @@
+2007-06-07  Ludovic Courtès  <ludovic.courtes@laas.fr>
+
+	* lib.scm (exception:system-error): New variable.
+
+	* tests/posix.test (ttyname): New test prefix.  Catches a bug
+	reported by Dan McMahill.
+
 2007-05-09  Ludovic Courtès  <ludo@chbouib.org>
 
 	* tests/srfi-19.test ((current-time time-tai) works): Use `time?'.

test-suite/lib.scm

@@ -29,6 +29,7 @@
  exception:wrong-num-args exception:wrong-type-arg
  exception:numerical-overflow
  exception:struct-set!-denied
+ exception:system-error
  exception:miscellaneous-error
  exception:string-contains-nul
 
@@ -257,6 +258,8 @@
   (cons 'numerical-overflow "^Numerical overflow"))
 (define exception:struct-set!-denied
   (cons 'misc-error "^set! denied for field"))
+(define exception:system-error
+  (cons 'system-error ".*"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
 

test-suite/tests/posix.test

@@ -1,6 +1,6 @@
 ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -17,7 +17,8 @@
 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;;;; Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib))
+(define-module (test-suite test-posix)
+  :use-module (test-suite lib))
 
 
 ;; FIXME: The following exec tests are disabled since on an i386 debian with
@@ -145,3 +146,19 @@
     (putenv "FOO=")
     (unsetenv "FOO")
     (not (getenv "FOO"))))
+
+;;
+;; ttyname
+;;
+
+(with-test-prefix "ttyname"
+
+  (pass-if-exception "non-tty argument" exception:system-error
+    ;; This used to crash in 1.8.1 and earlier.
+    (let ((file (false-if-exception
+                 (open-output-file "/dev/null"))))
+      (if (not file)
+          (throw 'unsupported)
+          (ttyname file)))))
+
+