-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 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 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 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
+ * 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
what it takes away, and decide from that whether to use it, instead of
hard coding __hpux. */
-#define _GNU_SOURCE /* ask glibc for everything, in particular strptime */
+#ifndef _REENTRANT
+# define _REENTRANT /* ask solaris for gmtime_r prototype */
+#endif
#ifdef __hpux
#define _POSIX_C_SOURCE 199506L /* for gmtime_r prototype */
#endif
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <stdio.h>
#include <errno.h>
+#include <strftime.h>
+#include <unistr.h>
#include "libguile/_scm.h"
+#include "libguile/async.h"
#include "libguile/feature.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/dynwind.h"
+#include "libguile/strings.h"
#include "libguile/validate.h"
#include "libguile/stime.h"
# include <sys/timeb.h>
#endif
-#if HAVE_CRT_EXTERNS_H
-#include <crt_externs.h> /* for Darwin _NSGetEnviron */
-#endif
-
#ifndef tzname /* For SGI. */
extern char *tzname[]; /* RS6000 and others reject char **tzname. */
#endif
# define timet long
#endif
-extern char ** environ;
-
-/* On Apple Darwin in a shared library there's no "environ" to access
- directly, instead the address of that variable must be obtained with
- _NSGetEnviron(). */
-#if HAVE__NSGETENVIRON && defined (PIC)
-#define environ (*_NSGetEnviron())
-#endif
-
#ifdef HAVE_TIMES
static
result = filltime (<, zoff, zname);
SCM_CRITICAL_SECTION_END;
- if (zname)
- free (zname);
+
+ free (zname);
return result;
}
#undef FUNC_NAME
lt->tm_wday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 6));
lt->tm_yday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 7));
lt->tm_isdst = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 8));
+#if HAVE_STRUCT_TM_TM_GMTOFF
+ lt->tm_gmtoff = - scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
+#endif
#ifdef HAVE_TM_ZONE
- lt->tm_gmtoff = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
if (scm_is_false (SCM_SIMPLE_VECTOR_REF (sbd_time, 10)))
lt->tm_zone = NULL;
else
char **oldenv;
int err;
- scm_frame_begin (0);
+ scm_dynwind_begin (0);
bdtime2c (sbd_time, <, SCM_ARG1, FUNC_NAME);
#if HAVE_STRUCT_TM_TM_ZONE
- scm_frame_free ((char *)lt.tm_zone);
+ scm_dynwind_free ((char *)lt.tm_zone);
#endif
- SCM_CRITICAL_SECTION_START;
+ scm_dynwind_critical_section (SCM_BOOL_F);
+
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
#ifdef LOCALTIME_CACHE
tzset ();
result = scm_cons (scm_from_long (itime),
filltime (<, zoff, zname));
- SCM_CRITICAL_SECTION_END;
- if (zname)
- free (zname);
+ free (zname);
- scm_frame_end ();
+ scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
(SCM format, SCM stime),
- "Formats a time specification @var{time} using @var{template}. @var{time}\n"
- "is an object with time components in the form returned by @code{localtime}\n"
- "or @code{gmtime}. @var{template} is a string which can include formatting\n"
- "specifications introduced by a @code{%} character. The formatting of\n"
- "month and day names is dependent on the current locale. The value returned\n"
- "is the formatted string.\n"
- "@xref{Formatting Date and Time, , , libc, The GNU C Library Reference Manual}.)")
+ "Return a string which is broken-down time structure @var{stime}\n"
+ "formatted according to the given @var{format} string.\n"
+ "\n"
+ "@var{format} contains field specifications introduced by a\n"
+ "@samp{%} character. See @ref{Formatting Calendar Time,,, libc,\n"
+ "The GNU C Library Reference Manual}, or @samp{man 3 strftime},\n"
+ "for the available formatting.\n"
+ "\n"
+ "@lisp\n"
+ "(strftime \"%c\" (localtime (current-time)))\n"
+ "@result{} \"Mon Mar 11 20:17:43 2002\"\n"
+ "@end lisp\n"
+ "\n"
+ "If @code{setlocale} has been called (@pxref{Locales}), month\n"
+ "and day names are from the current locale and in the locale\n"
+ "character set.")
#define FUNC_NAME s_scm_strftime
{
struct tm t;
char *tbuf;
int size = 50;
- const char *fmt;
+ char *fmt;
char *myfmt;
- int len;
+ size_t len;
SCM result;
SCM_VALIDATE_STRING (1, format);
bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
- fmt = scm_i_string_chars (format);
- len = scm_i_string_length (format);
+ /* Convert string to UTF-8 so that non-ASCII characters in the
+ format are passed through unchanged. */
+ fmt = scm_to_utf8_stringn (format, &len);
/* Ugly hack: strftime can return 0 if its buffer is too small,
but some valid time strings (e.g. "%p") can sometimes produce
character to the format string, so that valid returns are always
nonzero. */
myfmt = scm_malloc (len+2);
- *myfmt = 'x';
- strncpy(myfmt+1, fmt, len);
- myfmt[len+1] = 0;
+ *myfmt = (scm_t_uint8) 'x';
+ strncpy (myfmt + 1, fmt, len);
+ myfmt[len + 1] = 0;
+ scm_remember_upto_here_1 (format);
+ free (fmt);
tbuf = scm_malloc (size);
{
environment. interrupts and thread switching must be deferred
until TZ is restored. */
char **oldenv = NULL;
- SCM *velts = (SCM *) SCM_VELTS (stime);
+ SCM zone_spec = SCM_SIMPLE_VECTOR_REF (stime, 10);
int have_zone = 0;
- if (scm_is_true (velts[10]) && *SCM_STRING_CHARS (velts[10]) != 0)
+ if (scm_is_true (zone_spec) && scm_c_string_length (zone_spec) > 0)
{
/* it's not required that the TZ setting be correct, just that
it has the right name. so try something like TZ=EST0.
using only TZ=EST would be simpler but it doesn't work on
some OSs, e.g., Solaris. */
SCM zone =
- scm_string_append (scm_cons (velts[10],
- scm_cons (scm_from_locale_string ("0"),
- SCM_EOL)));
+ scm_string_append (scm_list_2 (zone_spec,
+ scm_from_locale_string ("0")));
have_zone = 1;
SCM_CRITICAL_SECTION_START;
tzset ();
#endif
- /* POSIX says strftime returns 0 on buffer overrun, but old
- systems (i.e. libc 4 on GNU/Linux) might return `size' in that
- case. */
- while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size)
+ /* Use `nstrftime ()' from Gnulib, which supports all GNU extensions
+ supported by glibc. */
+ while ((len = nstrftime (tbuf, size, myfmt, &t, 0, 0)) == 0)
{
free (tbuf);
size *= 2;
#if !defined (HAVE_TM_ZONE)
if (have_zone)
{
- restorezone (velts[10], oldenv, FUNC_NAME);
+ restorezone (zone_spec, oldenv, FUNC_NAME);
SCM_CRITICAL_SECTION_END;
}
#endif
}
- result = scm_from_locale_stringn (tbuf + 1, len - 1);
+ result = scm_from_utf8_string (tbuf + 1);
free (tbuf);
free (myfmt);
#if HAVE_STRUCT_TM_TM_ZONE
#define FUNC_NAME s_scm_strptime
{
struct tm t;
- const char *fmt, *str, *rest;
+ char *fmt, *str, *rest;
+ size_t used_len;
+ long zoff;
SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_STRING (2, string);
- fmt = scm_i_string_chars (format);
- str = scm_i_string_chars (string);
+ /* Convert strings to UTF-8 so that non-ASCII characters are passed
+ through unchanged. */
+ fmt = scm_to_utf8_string (format);
+ str = scm_to_utf8_string (string);
/* initialize the struct tm */
#define tm_init(field) t.field = 0
tm_init (tm_year);
tm_init (tm_wday);
tm_init (tm_yday);
+#if HAVE_STRUCT_TM_TM_GMTOFF
+ tm_init (tm_gmtoff);
+#endif
#undef tm_init
/* GNU glibc strptime() "%s" is affected by the current timezone, since it
instance it doesn't. Force a sensible value for our error
message. */
errno = EINVAL;
+ scm_remember_upto_here_2 (format, string);
+ free (str);
+ free (fmt);
SCM_SYSERROR;
}
- return scm_cons (filltime (&t, 0, NULL),
- scm_from_signed_integer (rest - str));
+ /* tm_gmtoff is set by GNU glibc strptime "%s", so capture it when
+ available */
+#if HAVE_STRUCT_TM_TM_GMTOFF
+ zoff = - t.tm_gmtoff; /* seconds west, not east */
+#else
+ zoff = 0;
+#endif
+
+ /* Compute the number of UTF-8 characters. */
+ used_len = u8_strnlen ((scm_t_uint8*) str, rest-str);
+ scm_remember_upto_here_2 (format, string);
+ free (str);
+ free (fmt);
+
+ return scm_cons (filltime (&t, zoff, NULL),
+ scm_from_signed_integer (used_len));
}
#undef FUNC_NAME
#endif /* HAVE_STRPTIME */
HCoop / bpt / guile.git / blobdiff