[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-193-g07316
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-193-g073167e |
|
Date: |
Thu, 14 Apr 2011 22:12:34 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=073167ef7b803067bcc8be19925fac1a48577bd8
The branch, stable-2.0 has been updated
via 073167ef7b803067bcc8be19925fac1a48577bd8 (commit)
via 22072f2155f657ff229bf8aaaa00318b60e8d6e5 (commit)
via 022ae742d171fb9ef3db7aab59b4e029edd2ff02 (commit)
from 3936cebc77bfbde57bb3fe904b26943e54a9d618 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 073167ef7b803067bcc8be19925fac1a48577bd8
Author: Ludovic Courtès <address@hidden>
Date: Thu Apr 14 23:42:28 2011 +0200
Allow compilation with `--disable-posix'.
Reported by Dmitry Dzhus <address@hidden>.
* configure.ac: Remove `AC_LIBOBJ([filesys])'. Document
`--disable-posix' as omitting non-essential POSIX interfaces.
* libguile/Makefile.am (address@hidden@_la_SOURCES):
Add `filesys.c'.
(DOT_DOC_FILES): Add `filesys.doc'.
(address@hidden@_la_SOURCES): Remove
`filesys.c'.
* libguile/posix.c (scm_mkstemp, scm_access): Move to `filesys.c'.
(scm_init_posix): Move `R_OK' etc. to `filesys.c'.
* libguile/filesys.c (scm_chown, scm_chmod, scm_umask, scm_open_fdes,
scm_open, scm_close, scm_close_fdes, scm_link, scm_tc16_dir,
scm_directory_stream_p, scm_opendir, scm_readdir, scm_rewinddir,
scm_closedir, scm_dir_print, scm_dir_free, scm_chdir, scm_getcwd,
set_element, fill_select_type, get_element, retrieve_select_type,
scm_select, scm_fcntl, scm_fsync, scm_symlink, scm_readlink,
scm_lstat, scm_copy_file): Conditionalize on HAVE_POSIX.
(scm_mkstemp, scm_access): New functions.
(scm_init_filesys): Conditionalize `scm_tc16_dir', `O_RDONLY', etc. on
HAVE_POSIX. Define `R_OK', `W_OK', etc.
* libguile/fports.c (fport_print): Use `scm_ttyname' only when
HAVE_POSIX.
* libguile/i18n.c (lock_locale_mutex, unlock_locale_mutex): New
functions. Update users of `scm_i_locale_mutex' to use them.
* libguile/init.c (scm_i_init_guile): Always call `scm_init_filesys'.
* meta/guile-tools.in (main): Use `setlocale' only when it is defined.
* module/ice-9/boot-9.scm: Always load `ice-9/posix'.
commit 22072f2155f657ff229bf8aaaa00318b60e8d6e5
Author: Ludovic Courtès <address@hidden>
Date: Thu Apr 14 23:16:21 2011 +0200
Include <sched.h> in `posix.c'.
* configure.ac: Check for <sched.h>.
* libguile/posix.c [HAVE_SCHED_H]: Include <sched.h>, for
`sched_setaffinity' & co.
Reported by Marco Maggi <address@hidden>.
commit 022ae742d171fb9ef3db7aab59b4e029edd2ff02
Author: Ludovic Courtès <address@hidden>
Date: Thu Apr 14 23:14:14 2011 +0200
Add tests for `-Wformat' and gettext.
* test-suite/tests/tree-il.test ("warnings")["non-literal format string
using gettext", "one missing argument, gettext"]: New tests.
-----------------------------------------------------------------------
Summary of changes:
configure.ac | 8 +-
libguile/Makefile.am | 4 +-
libguile/filesys.c | 503 +++++++++++++++++++++++++---------------
libguile/fports.c | 9 +-
libguile/i18n.c | 35 +++-
libguile/init.c | 2 +-
libguile/posix.c | 110 +---------
meta/guile-tools.in | 4 +-
module/ice-9/boot-9.scm | 5 +-
test-suite/tests/tree-il.test | 17 ++
10 files changed, 381 insertions(+), 316 deletions(-)
diff --git a/configure.ac b/configure.ac
index 45438c8..fe77773 100644
--- a/configure.ac
+++ b/configure.ac
@@ -127,7 +127,7 @@ AC_ARG_ENABLE(guile-debug,
fi)
AC_ARG_ENABLE(posix,
- [ --disable-posix omit posix interfaces],,
+ [ --disable-posix omit non-essential POSIX interfaces],,
enable_posix=yes)
AC_ARG_ENABLE(networking,
@@ -230,10 +230,9 @@ if test "$use_modules" != no; then
fi
if test "$enable_posix" = yes; then
- AC_LIBOBJ([filesys])
AC_LIBOBJ([posix])
AC_DEFINE([HAVE_POSIX], 1,
- [Define this if you want support for POSIX system calls in Guile.])
+ [Define this if you want support for non-essential POSIX system calls in
Guile.])
fi
if test "$enable_networking" = yes; then
@@ -644,12 +643,13 @@ AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64])
# this file instead of <fenv.h>
# process.h - mingw specific
# langinfo.h, nl_types.h - SuS v2
+# sched.h - missing on MinGW
#
AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h malloc.h memory.h
process.h string.h \
regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h langinfo.h nl_types.h machine/fpu.h poll.h])
+direct.h langinfo.h nl_types.h machine/fpu.h poll.h sched.h])
# Reasons for testing:
# nl_item - lacking on Cygwin
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index ac27eb8..29de791 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -138,6 +138,7 @@ address@hidden@_la_SOURCES =
\
expand.c \
extensions.c \
feature.c \
+ filesys.c \
fluids.c \
foreign.c \
fports.c \
@@ -342,6 +343,7 @@ DOT_DOC_FILES = \
expand.doc \
extensions.doc \
feature.doc \
+ filesys.doc \
fluids.doc \
foreign.doc \
fports.doc \
@@ -425,7 +427,7 @@ BUILT_SOURCES = cpp-E.c cpp-SIG.c libpath.h \
address@hidden@_la_SOURCES = _scm.h \
memmove.c strerror.c \
dynl.c regex-posix.c \
- filesys.c posix.c net_db.c socket.c \
+ posix.c net_db.c socket.c \
debug-malloc.c mkstemp.c \
win32-uname.c win32-dirent.c win32-socket.c \
locale-categories.h
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 96752bc..fab8ab4 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -18,6 +18,10 @@
+/* This file contains POSIX file system access procedures. Procedures
+ essential to the compiler and run-time (`stat', `canonicalize-path',
+ etc.) are compiled even with `--disable-posix'. */
+
/* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
@@ -158,6 +162,8 @@
+#ifdef HAVE_POSIX
+
/* {Permissions}
*/
@@ -203,64 +209,6 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_CHOWN */
-
-SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
- (SCM object, SCM mode),
- "Changes the permissions of the file referred to by @var{obj}.\n"
- "@var{obj} can be a string containing a file name or a port or
integer file\n"
- "descriptor which is open on a file (in which case @code{fchmod} is
used\n"
- "as the underlying system call).\n"
- "@var{mode} specifies\n"
- "the new permissions as a decimal number, e.g., @code{(chmod
\"foo\" #o755)}.\n"
- "The return value is unspecified.")
-#define FUNC_NAME s_scm_chmod
-{
- int rv;
- int fdes;
-
- object = SCM_COERCE_OUTPORT (object);
-
- if (scm_is_integer (object) || SCM_OPFPORTP (object))
- {
- if (scm_is_integer (object))
- fdes = scm_to_int (object);
- else
- fdes = SCM_FPORT_FDES (object);
- SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
- }
- else
- {
- STRING_SYSCALL (object, c_object,
- rv = chmod (c_object, scm_to_int (mode)));
- }
- if (rv == -1)
- SCM_SYSERROR;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
- (SCM mode),
- "If @var{mode} is omitted, returns a decimal number representing
the current\n"
- "file creation mask. Otherwise the file creation mask is set to\n"
- "@var{mode} and the previous value is returned.\n\n"
- "E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18.")
-#define FUNC_NAME s_scm_umask
-{
- mode_t mask;
- if (SCM_UNBNDP (mode))
- {
- mask = umask (0);
- umask (mask);
- }
- else
- {
- mask = umask (scm_to_uint (mode));
- }
- return scm_from_uint (mask);
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
@@ -386,6 +334,8 @@ SCM_DEFINE (scm_close_fdes, "close-fdes", 1, 0, 0,
}
#undef FUNC_NAME
+#endif /* HAVE_POSIX */
+
/* {Files}
*/
@@ -653,6 +603,8 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
#undef FUNC_NAME
+#ifdef HAVE_POSIX
+
/* {Modifying Directories}
*/
@@ -677,103 +629,6 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_LINK */
-#ifdef HAVE_RENAME
-#define my_rename rename
-#else
-static int
-my_rename (const char *oldname, const char *newname)
-{
- int rv;
-
- SCM_SYSCALL (rv = link (oldname, newname));
- if (rv == 0)
- {
- SCM_SYSCALL (rv = unlink (oldname));
- if (rv != 0)
- /* unlink failed. remove new name */
- SCM_SYSCALL (unlink (newname));
- }
- return rv;
-}
-#endif
-
-SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
- (SCM oldname, SCM newname),
- "Renames the file specified by @var{oldname} to @var{newname}.\n"
- "The return value is unspecified.")
-#define FUNC_NAME s_scm_rename
-{
- int rv;
-
- STRING2_SYSCALL (oldname, c_oldname,
- newname, c_newname,
- rv = my_rename (c_oldname, c_newname));
- if (rv != 0)
- SCM_SYSERROR;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
- (SCM str),
- "Deletes (or \"unlinks\") the file specified by @var{path}.")
-#define FUNC_NAME s_scm_delete_file
-{
- int ans;
- STRING_SYSCALL (str, c_str, ans = unlink (c_str));
- if (ans != 0)
- SCM_SYSERROR;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-#ifdef HAVE_MKDIR
-SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
- (SCM path, SCM mode),
- "Create a new directory named by @var{path}. If @var{mode} is
omitted\n"
- "then the permissions of the directory file are set using the
current\n"
- "umask. Otherwise they are set to the decimal value specified
with\n"
- "@var{mode}. The return value is unspecified.")
-#define FUNC_NAME s_scm_mkdir
-{
- int rv;
- mode_t mask;
-
- if (SCM_UNBNDP (mode))
- {
- mask = umask (0);
- umask (mask);
- STRING_SYSCALL (path, c_path, rv = mkdir (c_path, 0777 ^ mask));
- }
- else
- {
- STRING_SYSCALL (path, c_path, rv = mkdir (c_path, scm_to_uint (mode)));
- }
- if (rv != 0)
- SCM_SYSERROR;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-#endif /* HAVE_MKDIR */
-
-#ifdef HAVE_RMDIR
-SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
- (SCM path),
- "Remove the existing directory named by @var{path}. The directory
must\n"
- "be empty for this to succeed. The return value is unspecified.")
-#define FUNC_NAME s_scm_rmdir
-{
- int val;
-
- STRING_SYSCALL (path, c_path, val = rmdir (c_path));
- if (val != 0)
- SCM_SYSERROR;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-#endif
-
/* {Examining Directories}
@@ -971,38 +826,6 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
}
#undef FUNC_NAME
-#ifdef HAVE_GETCWD
-SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
- (),
- "Return the name of the current working directory.")
-#define FUNC_NAME s_scm_getcwd
-{
- char *rv;
- size_t size = 100;
- char *wd;
- SCM result;
-
- wd = scm_malloc (size);
- while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
- {
- free (wd);
- size *= 2;
- wd = scm_malloc (size);
- }
- if (rv == 0)
- {
- int save_errno = errno;
- free (wd);
- errno = save_errno;
- SCM_SYSERROR;
- }
- result = scm_from_locale_stringn (wd, strlen (wd));
- free (wd);
- return result;
-}
-#undef FUNC_NAME
-#endif /* HAVE_GETCWD */
-
#ifdef HAVE_SELECT
@@ -1509,6 +1332,300 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
}
#undef FUNC_NAME
+#endif /* HAVE_POSIX */
+
+
+/* Essential procedures used in (system base compile). */
+
+#ifdef HAVE_GETCWD
+SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
+ (),
+ "Return the name of the current working directory.")
+#define FUNC_NAME s_scm_getcwd
+{
+ char *rv;
+ size_t size = 100;
+ char *wd;
+ SCM result;
+
+ wd = scm_malloc (size);
+ while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
+ {
+ free (wd);
+ size *= 2;
+ wd = scm_malloc (size);
+ }
+ if (rv == 0)
+ {
+ int save_errno = errno;
+ free (wd);
+ errno = save_errno;
+ SCM_SYSERROR;
+ }
+ result = scm_from_locale_stringn (wd, strlen (wd));
+ free (wd);
+ return result;
+}
+#undef FUNC_NAME
+#endif /* HAVE_GETCWD */
+
+#ifdef HAVE_MKDIR
+SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
+ (SCM path, SCM mode),
+ "Create a new directory named by @var{path}. If @var{mode} is
omitted\n"
+ "then the permissions of the directory file are set using the
current\n"
+ "umask. Otherwise they are set to the decimal value specified
with\n"
+ "@var{mode}. The return value is unspecified.")
+#define FUNC_NAME s_scm_mkdir
+{
+ int rv;
+ mode_t mask;
+
+ if (SCM_UNBNDP (mode))
+ {
+ mask = umask (0);
+ umask (mask);
+ STRING_SYSCALL (path, c_path, rv = mkdir (c_path, 0777 ^ mask));
+ }
+ else
+ {
+ STRING_SYSCALL (path, c_path, rv = mkdir (c_path, scm_to_uint (mode)));
+ }
+ if (rv != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MKDIR */
+
+#ifdef HAVE_RMDIR
+SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
+ (SCM path),
+ "Remove the existing directory named by @var{path}. The directory
must\n"
+ "be empty for this to succeed. The return value is unspecified.")
+#define FUNC_NAME s_scm_rmdir
+{
+ int val;
+
+ STRING_SYSCALL (path, c_path, val = rmdir (c_path));
+ if (val != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
+#ifdef HAVE_RENAME
+#define my_rename rename
+#else
+static int
+my_rename (const char *oldname, const char *newname)
+{
+ int rv;
+
+ SCM_SYSCALL (rv = link (oldname, newname));
+ if (rv == 0)
+ {
+ SCM_SYSCALL (rv = unlink (oldname));
+ if (rv != 0)
+ /* unlink failed. remove new name */
+ SCM_SYSCALL (unlink (newname));
+ }
+ return rv;
+}
+#endif
+
+SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
+ (SCM oldname, SCM newname),
+ "Renames the file specified by @var{oldname} to @var{newname}.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_rename
+{
+ int rv;
+
+ STRING2_SYSCALL (oldname, c_oldname,
+ newname, c_newname,
+ rv = my_rename (c_oldname, c_newname));
+ if (rv != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
+ (SCM str),
+ "Deletes (or \"unlinks\") the file specified by @var{path}.")
+#define FUNC_NAME s_scm_delete_file
+{
+ int ans;
+ STRING_SYSCALL (str, c_str, ans = unlink (c_str));
+ if (ans != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_access, "access?", 2, 0, 0,
+ (SCM path, SCM how),
+ "Test accessibility of a file under the real UID and GID of the\n"
+ "calling process. The return is @code{#t} if @var{path} exists\n"
+ "and the permissions requested by @var{how} are all allowed, or\n"
+ "@code{#f} if not.\n"
+ "\n"
+ "@var{how} is an integer which is one of the following values,\n"
+ "or a bitwise-OR (@code{logior}) of multiple values.\n"
+ "\n"
+ "@defvar R_OK\n"
+ "Test for read permission.\n"
+ "@end defvar\n"
+ "@defvar W_OK\n"
+ "Test for write permission.\n"
+ "@end defvar\n"
+ "@defvar X_OK\n"
+ "Test for execute permission.\n"
+ "@end defvar\n"
+ "@defvar F_OK\n"
+ "Test for existence of the file. This is implied by each of the\n"
+ "other tests, so there's no need to combine it with them.\n"
+ "@end defvar\n"
+ "\n"
+ "It's important to note that @code{access?} does not simply\n"
+ "indicate what will happen on attempting to read or write a\n"
+ "file. In normal circumstances it does, but in a set-UID or\n"
+ "set-GID program it doesn't because @code{access?} tests the\n"
+ "real ID, whereas an open or execute attempt uses the effective\n"
+ "ID.\n"
+ "\n"
+ "A program which will never run set-UID/GID can ignore the\n"
+ "difference between real and effective IDs, but for maximum\n"
+ "generality, especially in library functions, it's best not to\n"
+ "use @code{access?} to predict the result of an open or execute,\n"
+ "instead simply attempt that and catch any exception.\n"
+ "\n"
+ "The main use for @code{access?} is to let a set-UID/GID program\n"
+ "determine what the invoking user would have been allowed to do,\n"
+ "without the greater (or perhaps lesser) privileges afforded by\n"
+ "the effective ID. For more on this, see ``Testing File\n"
+ "Access'' in The GNU C Library Reference Manual.")
+#define FUNC_NAME s_scm_access
+{
+ int rv;
+ char *c_path;
+
+ c_path = scm_to_locale_string (path);
+ rv = access (c_path, scm_to_int (how));
+ free (c_path);
+
+ return scm_from_bool (!rv);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
+ (SCM object, SCM mode),
+ "Changes the permissions of the file referred to by @var{obj}.\n"
+ "@var{obj} can be a string containing a file name or a port or
integer file\n"
+ "descriptor which is open on a file (in which case @code{fchmod} is
used\n"
+ "as the underlying system call).\n"
+ "@var{mode} specifies\n"
+ "the new permissions as a decimal number, e.g., @code{(chmod
\"foo\" #o755)}.\n"
+ "The return value is unspecified.")
+#define FUNC_NAME s_scm_chmod
+{
+ int rv;
+ int fdes;
+
+ object = SCM_COERCE_OUTPORT (object);
+
+ if (scm_is_integer (object) || SCM_OPFPORTP (object))
+ {
+ if (scm_is_integer (object))
+ fdes = scm_to_int (object);
+ else
+ fdes = SCM_FPORT_FDES (object);
+ SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
+ }
+ else
+ {
+ STRING_SYSCALL (object, c_object,
+ rv = chmod (c_object, scm_to_int (mode)));
+ }
+ if (rv == -1)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
+ (SCM mode),
+ "If @var{mode} is omitted, returns a decimal number representing
the current\n"
+ "file creation mask. Otherwise the file creation mask is set to\n"
+ "@var{mode} and the previous value is returned.\n\n"
+ "E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18.")
+#define FUNC_NAME s_scm_umask
+{
+ mode_t mask;
+ if (SCM_UNBNDP (mode))
+ {
+ mask = umask (0);
+ umask (mask);
+ }
+ else
+ {
+ mask = umask (scm_to_uint (mode));
+ }
+ return scm_from_uint (mask);
+}
+#undef FUNC_NAME
+
+#ifndef HAVE_MKSTEMP
+extern int mkstemp (char *);
+#endif
+
+SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
+ (SCM tmpl),
+ "Create a new unique file in the file system and return a new\n"
+ "buffered port open for reading and writing to the file.\n"
+ "\n"
+ "@var{tmpl} is a string specifying where the file should be\n"
+ "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
+ "will be changed in the string to return the name of the file.\n"
+ "(@code{port-filename} on the port also gives the name.)\n"
+ "\n"
+ "POSIX doesn't specify the permissions mode of the file, on GNU\n"
+ "and most systems it's @code{#o600}. An application can use\n"
+ "@code{chmod} to relax that if desired. For example\n"
+ "@code{#o666} less @code{umask}, which is usual for ordinary\n"
+ "file creation,\n"
+ "\n"
+ "@example\n"
+ "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
+ " (chmod port (logand #o666 (lognot (umask))))\n"
+ " ...)\n"
+ "@end example")
+#define FUNC_NAME s_scm_mkstemp
+{
+ char *c_tmpl;
+ int rv;
+
+ scm_dynwind_begin (0);
+
+ c_tmpl = scm_to_locale_string (tmpl);
+ scm_dynwind_free (c_tmpl);
+
+ SCM_SYSCALL (rv = mkstemp (c_tmpl));
+ if (rv == -1)
+ SCM_SYSERROR;
+
+ scm_substring_move_x (scm_from_locale_string (c_tmpl),
+ SCM_INUM0, scm_string_length (tmpl),
+ tmpl, SCM_INUM0);
+
+ scm_dynwind_end ();
+ return scm_fdes_to_port (rv, "w+", tmpl);
+}
+#undef FUNC_NAME
+
/* Filename manipulation */
@@ -1703,12 +1820,11 @@ scm_i_relativize_path (SCM path, SCM in_path)
void
scm_init_filesys ()
{
+#ifdef HAVE_POSIX
scm_tc16_dir = scm_make_smob_type ("directory", 0);
scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print);
- scm_dot_string = scm_from_locale_string (".");
-
#ifdef O_RDONLY
scm_c_define ("O_RDONLY", scm_from_int (O_RDONLY));
#endif
@@ -1770,6 +1886,15 @@ scm_init_filesys ()
#ifdef FD_CLOEXEC
scm_c_define ("FD_CLOEXEC", scm_from_int (FD_CLOEXEC));
#endif
+#endif /* HAVE_POSIX */
+
+ /* `access' symbols. */
+ scm_c_define ("R_OK", scm_from_int (R_OK));
+ scm_c_define ("W_OK", scm_from_int (W_OK));
+ scm_c_define ("X_OK", scm_from_int (X_OK));
+ scm_c_define ("F_OK", scm_from_int (F_OK));
+
+ scm_dot_string = scm_from_locale_string (".");
#include "libguile/filesys.x"
}
diff --git a/libguile/fports.c b/libguile/fports.c
index fdc8f46..0b84d44 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006,
2007, 2008, 2009, 2010 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2006, 2007, 2008, 2009, 2010, 2011 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 3 of
@@ -637,8 +638,8 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate
SCM_UNUSED)
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
scm_putc (' ', port);
fdes = (SCM_FSTREAM (exp))->fdes;
-
-#ifdef HAVE_TTYNAME
+
+#if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
if (isatty (fdes))
scm_display (scm_ttyname (exp), port);
else
diff --git a/libguile/i18n.c b/libguile/i18n.c
index fc651fd..6ee159b 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -82,6 +82,25 @@ setlocale (int category, const char *name)
/* Helper stringification macro. */
#define SCM_I18N_STRINGIFY(_name) # _name
+/* Acquiring and releasing the locale lock. */
+
+static inline void
+lock_locale_mutex (void)
+{
+#ifdef HAVE_POSIX
+ scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+#else
+#endif
+}
+
+static inline void
+unlock_locale_mutex (void)
+{
+#ifdef HAVE_POSIX
+ scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+#else
+#endif
+}
/* Locale objects, string and character collation, and other locale-dependent
@@ -421,7 +440,7 @@ leave_locale_section (const scm_t_locale_settings *settings)
/* Restore the previous locale settings. */
(void)restore_locale_settings (settings);
- scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+ unlock_locale_mutex ();
}
/* Enter a locked locale section. */
@@ -431,12 +450,12 @@ enter_locale_section (scm_t_locale locale,
{
int err;
- scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+ lock_locale_mutex ();
err = get_current_locale_settings (prev_locale);
if (err)
{
- scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+ unlock_locale_mutex ();
return err;
}
@@ -483,7 +502,7 @@ get_current_locale (SCM *result)
c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
- scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+ lock_locale_mutex ();
c_locale->category_mask = LC_ALL_MASK;
c_locale->base_locale = SCM_UNDEFINED;
@@ -498,7 +517,7 @@ get_current_locale (SCM *result)
else
err = EINVAL;
- scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+ unlock_locale_mutex ();
if (err)
scm_gc_free (c_locale, sizeof (* c_locale), "locale");
@@ -1490,7 +1509,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
http://opengroup.org/onlinepubs/007908799/xsh/nl_langinfo.html for
details. */
- scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
+ lock_locale_mutex ();
if (c_locale != NULL)
{
#ifdef USE_GNU_LOCALE_API
@@ -1506,7 +1525,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
lsec_err = get_current_locale_settings (&lsec_prev_locale);
if (lsec_err)
- scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+ unlock_locale_mutex ();
else
{
lsec_err = install_locale (c_locale);
@@ -1540,7 +1559,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
}
c_result = strdup (c_result);
- scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
+ unlock_locale_mutex ();
if (c_result == NULL)
result = SCM_BOOL_F;
diff --git a/libguile/init.c b/libguile/init.c
index 8b3b8cd..8741846 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -455,8 +455,8 @@ scm_i_init_guile (void *base)
scm_init_numbers ();
scm_init_options ();
scm_init_pairs ();
-#ifdef HAVE_POSIX
scm_init_filesys (); /* Requires smob_prehistory */
+#ifdef HAVE_POSIX
scm_init_posix ();
#endif
#ifdef HAVE_REGCOMP
diff --git a/libguile/posix.c b/libguile/posix.c
index a5c7262..bfcefae 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -27,6 +27,10 @@
#include <errno.h>
#include <uniconv.h>
+#ifdef HAVE_SCHED_H
+# include <sched.h>
+#endif
+
#include "libguile/_scm.h"
#include "libguile/dynwind.h"
#include "libguile/fports.h"
@@ -1325,54 +1329,6 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
#endif
-#ifndef HAVE_MKSTEMP
-extern int mkstemp (char *);
-#endif
-
-SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
- (SCM tmpl),
- "Create a new unique file in the file system and return a new\n"
- "buffered port open for reading and writing to the file.\n"
- "\n"
- "@var{tmpl} is a string specifying where the file should be\n"
- "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
- "will be changed in the string to return the name of the file.\n"
- "(@code{port-filename} on the port also gives the name.)\n"
- "\n"
- "POSIX doesn't specify the permissions mode of the file, on GNU\n"
- "and most systems it's @code{#o600}. An application can use\n"
- "@code{chmod} to relax that if desired. For example\n"
- "@code{#o666} less @code{umask}, which is usual for ordinary\n"
- "file creation,\n"
- "\n"
- "@example\n"
- "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
- " (chmod port (logand #o666 (lognot (umask))))\n"
- " ...)\n"
- "@end example")
-#define FUNC_NAME s_scm_mkstemp
-{
- char *c_tmpl;
- int rv;
-
- scm_dynwind_begin (0);
-
- c_tmpl = scm_to_locale_string (tmpl);
- scm_dynwind_free (c_tmpl);
-
- SCM_SYSCALL (rv = mkstemp (c_tmpl));
- if (rv == -1)
- SCM_SYSERROR;
-
- scm_substring_move_x (scm_from_locale_string (c_tmpl),
- SCM_INUM0, scm_string_length (tmpl),
- tmpl, SCM_INUM0);
-
- scm_dynwind_end ();
- return scm_fdes_to_port (rv, "w+", tmpl);
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
(void),
"Return an input/output port to a unique temporary file\n"
@@ -1485,58 +1441,6 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_access, "access?", 2, 0, 0,
- (SCM path, SCM how),
- "Test accessibility of a file under the real UID and GID of the\n"
- "calling process. The return is @code{#t} if @var{path} exists\n"
- "and the permissions requested by @var{how} are all allowed, or\n"
- "@code{#f} if not.\n"
- "\n"
- "@var{how} is an integer which is one of the following values,\n"
- "or a bitwise-OR (@code{logior}) of multiple values.\n"
- "\n"
- "@defvar R_OK\n"
- "Test for read permission.\n"
- "@end defvar\n"
- "@defvar W_OK\n"
- "Test for write permission.\n"
- "@end defvar\n"
- "@defvar X_OK\n"
- "Test for execute permission.\n"
- "@end defvar\n"
- "@defvar F_OK\n"
- "Test for existence of the file. This is implied by each of the\n"
- "other tests, so there's no need to combine it with them.\n"
- "@end defvar\n"
- "\n"
- "It's important to note that @code{access?} does not simply\n"
- "indicate what will happen on attempting to read or write a\n"
- "file. In normal circumstances it does, but in a set-UID or\n"
- "set-GID program it doesn't because @code{access?} tests the\n"
- "real ID, whereas an open or execute attempt uses the effective\n"
- "ID.\n"
- "\n"
- "A program which will never run set-UID/GID can ignore the\n"
- "difference between real and effective IDs, but for maximum\n"
- "generality, especially in library functions, it's best not to\n"
- "use @code{access?} to predict the result of an open or execute,\n"
- "instead simply attempt that and catch any exception.\n"
- "\n"
- "The main use for @code{access?} is to let a set-UID/GID program\n"
- "determine what the invoking user would have been allowed to do,\n"
- "without the greater (or perhaps lesser) privileges afforded by\n"
- "the effective ID. For more on this, see ``Testing File\n"
- "Access'' in The GNU C Library Reference Manual.")
-#define FUNC_NAME s_scm_access
-{
- int rv;
-
- WITH_STRING (path, c_path,
- rv = access (c_path, scm_to_int (how)));
- return scm_from_bool (!rv);
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_getpid, "getpid", 0, 0, 0,
(),
"Return an integer representing the current process ID.")
@@ -2218,12 +2122,6 @@ scm_init_posix ()
scm_c_define ("WUNTRACED", scm_from_int (WUNTRACED));
#endif
- /* access() symbols. */
- scm_c_define ("R_OK", scm_from_int (R_OK));
- scm_c_define ("W_OK", scm_from_int (W_OK));
- scm_c_define ("X_OK", scm_from_int (X_OK));
- scm_c_define ("F_OK", scm_from_int (F_OK));
-
#ifdef LC_COLLATE
scm_c_define ("LC_COLLATE", scm_from_int (LC_COLLATE));
#endif
diff --git a/meta/guile-tools.in b/meta/guile-tools.in
index a0822ae..7f156ff 100755
--- a/meta/guile-tools.in
+++ b/meta/guile-tools.in
@@ -174,7 +174,9 @@ There is NO WARRANTY, to the extent permitted by law.
(else (values (reverse options) args))))))
(define (main args)
- (setlocale LC_ALL "")
+ (if (defined? 'setlocale)
+ (setlocale LC_ALL ""))
+
(call-with-values (lambda () (getopt args *option-grammar*))
(lambda (options args)
(cond
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 327e3fa..800410c 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -957,8 +957,9 @@ VALUE."
-(if (provided? 'posix)
- (primitive-load-path "ice-9/posix"))
+;; Load `posix.scm' even when not (provided? 'posix) so that we get the
+;; `stat' accessors.
+(primitive-load-path "ice-9/posix")
(if (provided? 'socket)
(primitive-load-path "ice-9/networking"))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 8ea2443..1b86b99 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1153,6 +1153,13 @@
(number? (string-contains (car w)
"non-literal format string")))))
+ (pass-if "non-literal format string using gettext"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(format #t (_ "~A ~A!") "hello" "world")
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
(pass-if "wrong format string"
(let ((w (call-with-warnings
(lambda ()
@@ -1190,6 +1197,16 @@
(number? (string-contains (car w)
"expected 1, got 0")))))
+ (pass-if "one missing argument, gettext"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(format some-port (_ "foo ~A~%"))
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ "expected 1, got 0")))))
+
(pass-if "two missing arguments"
(let ((w (call-with-warnings
(lambda ()
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-193-g073167e,
Ludovic Courtès <=