diff options
author | Mark H Weaver <mhw@netris.org> | 2014-01-09 01:32:32 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-01-09 02:52:34 -0500 |
commit | 1df515a077f26d59510e48fad3d45a33d2c90e0f (patch) | |
tree | 05991bb4b3d527390d036fbb17617d6905097bda /libguile | |
parent | 61989c705359c50c61d7f52392f244d386218298 (diff) | |
parent | 306cc01d3981feaa11aa0d866ff1d99128f0ace3 (diff) | |
download | guile-1df515a077f26d59510e48fad3d45a33d2c90e0f.tar.gz |
Merge branch 'stable-2.0'
Conflicts:
module/system/vm/traps.scm
test-suite/tests/peval.test
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/load.c | 15 | ||||
-rw-r--r-- | libguile/numbers.c | 23 | ||||
-rw-r--r-- | libguile/numbers.h | 2 | ||||
-rw-r--r-- | libguile/private-options.h | 2 | ||||
-rw-r--r-- | libguile/read.c | 3 | ||||
-rw-r--r-- | libguile/socket.c | 2 | ||||
-rw-r--r-- | libguile/srfi-13.c | 13 |
7 files changed, 43 insertions, 17 deletions
diff --git a/libguile/load.c b/libguile/load.c index 16e3fb2a6..5019201dc 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -88,7 +88,6 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM ret = SCM_UNSPECIFIED; - char *encoding; SCM_VALIDATE_STRING (1, filename); if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) @@ -101,18 +100,14 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM port; - port = scm_open_file (filename, scm_from_locale_string ("r")); + port = scm_open_file_with_encoding (filename, + scm_from_latin1_string ("r"), + SCM_BOOL_T, /* guess_encoding */ + scm_from_latin1_string ("UTF-8")); + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); scm_i_dynwind_current_load_port (port); - encoding = scm_i_scan_for_encoding (port); - if (encoding) - scm_i_set_port_encoding_x (port, encoding); - else - /* The file has no encoding declared. We'll presume UTF-8, like - compile-file does. */ - scm_i_set_port_encoding_x (port, "UTF-8"); - while (1) { SCM reader, form; diff --git a/libguile/numbers.c b/libguile/numbers.c index 2ed98d3f6..f4e8b2710 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -6519,8 +6519,8 @@ SCM_DEFINE (scm_rational_p, "rational?", 1, 0, 0, SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0, (SCM x), - "Return @code{#t} if @var{x} is an integer number, @code{#f}\n" - "else.") + "Return @code{#t} if @var{x} is an integer number,\n" + "else return @code{#f}.") #define FUNC_NAME s_scm_integer_p { if (SCM_I_INUMP (x) || SCM_BIGP (x)) @@ -6535,6 +6535,19 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_exact_integer_p, "exact-integer?", 1, 0, 0, + (SCM x), + "Return @code{#t} if @var{x} is an exact integer number,\n" + "else return @code{#f}.") +#define FUNC_NAME s_scm_exact_integer_p +{ + if (SCM_I_INUMP (x) || SCM_BIGP (x)) + return SCM_BOOL_T; + else + return SCM_BOOL_F; +} +#undef FUNC_NAME + SCM scm_i_num_eq_p (SCM, SCM, SCM); SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1, @@ -9624,6 +9637,12 @@ scm_is_integer (SCM val) } int +scm_is_exact_integer (SCM val) +{ + return scm_is_true (scm_exact_integer_p (val)); +} + +int scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) { if (SCM_I_INUMP (val)) diff --git a/libguile/numbers.h b/libguile/numbers.h index 5cdfbacea..6e382ea35 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -242,6 +242,7 @@ SCM_API SCM scm_complex_p (SCM x); SCM_API SCM scm_real_p (SCM x); SCM_API SCM scm_rational_p (SCM z); SCM_API SCM scm_integer_p (SCM x); +SCM_API SCM scm_exact_integer_p (SCM x); SCM_API SCM scm_inexact_p (SCM x); SCM_API int scm_is_inexact (SCM x); SCM_API SCM scm_num_eq_p (SCM x, SCM y); @@ -330,6 +331,7 @@ SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port); /* conversion functions for integers */ SCM_API int scm_is_integer (SCM val); +SCM_API int scm_is_exact_integer (SCM val); SCM_API int scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max); SCM_API int scm_is_unsigned_integer (SCM val, diff --git a/libguile/private-options.h b/libguile/private-options.h index ed0f314e5..4f580a640 100644 --- a/libguile/private-options.h +++ b/libguile/private-options.h @@ -69,6 +69,6 @@ SCM_INTERNAL scm_t_option scm_read_opts[]; #define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[6].val #define SCM_CURLY_INFIX_P scm_read_opts[7].val -#define SCM_N_READ_OPTIONS 7 +#define SCM_N_READ_OPTIONS 8 #endif /* PRIVATE_OPTIONS */ diff --git a/libguile/read.c b/libguile/read.c index 382a1d379..61addf3a5 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1116,6 +1116,9 @@ read_decimal_integer (SCM port, int c, ssize_t *resp) while ('0' <= c && c <= '9') { + if (((SSIZE_MAX - (c-'0')) / 10) <= res) + scm_i_input_error ("read_decimal_integer", port, + "number too large", SCM_EOL); res = 10*res + c-'0'; got_it = 1; c = scm_getc_unlocked (port); diff --git a/libguile/socket.c b/libguile/socket.c index 34bc21a73..8c1326a54 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -1331,7 +1331,7 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0, sock = SCM_COERCE_OUTPORT (sock); SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); - newfd = accept (fd, (struct sockaddr *) &addr, &addr_size); + SCM_SYSCALL (newfd = accept (fd, (struct sockaddr *) &addr, &addr_size)); if (newfd == -1) SCM_SYSERROR; newsock = SCM_SOCK_FD_TO_PORT (newfd); diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index 4e5d5725f..5c30dfe20 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -546,10 +546,17 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0, SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart); target = scm_i_string_start_writing (target); - for (i = 0; i < cend - cstart; i++) + if (ctstart < cstart) { - scm_i_string_set_x (target, ctstart + i, - scm_i_string_ref (s, cstart + i)); + for (i = 0; i < len; i++) + scm_i_string_set_x (target, ctstart + i, + scm_i_string_ref (s, cstart + i)); + } + else + { + for (i = len; i--;) + scm_i_string_set_x (target, ctstart + i, + scm_i_string_ref (s, cstart + i)); } scm_i_string_stop_writing (); scm_remember_upto_here_1 (target); |