Fix infinite loop in expander
[bpt/guile.git] / libguile / posix.c
index b9097d4..494df1e 100644 (file)
@@ -1,5 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
+ *   2014 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
 # include <sched.h>
 #endif
 
-#include "libguile/_scm.h"
-#include "libguile/dynwind.h"
-#include "libguile/fports.h"
-#include "libguile/scmsigs.h"
-#include "libguile/feature.h"
-#include "libguile/strings.h"
-#include "libguile/srfi-13.h"
-#include "libguile/srfi-14.h"
-#include "libguile/vectors.h"
-#include "libguile/values.h"
-
-#include "libguile/validate.h"
-#include "libguile/posix.h"
-#include "libguile/gettext.h"
-#include "libguile/threads.h"
-\f
-
 #ifdef HAVE_STRING_H
 #include <string.h>
 #endif
 # endif
 #endif
 
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#else
-#ifndef ttyname
-extern char *ttyname();
-#endif
-#endif
 
 #ifdef LIBC_H_WITH_UNISTD_H
 #include <libc.h>
@@ -85,15 +63,23 @@ extern char *ttyname();
 #ifdef HAVE_IO_H
 #include <io.h>
 #endif
-#ifdef HAVE_WINSOCK2_H
-#include <winsock2.h>
-#endif
 
-#ifdef __MINGW32__
-/* Some defines for Windows here. */
-# include <process.h>
-# define pipe(fd) _pipe (fd, 256, O_BINARY)
-#endif /* __MINGW32__ */
+#include "libguile/_scm.h"
+#include "libguile/dynwind.h"
+#include "libguile/fports.h"
+#include "libguile/scmsigs.h"
+#include "libguile/feature.h"
+#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
+#include "libguile/srfi-14.h"
+#include "libguile/vectors.h"
+#include "libguile/values.h"
+
+#include "libguile/validate.h"
+#include "libguile/posix.h"
+#include "libguile/gettext.h"
+#include "libguile/threads.h"
+\f
 
 #if HAVE_SYS_WAIT_H
 # include <sys/wait.h>
@@ -168,6 +154,13 @@ extern char *ttyname();
 int sethostname (char *name, size_t namelen);
 #endif
 
+#if defined HAVE_GETLOGIN && !HAVE_DECL_GETLOGIN
+/* MinGW doesn't supply this decl; see
+   http://lists.gnu.org/archive/html/bug-gnulib/2013-03/msg00030.html for more
+   details.  */
+char *getlogin (void);
+#endif
+
 /* On NextStep, <utime.h> doesn't define struct utime, unless we
    #define _POSIX_SOURCE before #including it.  I think this is less
    of a kludge than defining struct utimbuf ourselves.  */
@@ -265,8 +258,10 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
   GETGROUPS_T *groups;
 
   ngroups = getgroups (0, NULL);
-  if (ngroups <= 0)
+  if (ngroups < 0)
     SCM_SYSERROR;
+  else if (ngroups == 0)
+    return scm_c_make_vector (0, SCM_BOOL_F);
 
   size = ngroups * sizeof (GETGROUPS_T);
   groups = scm_malloc (size);
@@ -914,7 +909,7 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
 
 
 #ifdef HAVE_SETEGID
-SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0, 
+SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
             (SCM id),
            "Sets the effective group ID to the integer @var{id}, provided the process\n"
            "has appropriate privileges.  If effective IDs are not supported, the\n"
@@ -925,7 +920,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
 {
   int rv;
 
-#ifdef HAVE_SETEUID
+#ifdef HAVE_SETEGID
   rv = setegid (scm_to_int (id));
 #else
   rv = setgid (scm_to_int (id));
@@ -1146,12 +1141,7 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
 
   exec_argv = scm_i_allocate_string_pointers (args);
 
-  execv (exec_file,
-#ifdef __MINGW32__
-         /* extra "const" in mingw formals, provokes warning from gcc */
-         (const char * const *)
-#endif
-         exec_argv);
+  execv (exec_file, exec_argv);
   SCM_SYSERROR;
 
   /* not reached.  */
@@ -1180,12 +1170,7 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
 
   exec_argv = scm_i_allocate_string_pointers (args);
 
-  execvp (exec_file,
-#ifdef __MINGW32__
-          /* extra "const" in mingw formals, provokes warning from gcc */
-          (const char * const *)
-#endif
-          exec_argv);
+  execvp (exec_file, exec_argv);
   SCM_SYSERROR;
 
   /* not reached.  */
@@ -1219,17 +1204,7 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
   exec_argv = scm_i_allocate_string_pointers (args);
   exec_env = scm_i_allocate_string_pointers (env);
 
-  execve (exec_file,
-#ifdef __MINGW32__
-          /* extra "const" in mingw formals, provokes warning from gcc */
-          (const char * const *)
-#endif
-          exec_argv,
-#ifdef __MINGW32__
-          /* extra "const" in mingw formals, provokes warning from gcc */
-          (const char * const *)
-#endif
-          exec_env);
+  execve (exec_file, exec_argv, exec_env);
   SCM_SYSERROR;
 
   /* not reached.  */
@@ -1371,23 +1346,21 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
 
       /* There is no sense in catching errors on close().  */
-      if (reading) 
+      if (reading)
         {
           close (c2p[1]);
-          read_port = scm_fdes_to_port (c2p[0], "r", sym_read_pipe);
-          scm_setvbuf (read_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
         }
       if (writing)
         {
           close (p2c[0]);
-          write_port = scm_fdes_to_port (p2c[1], "w", sym_write_pipe);
-          scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED);
+          write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
         }
-      
+
       return scm_values
         (scm_list_3 (read_port, write_port, scm_from_int (pid)));
     }
-  
+
   /* The child.  */
   if (reading)
     close (c2p[0]);
@@ -1430,12 +1403,7 @@ scm_open_process (SCM mode, SCM prog, SCM args)
       close (err);
     }
 
-  execvp (exec_file,
-#ifdef __MINGW32__
-          /* extra "const" in mingw formals, provokes warning from gcc */
-          (const char * const *)
-#endif
-          exec_argv);
+  execvp (exec_file, exec_argv);
 
   /* The exec failed!  There is nothing sensible to do.  */
   if (err > 0)
@@ -1636,6 +1604,12 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
     struct utimbuf utm;
     utm.actime = atim_sec;
     utm.modtime = mtim_sec;
+    /* Silence warnings.  */
+    (void) atim_nsec;
+    (void) mtim_nsec;
+
+    if (f != 0)
+      scm_out_of_range(FUNC_NAME, flags);
 
     STRING_SYSCALL (pathname, c_pathname,
                     rv = utime (c_pathname, &utm));
@@ -1920,22 +1894,6 @@ SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_CHROOT */
 
-
-#ifdef __MINGW32__
-/* Wrapper function to supplying `getlogin()' under Windows.  */
-static char * getlogin (void)
-{
-  static char user[256];
-  static unsigned long len = 256;
-
-  if (!GetUserName (user, &len))
-    return NULL;
-  return user;
-}
-#endif /* __MINGW32__ */
-
-
-#if defined (HAVE_GETLOGIN) || defined (__MINGW32__)
 SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0, 
             (void),
            "Return a string containing the name of the user logged in on\n"
@@ -1951,7 +1909,6 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
   return scm_from_locale_string (p);
 }
 #undef FUNC_NAME
-#endif /* HAVE_GETLOGIN */
 
 #if HAVE_GETPRIORITY
 SCM_DEFINE (scm_getpriority, "getpriority", 2, 0, 0, 
@@ -2023,9 +1980,9 @@ cpu_set_to_bitvector (const cpu_set_t *cs)
   SCM bv;
   size_t cpu;
 
-  bv = scm_c_make_bitvector (sizeof (*cs), SCM_BOOL_F);
+  bv = scm_c_make_bitvector (CPU_SETSIZE, SCM_BOOL_F);
 
-  for (cpu = 0; cpu < sizeof (*cs); cpu++)
+  for (cpu = 0; cpu < CPU_SETSIZE; cpu++)
     {
       if (CPU_ISSET (cpu, cs))
        /* XXX: This is inefficient but avoids code duplication.  */
@@ -2291,6 +2248,12 @@ void
 scm_init_posix ()
 {
   scm_add_feature ("posix");
+#ifdef EXIT_SUCCESS
+  scm_c_define ("EXIT_SUCCESS", scm_from_int (EXIT_SUCCESS));
+#endif
+#ifdef EXIT_FAILURE
+  scm_c_define ("EXIT_FAILURE", scm_from_int (EXIT_FAILURE));
+#endif
 #ifdef HAVE_GETEUID
   scm_add_feature ("EIDs");
 #endif
@@ -2377,6 +2340,7 @@ scm_init_posix ()
 #include "libguile/posix.x"
 
 #ifdef HAVE_FORK
+  scm_add_feature ("fork");
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_popen",
                            (scm_t_extension_init_func) scm_init_popen,