diff options
31 files changed, 371 insertions, 154 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index ce2af7a77..a24e860ca 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,7 +8,9 @@ (eval . (put 'pass-if 'scheme-indent-function 1)) (eval . (put 'pass-if-exception 'scheme-indent-function 2)) (eval . (put 'pass-if-equal 'scheme-indent-function 2)) - (eval . (put 'with-test-prefix 'scheme-indent-function 1)))) + (eval . (put 'with-test-prefix 'scheme-indent-function 1)) + (eval . (put 'with-code-coverage 'scheme-indent-function 1)) + (eval . (put 'with-statprof 'scheme-indent-function 1)))) (emacs-lisp-mode . ((indent-tabs-mode . nil))) (texinfo-mode . ((indent-tabs-mode . nil) (fill-column . 72)))) @@ -77,6 +77,7 @@ For fixes or providing information which led to a fix: Fu-gangqiang Aidan Gauland Peter Gavin + Andrew Gaylard Nils Gey Eric Gillespie, Jr Didier Godefroy diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi index f34074ec6..026308cac 100644 --- a/doc/ref/api-control.texi +++ b/doc/ref/api-control.texi @@ -1424,7 +1424,8 @@ Guile) formats using @code{display} and @code{~S} (was @code{system-error} then it should be a list containing the Unix @code{errno} value; If @var{key} is @code{signal} then it should be a list containing the Unix signal number; If -@var{key} is @code{out-of-range} or @code{wrong-type-arg}, +@var{key} is @code{out-of-range}, @code{wrong-type-arg}, +or @code{keyword-argument-error}, it is a list containing the bad value; otherwise it will usually be @code{#f}. @end deffn diff --git a/doc/ref/api-macros.texi b/doc/ref/api-macros.texi index 09ffee6a7..82a2c071e 100644 --- a/doc/ref/api-macros.texi +++ b/doc/ref/api-macros.texi @@ -122,8 +122,8 @@ same @var{letrec-syntax}. exp) ((my-or exp rest ...) (let ((t exp)) - (if exp - exp + (if t + t (my-or rest ...))))))) (my-or #f "rockaway beach")) @result{} "rockaway beach" @@ -323,8 +323,8 @@ Consider the definition of @code{my-or} from the previous section: exp) ((my-or exp rest ...) (let ((t exp)) - (if exp - exp + (if t + t (my-or rest ...)))))) @end example diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index b23082192..0d036be9e 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -446,9 +446,9 @@ which the calling thread will wait to be signalled before returning. @code{wait-condition-variable}, except that the mutex is left in an unlocked state when the function returns.) -When @var{timeout} is also given, it specifies a point in time where -the waiting should be aborted. It can be either an integer as -returned by @code{current-time} or a pair as returned by +When @var{timeout} is also given and not false, it specifies a point in +time where the waiting should be aborted. It can be either an integer +as returned by @code{current-time} or a pair as returned by @code{gettimeofday}. When the waiting is aborted, @code{#f} is returned. Otherwise the function returns @code{#t}. @end deffn diff --git a/libguile/error.c b/libguile/error.c index 0df4c737e..26cf5b6d6 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -80,7 +80,8 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, "@code{system-error} then it should be a list containing the\n" "Unix @code{errno} value; If @var{key} is @code{signal} then it\n" "should be a list containing the Unix signal number; If\n" - "@var{key} is @code{out-of-range} or @code{wrong-type-arg},\n" + "@var{key} is @code{out-of-range}, @code{wrong-type-arg},\n" + "or @code{keyword-argument-error}, " "it is a list containing the bad value; otherwise\n" "it will usually be @code{#f}.") #define FUNC_NAME s_scm_error_scm diff --git a/libguile/eval.c b/libguile/eval.c index b245026f0..f5e1524c7 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -162,18 +162,18 @@ static void error_used_before_defined (void) "Variable used before given a value", SCM_EOL, SCM_BOOL_F); } -static void error_invalid_keyword (SCM proc) +static void error_invalid_keyword (SCM proc, SCM obj) { scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc, scm_from_locale_string ("Invalid keyword"), SCM_EOL, - SCM_BOOL_F); + scm_list_1 (obj)); } -static void error_unrecognized_keyword (SCM proc) +static void error_unrecognized_keyword (SCM proc, SCM kw) { scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc, scm_from_locale_string ("Unrecognized keyword"), SCM_EOL, - SCM_BOOL_F); + scm_list_1 (kw)); } @@ -818,10 +818,10 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args, break; } if (scm_is_null (walk) && scm_is_false (aok)) - error_unrecognized_keyword (proc); + error_unrecognized_keyword (proc, k); } if (scm_is_pair (args) && scm_is_false (rest)) - error_invalid_keyword (proc); + error_invalid_keyword (proc, CAR (args)); /* Now fill in unbound values, evaluating init expressions in their appropriate environment. */ diff --git a/libguile/keywords.c b/libguile/keywords.c index 96c0b0144..f630259d9 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. - * +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, + * 2006, 2008, 2009, 2011, 2013 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 @@ -157,9 +158,11 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest, { /* KW_OR_ARG is not in the list of expected keywords. */ if (!(flags & SCM_ALLOW_OTHER_KEYS)) - scm_error (scm_keyword_argument_error, - subr, "Unrecognized keyword", - SCM_EOL, SCM_BOOL_F); + scm_error_scm (scm_keyword_argument_error, + scm_from_locale_string (subr), + scm_from_latin1_string + ("Unrecognized keyword"), + SCM_EOL, scm_list_1 (kw_or_arg)); break; } arg_p = va_arg (va, SCM *); @@ -181,9 +184,10 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest, /* The next argument is not a keyword, or is a singleton keyword at the end of REST. */ if (!(flags & SCM_ALLOW_NON_KEYWORD_ARGUMENTS)) - scm_error (scm_keyword_argument_error, - subr, "Invalid keyword", - SCM_EOL, SCM_BOOL_F); + scm_error_scm (scm_keyword_argument_error, + scm_from_locale_string (subr), + scm_from_latin1_string ("Invalid keyword"), + SCM_EOL, scm_list_1 (kw_or_arg)); /* Advance REST. */ rest = tail; diff --git a/libguile/numbers.c b/libguile/numbers.c index d941133df..9857e182d 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -100,6 +100,13 @@ typedef scm_t_signed_bits scm_t_inum; #define DOUBLE_IS_POSITIVE_INFINITY(x) (isinf(x) && ((x) > 0)) #define DOUBLE_IS_NEGATIVE_INFINITY(x) (isinf(x) && ((x) < 0)) +/* Test an inum to see if it can be converted to a double without loss + of precision. Note that this will sometimes return 0 even when 1 + could have been returned, e.g. for large powers of 2. It is designed + to be a fast check to optimize common cases. */ +#define INUM_LOSSLESSLY_CONVERTIBLE_TO_DOUBLE(n) \ + (SCM_I_FIXNUM_BIT-1 <= DBL_MANT_DIG \ + || ((n) ^ ((n) >> (SCM_I_FIXNUM_BIT-1))) < (1L << DBL_MANT_DIG)) #if ! HAVE_DECL_MPZ_INITS @@ -506,10 +513,10 @@ scm_i_divide2double (SCM n, SCM d) if (SCM_LIKELY (SCM_I_INUMP (d))) { - if (SCM_LIKELY (SCM_I_INUMP (n) - && (SCM_I_FIXNUM_BIT-1 <= DBL_MANT_DIG - || (SCM_I_INUM (n) < (1L << DBL_MANT_DIG) - && SCM_I_INUM (d) < (1L << DBL_MANT_DIG))))) + if (SCM_LIKELY + (SCM_I_INUMP (n) + && INUM_LOSSLESSLY_CONVERTIBLE_TO_DOUBLE (SCM_I_INUM (n)) + && INUM_LOSSLESSLY_CONVERTIBLE_TO_DOUBLE (SCM_I_INUM (d)))) /* If both N and D can be losslessly converted to doubles, then we can rely on IEEE floating point to do proper rounding much faster than we can. */ @@ -6535,9 +6542,11 @@ scm_num_eq_p (SCM x, SCM y) to a double and compare. But on a 64-bit system an inum is bigger than a double and - casting it to a double (call that dxx) will round. dxx is at - worst 1 bigger or smaller than xx, so if dxx==yy we know yy is - an integer and fits a long. So we cast yy to a long and + casting it to a double (call that dxx) will round. + Although dxx will not in general be equal to xx, dxx will + always be an integer and within a factor of 2 of xx, so if + dxx==yy, we know that yy is an integer and fits in + scm_t_signed_bits. So we cast yy to scm_t_signed_bits and compare with plain xx. An alternative (for any size system actually) would be to check @@ -6552,8 +6561,14 @@ scm_num_eq_p (SCM x, SCM y) || xx == (scm_t_signed_bits) yy)); } else if (SCM_COMPLEXP (y)) - return scm_from_bool (((double) xx == SCM_COMPLEX_REAL (y)) - && (0.0 == SCM_COMPLEX_IMAG (y))); + { + /* see comments with inum/real above */ + double ry = SCM_COMPLEX_REAL (y); + return scm_from_bool ((double) xx == ry + && 0.0 == SCM_COMPLEX_IMAG (y) + && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 + || xx == (scm_t_signed_bits) ry)); + } else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; else @@ -6610,24 +6625,21 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_BIGP (y)) { int cmp; - if (isnan (SCM_REAL_VALUE (x))) + if (isnan (xx)) return SCM_BOOL_F; - cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); + cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx); scm_remember_upto_here_1 (y); return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) - return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (xx == SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) - return scm_from_bool ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) - && (0.0 == SCM_COMPLEX_IMAG (y))); + return scm_from_bool ((xx == SCM_COMPLEX_REAL (y)) + && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { - double xx = SCM_REAL_VALUE (x); - if (isnan (xx)) + if (isnan (xx) || isinf (xx)) return SCM_BOOL_F; - if (isinf (xx)) - return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -6638,8 +6650,15 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_COMPLEXP (x)) { if (SCM_I_INUMP (y)) - return scm_from_bool ((SCM_COMPLEX_REAL (x) == (double) SCM_I_INUM (y)) - && (SCM_COMPLEX_IMAG (x) == 0.0)); + { + /* see comments with inum/real above */ + double rx = SCM_COMPLEX_REAL (x); + scm_t_signed_bits yy = SCM_I_INUM (y); + return scm_from_bool (rx == (double) yy + && 0.0 == SCM_COMPLEX_IMAG (x) + && (DBL_MANT_DIG >= SCM_I_FIXNUM_BIT-1 + || (scm_t_signed_bits) rx == yy)); + } else if (SCM_BIGP (y)) { int cmp; @@ -6653,20 +6672,18 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_REALP (y)) return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) - && (SCM_COMPLEX_IMAG (x) == 0.0)); + && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_COMPLEXP (y)) return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) - && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); + && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { double xx; if (SCM_COMPLEX_IMAG (x) != 0.0) return SCM_BOOL_F; xx = SCM_COMPLEX_REAL (x); - if (isnan (xx)) + if (isnan (xx) || isinf (xx)) return SCM_BOOL_F; - if (isinf (xx)) - return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -6683,10 +6700,8 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_REALP (y)) { double yy = SCM_REAL_VALUE (y); - if (isnan (yy)) + if (isnan (yy) || isinf (yy)) return SCM_BOOL_F; - if (isinf (yy)) - return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -6696,10 +6711,8 @@ scm_num_eq_p (SCM x, SCM y) if (SCM_COMPLEX_IMAG (y) != 0.0) return SCM_BOOL_F; yy = SCM_COMPLEX_REAL (y); - if (isnan (yy)) + if (isnan (yy) || isinf(yy)) return SCM_BOOL_F; - if (isinf (yy)) - return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -6760,7 +6773,25 @@ scm_less_p (SCM x, SCM y) return scm_from_bool (sgn > 0); } else if (SCM_REALP (y)) - return scm_from_bool ((double) xx < SCM_REAL_VALUE (y)); + { + /* We can safely take the ceiling of y without changing the + result of x<y, given that x is an integer. */ + double yy = ceil (SCM_REAL_VALUE (y)); + + /* In the following comparisons, it's important that the right + hand side always be a power of 2, so that it can be + losslessly converted to a double even on 64-bit + machines. */ + if (yy >= (double) (SCM_MOST_POSITIVE_FIXNUM+1)) + return SCM_BOOL_T; + else if (!(yy > (double) SCM_MOST_NEGATIVE_FIXNUM)) + /* The condition above is carefully written to include the + case where yy==NaN. */ + return SCM_BOOL_F; + else + /* yy is a finite integer that fits in an inum. */ + return scm_from_bool (xx < (scm_t_inum) yy); + } else if (SCM_FRACTIONP (y)) { /* "x < a/b" becomes "x*b < a" */ @@ -6805,7 +6836,25 @@ scm_less_p (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_I_INUMP (y)) - return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_I_INUM (y)); + { + /* We can safely take the floor of x without changing the + result of x<y, given that y is an integer. */ + double xx = floor (SCM_REAL_VALUE (x)); + + /* In the following comparisons, it's important that the right + hand side always be a power of 2, so that it can be + losslessly converted to a double even on 64-bit + machines. */ + if (xx < (double) SCM_MOST_NEGATIVE_FIXNUM) + return SCM_BOOL_T; + else if (!(xx < (double) (SCM_MOST_POSITIVE_FIXNUM+1))) + /* The condition above is carefully written to include the + case where xx==NaN. */ + return SCM_BOOL_F; + else + /* xx is a finite integer that fits in an inum. */ + return scm_from_bool ((scm_t_inum) xx < SCM_I_INUM (y)); + } else if (SCM_BIGP (y)) { int cmp; diff --git a/libguile/posix.c b/libguile/posix.c index 822599d9e..0443f95ea 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -910,7 +910,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" @@ -921,7 +921,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)); diff --git a/libguile/socket.c b/libguile/socket.c index 7e735f43c..34bc21a73 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -1645,7 +1645,7 @@ scm_init_socket () #ifdef AF_UNSPEC scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC)); #endif -#ifdef AF_UNIX +#if defined HAVE_UNIX_DOMAIN_SOCKETS && defined AF_UNIX scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX)); #endif #ifdef AF_INET diff --git a/libguile/threads.c b/libguile/threads.c index ef771dcae..99582cca0 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -326,7 +326,7 @@ remqueue (SCM q, SCM c) if (scm_is_eq (p, c)) { if (scm_is_eq (c, SCM_CAR (q))) - SCM_SETCAR (q, SCM_CDR (c)); + SCM_SETCAR (q, scm_is_eq (prev, q) ? SCM_EOL : prev); SCM_SETCDR (prev, SCM_CDR (c)); /* GC-robust */ @@ -1712,7 +1712,7 @@ SCM_DEFINE (scm_unlock_mutex_timed, "unlock-mutex", 1, 2, 0, { SCM_VALIDATE_CONDVAR (2, cond); - if (! (SCM_UNBNDP (timeout))) + if (! SCM_UNBNDP (timeout) && ! scm_is_false (timeout)) { to_timespec (timeout, &cwaittime); waittime = &cwaittime; diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 8b11e7f24..9b12d3e77 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1555,11 +1555,13 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) break; } VM_ASSERT (scm_is_pair (walk) || allow_other_keys, - vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp))); + vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp), + LOCAL_REF (ntotal + n))); n++; } else - VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp))); + VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp), + LOCAL_REF (ntotal + n))); if (has_rest) { diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index ef3d02b7c..2f1d5fe02 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -402,8 +402,12 @@ VM_DEFINE_FUNCTION (161, ash, "ash", 2) if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) { if (SCM_I_INUM (y) < 0) - /* Right shift, will be a fixnum. */ - RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y))); + { + /* Right shift, will be a fixnum. */ + if (SCM_I_INUM (y) > -SCM_I_FIXNUM_BIT) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y))); + /* fall through */ + } else /* Left shift. See comments in scm_ash. */ { diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 248db9af0..0973792bd 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -697,12 +697,12 @@ VM_DEFINE_INSTRUCTION (50, bind_kwargs, "bind-kwargs", 5, 0, 0) } VM_ASSERT (scm_is_pair (walk) || (kw_and_rest_flags & F_ALLOW_OTHER_KEYS), - vm_error_kwargs_unrecognized_keyword (program)); + vm_error_kwargs_unrecognized_keyword (program, sp[nkw])); nkw++; } else VM_ASSERT (kw_and_rest_flags & F_REST, - vm_error_kwargs_invalid_keyword (program)); + vm_error_kwargs_invalid_keyword (program, sp[nkw])); } NEXT; diff --git a/libguile/vm.c b/libguile/vm.c index f43191299..dd016b7fe 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -416,8 +416,8 @@ static void vm_error_unbound_fluid (SCM proc, SCM fluid) SCM_NORETURN SCM_NOINLI static void vm_error_not_a_variable (const char *func_name, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN SCM_NOINLINE; -static void vm_error_kwargs_invalid_keyword (SCM proc) SCM_NORETURN SCM_NOINLINE; -static void vm_error_kwargs_unrecognized_keyword (SCM proc) SCM_NORETURN SCM_NOINLINE; +static void vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) SCM_NORETURN SCM_NOINLINE; +static void vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) SCM_NORETURN SCM_NOINLINE; static void vm_error_too_many_args (int nargs) SCM_NORETURN SCM_NOINLINE; static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN SCM_NOINLINE; static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN SCM_NOINLINE; @@ -486,19 +486,19 @@ vm_error_kwargs_length_not_even (SCM proc) } static void -vm_error_kwargs_invalid_keyword (SCM proc) +vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) { scm_error_scm (sym_keyword_argument_error, proc, scm_from_latin1_string ("Invalid keyword"), - SCM_EOL, SCM_BOOL_F); + SCM_EOL, scm_list_1 (obj)); } static void -vm_error_kwargs_unrecognized_keyword (SCM proc) +vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) { scm_error_scm (sym_keyword_argument_error, proc, scm_from_latin1_string ("Unrecognized keyword"), - SCM_EOL, SCM_BOOL_F); + SCM_EOL, scm_list_1 (kw)); } static void diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 48aec4904..39d313f63 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -977,12 +977,17 @@ information is unavailable." (_ (default-printer))) args)) + (define (keyword-error-printer port key args default-printer) + (let ((message (cadr args)) + (faulty (car (cadddr args)))) ; I won't do it again, I promise. + (format port "~a: ~s" message faulty))) + (define (getaddrinfo-error-printer port key args default-printer) (format port "In procedure getaddrinfo: ~a" (gai-strerror (car args)))) (set-exception-printer! 'goops-error scm-error-printer) (set-exception-printer! 'host-not-found scm-error-printer) - (set-exception-printer! 'keyword-argument-error scm-error-printer) + (set-exception-printer! 'keyword-argument-error keyword-error-printer) (set-exception-printer! 'misc-error scm-error-printer) (set-exception-printer! 'no-data scm-error-printer) (set-exception-printer! 'no-recovery scm-error-printer) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index bb1ce1e81..fdf16c8ae 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -349,7 +349,7 @@ (scm-error 'keyword-argument-error "eval" "Unrecognized keyword" - '() #f))) + '() (list (car args))))) (lp (cddr args))) (if (pair? args) (if rest? @@ -357,7 +357,7 @@ (lp (cdr args)) (scm-error 'keyword-argument-error "eval" "Invalid keyword" - '() #f)) + '() (list (car args)))) ;; Finished parsing keywords. Fill in ;; uninitialized kwargs by evalling init ;; expressions in their appropriate diff --git a/module/rnrs/arithmetic/bitwise.scm b/module/rnrs/arithmetic/bitwise.scm index bb3a20797..ac870ff79 100644 --- a/module/rnrs/arithmetic/bitwise.scm +++ b/module/rnrs/arithmetic/bitwise.scm @@ -53,9 +53,13 @@ (logand bitwise-and) (logior bitwise-ior) (logxor bitwise-xor) - (logcount bitwise-bit-count) (ash bitwise-arithmetic-shift))) + (define (bitwise-bit-count ei) + (if (negative? ei) + (bitwise-not (logcount ei)) + (logcount ei))) + (define (bitwise-if ei1 ei2 ei3) (bitwise-ior (bitwise-and ei1 ei2) (bitwise-and (bitwise-not ei1) ei3))) diff --git a/module/web/uri.scm b/module/web/uri.scm index 7fe010096..3ab820d14 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -6,12 +6,12 @@ ;;;; 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 ;;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA @@ -20,7 +20,7 @@ ;;; Commentary: ;; A data type for Universal Resource Identifiers, as defined in RFC -;; 3986. +;; 3986. ;;; Code: @@ -382,7 +382,7 @@ The default character set includes alphanumerics from ASCII, as well as the special characters ‘-’, ‘.’, ‘_’, and ‘~’. Any other character will be percent-encoded, by writing out the character to a bytevector within the given ENCODING, then encoding each byte as ‘%HH’, where HH is the -hexadecimal representation of the byte." +uppercase hexadecimal representation of the byte." (define (needs-escaped? ch) (not (char-set-contains? unescaped-chars ch))) (if (string-index str needs-escaped?) @@ -400,7 +400,8 @@ hexadecimal representation of the byte." (display #\% port) (when (< byte 16) (display #\0 port)) - (display (number->string byte 16) port) + (display (string-upcase (number->string byte 16)) + port) (lp (1+ i)))))))) str))) str)) diff --git a/test-suite/standalone/test-language b/test-suite/standalone/test-language index 59ed82b62..d67d36129 100755 --- a/test-suite/standalone/test-language +++ b/test-suite/standalone/test-language @@ -8,7 +8,9 @@ set -e # The default language in effect until `--language' is encountered is # Scheme. guile -c "(exit (= 3 (apply + '(1 2))))" --language=elisp -! guile -c "(= (funcall (symbol-function '+) 1 2) 3)" 2> /dev/null + +if guile -c "(= (funcall (symbol-function '+) 1 2) 3)" 2> /dev/null +then false; else true; fi guile --language=elisp -c "(= (funcall (symbol-function '+) 1 2) 3)" guile --language=ecmascript -c '(function (x) { return x * x; })(2);' diff --git a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c index 6fcf82180..ad0722ce8 100644 --- a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c +++ b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c @@ -25,20 +25,6 @@ #include <assert.h> static SCM -error_handler (void *data, SCM key, SCM args) -{ - SCM expected_args = scm_list_n (scm_from_utf8_string ("test"), - scm_from_utf8_string ((char *) data), - SCM_EOL, SCM_BOOL_F, - SCM_UNDEFINED); - - assert (scm_is_eq (key, scm_from_utf8_symbol ("keyword-argument-error"))); - assert (scm_is_true (scm_equal_p (args, expected_args))); - - return SCM_BOOL_T; -} - -static SCM test_unrecognized_keyword (void *data) { SCM k_foo = scm_from_utf8_keyword ("foo"); @@ -58,6 +44,21 @@ test_unrecognized_keyword (void *data) } static SCM +unrecognized_keyword_error_handler (void *data, SCM key, SCM args) +{ + SCM expected_args = scm_list_n + (scm_from_utf8_string ("test"), + scm_from_utf8_string ("Unrecognized keyword"), + SCM_EOL, scm_list_1 (scm_from_utf8_keyword ("baz")), + SCM_UNDEFINED); + + assert (scm_is_eq (key, scm_from_utf8_symbol ("keyword-argument-error"))); + assert (scm_is_true (scm_equal_p (args, expected_args))); + + return SCM_BOOL_T; +} + +static SCM test_invalid_keyword (void *data) { SCM k_foo = scm_from_utf8_keyword ("foo"); @@ -76,6 +77,21 @@ test_invalid_keyword (void *data) } static SCM +invalid_keyword_error_handler (void *data, SCM key, SCM args) +{ + SCM expected_args = scm_list_n + (scm_from_utf8_string ("test"), + scm_from_utf8_string ("Invalid keyword"), + SCM_EOL, scm_list_1 (SCM_INUM0), + SCM_UNDEFINED); + + assert (scm_is_eq (key, scm_from_utf8_symbol ("keyword-argument-error"))); + assert (scm_is_true (scm_equal_p (args, expected_args))); + + return SCM_BOOL_T; +} + +static SCM test_odd_length (void *data) { SCM k_foo = scm_from_utf8_keyword ("foo"); @@ -93,6 +109,21 @@ test_odd_length (void *data) assert (0); } +static SCM +odd_length_error_handler (void *data, SCM key, SCM args) +{ + SCM expected_args = scm_list_n + (scm_from_utf8_string ("test"), + scm_from_utf8_string ("Odd length of keyword argument list"), + SCM_EOL, SCM_BOOL_F, + SCM_UNDEFINED); + + assert (scm_is_eq (key, scm_from_utf8_symbol ("keyword-argument-error"))); + assert (scm_is_true (scm_equal_p (args, expected_args))); + + return SCM_BOOL_T; +} + static void test_scm_c_bind_keyword_arguments () { @@ -174,17 +205,17 @@ test_scm_c_bind_keyword_arguments () /* Test unrecognized keyword error. */ scm_internal_catch (SCM_BOOL_T, test_unrecognized_keyword, NULL, - error_handler, "Unrecognized keyword"); + unrecognized_keyword_error_handler, NULL); /* Test invalid keyword error. */ scm_internal_catch (SCM_BOOL_T, test_invalid_keyword, NULL, - error_handler, "Invalid keyword"); + invalid_keyword_error_handler, NULL); /* Test odd length error. */ scm_internal_catch (SCM_BOOL_T, test_odd_length, NULL, - error_handler, "Odd length of keyword argument list"); + odd_length_error_handler, NULL); } static void diff --git a/test-suite/standalone/test-system-cmds b/test-suite/standalone/test-system-cmds index f5007297e..8c590835d 100755 --- a/test-suite/standalone/test-system-cmds +++ b/test-suite/standalone/test-system-cmds @@ -9,8 +9,10 @@ exec guile -q -s "$0" "$@" #t "test-system-cmds: (system) did not return a boolean\n") (exit 1))) - - (let ((rs (status:exit-val (system "guile -c '(exit 42)'")))) + + ;; Note: Use double quotes since simple quotes are not supported by + ;; `cmd.exe' on Windows. + (let ((rs (status:exit-val (system "guile -c \"(exit 42)\"")))) (if (not (= 42 rs)) (begin (simple-format @@ -39,4 +41,4 @@ exec guile -q -s "$0" "$@" ;; Local Variables: ;; mode: scheme -;; End:
\ No newline at end of file +;; End: diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index cf56a9658..3aa3e159d 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2004, 2005, 2008, 2009, 2010 Free Software Foundation, Inc. +/* Copyright (C) 2004, 2005, 2008, 2009, 2010, 2013 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 @@ -200,9 +200,20 @@ check_ports () #define FILENAME_TEMPLATE "/check-ports.XXXXXX" char *filename; const char *tmpdir = getenv ("TMPDIR"); +#ifdef __MINGW32__ + extern int mkstemp (char *); + /* On Windows neither $TMPDIR nor /tmp can be relied on. */ + if (tmpdir == NULL) + tmpdir = getenv ("TEMP"); + if (tmpdir == NULL) + tmpdir = getenv ("TMP"); + if (tmpdir == NULL) + tmpdir = "/"; +#else if (tmpdir == NULL) tmpdir = "/tmp"; +#endif filename = alloca (strlen (tmpdir) + sizeof (FILENAME_TEMPLATE) + 1); strcpy (filename, tmpdir); diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test index b29de0f20..336c87a33 100644 --- a/test-suite/tests/coverage.test +++ b/test-suite/tests/coverage.test @@ -1,6 +1,6 @@ ;;;; coverage.test --- Code coverage. -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011, 2012, 2013 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 @@ -230,19 +230,22 @@ ;; The `scm_call_N' functions use the VM returned by `the-vm'. This ;; test makes sure that they get to use %TEST-VM. (let ((proc (code "foo.scm" "(lambda (x y) (+ x y))")) - (call (pointer->procedure '* - (dynamic-func "scm_call_2" - (dynamic-link)) - '(* * *)))) - (let-values (((data result) - (with-code-coverage %test-vm - (lambda () - (call (make-pointer (object-address proc)) - (make-pointer (object-address 1)) - (make-pointer (object-address 2))))))) - (and (coverage-data? data) - (= (object-address 3) (pointer-address result)) - (= (procedure-execution-count data proc) 1))))) + (call (false-if-exception ; can we resolve `scm_call_2'? + (pointer->procedure '* + (dynamic-func "scm_call_2" + (dynamic-link)) + '(* * *))))) + (if call + (let-values (((data result) + (with-code-coverage %test-vm + (lambda () + (call (make-pointer (object-address proc)) + (make-pointer (object-address 1)) + (make-pointer (object-address 2))))))) + (and (coverage-data? data) + (= (object-address 3) (pointer-address result)) + (= (procedure-execution-count data proc) 1))) + (throw 'unresolved)))) (pass-if "called from eval" (let-values (((data result) diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 049c9a2b0..253c32ac5 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -222,4 +222,5 @@ (throw 'unresolved))))) (delete-file (test-file)) -(delete-file (test-symlink)) +(when (file-exists? (test-symlink)) + (delete-file (test-symlink))) diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 9d615ce16..74cdc1b4f 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -224,9 +224,13 @@ (define qsort ;; Bindings for libc's `qsort' function. - (pointer->procedure void - (dynamic-func "qsort" (dynamic-link)) - (list '* size_t size_t '*))) + ;; On some platforms, such as MinGW, `qsort' is visible only if + ;; linking with `-export-dynamic'. Just skip these tests when it's + ;; not visible. + (false-if-exception + (pointer->procedure void + (dynamic-func "qsort" (dynamic-link)) + (list '* size_t size_t '*)))) (define (dereference-pointer-to-byte ptr) (let ((b (pointer->bytevector ptr 1))) @@ -236,7 +240,7 @@ '(7 1 127 3 5 4 77 2 9 0)) (pass-if "qsort" - (if (defined? 'procedure->pointer) + (if (and qsort (defined? 'procedure->pointer)) (let* ((called? #f) (cmp (lambda (x y) (set! called? #t) @@ -254,7 +258,7 @@ (pass-if-exception "qsort, wrong return type" exception:wrong-type-arg - (if (defined? 'procedure->pointer) + (if (and qsort (defined? 'procedure->pointer)) (let* ((cmp (lambda (x y) #f)) ; wrong return type (ptr (procedure->pointer int cmp (list '* '*))) (bv (u8-list->bytevector input))) @@ -266,7 +270,7 @@ (pass-if-exception "qsort, wrong arity" exception:wrong-num-args - (if (defined? 'procedure->pointer) + (if (and qsort (defined? 'procedure->pointer)) (let* ((cmp (lambda (x y z) #f)) ; wrong arity (ptr (procedure->pointer int cmp (list '* '*))) (bv (u8-list->bytevector input))) diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index eca4536a9..5e95ab9b6 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -33,7 +33,10 @@ (not (not (object-documentation object)))) (define fixnum-bit - (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1))) + (do ((i 0 (+ 1 i)) + (n 1 (* 2 n))) + ((> n most-positive-fixnum) + (+ 1 i)))) (define fixnum-min most-negative-fixnum) (define fixnum-max most-positive-fixnum) @@ -2034,7 +2037,28 @@ (pass-if (not (= (ash-flo 1.0 58) (1- (ash 1 58))))) (pass-if (= (ash 1 58) (ash-flo 1.0 58))) (pass-if (not (= (1+ (ash 1 58)) (ash-flo 1.0 58)))) - (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58))))) + (pass-if (not (= (1- (ash 1 58)) (ash-flo 1.0 58)))) + + ;; prior to guile 2.0.10, inum/complex comparisons were done just by + ;; converting the inum to a double, which on a 64-bit would round making + ;; say inexact 2^58 appear equal to exact 2^58+1 + (pass-if (= (+ +0.0i (ash-flo 1.0 58)) (ash 1 58))) + (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1+ (ash 1 58))))) + (pass-if (not (= (+ +0.0i (ash-flo 1.0 58)) (1- (ash 1 58))))) + (pass-if (= (ash 1 58) (+ +0.0i (ash-flo 1.0 58)))) + (pass-if (not (= (1+ (ash 1 58)) (+ +0.0i (ash-flo 1.0 58))))) + (pass-if (not (= (1- (ash 1 58)) (+ +0.0i (ash-flo 1.0 58))))) + + ;; prior to guile 2.0.10, fraction/flonum and fraction/complex + ;; comparisons mishandled infinities. + (pass-if (not (= 1/2 +inf.0))) + (pass-if (not (= 1/2 -inf.0))) + (pass-if (not (= +inf.0 1/2))) + (pass-if (not (= -inf.0 1/2))) + (pass-if (not (= 1/2 +inf.0+0.0i))) + (pass-if (not (= 1/2 -inf.0+0.0i))) + (pass-if (not (= +inf.0+0.0i 1/2))) + (pass-if (not (= -inf.0+0.0i 1/2)))) ;;; ;;; < @@ -2085,6 +2109,9 @@ (pass-if "n = 0.0" (not (< 0.0 0.0))) + (pass-if "n = -0.0" + (not (< 0.0 -0.0))) + (pass-if "n = 1" (< 0.0 1)) @@ -2108,6 +2135,9 @@ (pass-if "n = fixnum-min - 1" (not (< 0.0 (- fixnum-min 1))))) + + (pass-if (not (< -0.0 0.0))) + (pass-if (not (< -0.0 -0.0))) (with-test-prefix "(< 1 n)" @@ -2433,6 +2463,42 @@ (pass-if (eq? #f (< x (* -4/3 x)))) (pass-if (eq? #f (< (- x) (* -4/3 x)))))) + (with-test-prefix "inum/flonum" + (pass-if (< 4 4.5)) + (pass-if (< 4.5 5)) + (pass-if (< -5 -4.5)) + (pass-if (< -4.5 4)) + (pass-if (not (< 4.5 4))) + (pass-if (not (< 5 4.5))) + (pass-if (not (< -4.5 -5))) + (pass-if (not (< 4 -4.5))) + + (pass-if (< 4 +inf.0)) + (pass-if (< -4 +inf.0)) + (pass-if (< -inf.0 4)) + (pass-if (< -inf.0 -4)) + (pass-if (not (< +inf.0 4))) + (pass-if (not (< +inf.0 -4))) + (pass-if (not (< 4 -inf.0))) + (pass-if (not (< -4 -inf.0))) + + (pass-if (not (< +nan.0 4))) + (pass-if (not (< +nan.0 -4))) + (pass-if (not (< 4 +nan.0))) + (pass-if (not (< -4 +nan.0))) + + (pass-if (< most-positive-fixnum (expt 2.0 fixnum-bit))) + (pass-if (not (< (expt 2.0 fixnum-bit) most-positive-fixnum))) + + (pass-if (< (- (expt 2.0 fixnum-bit)) most-negative-fixnum)) + (pass-if (not (< most-negative-fixnum (- (expt 2.0 fixnum-bit))))) + + ;; Prior to guile 2.0.10, we would unconditionally convert the inum + ;; to a double, which on a 64-bit system could result in a + ;; significant change in its value, thus corrupting the comparison. + (pass-if (< most-positive-fixnum (exact->inexact most-positive-fixnum))) + (pass-if (< (exact->inexact (- most-positive-fixnum)) (- most-positive-fixnum)))) + (with-test-prefix "flonum/frac" (pass-if (< 0.75 4/3)) (pass-if (< -0.75 4/3)) @@ -4021,6 +4087,19 @@ (let ((big (ash 1 4096))) (= 1.0 (exact->inexact (/ (1+ big) big))))) + ;; In guile 2.0.9, 'exact->inexact' guaranteed proper rounding when + ;; applied to non-negative fractions, but on 64-bit systems would + ;; sometimes double-round when applied to negative fractions, + ;; specifically when the numerator was a fixnum not exactly + ;; representable as a double. + (with-test-prefix "frac inum/inum, numerator not exactly representable as a double" + (let ((n (+ 1 (expt 2 dbl-mant-dig)))) + (for-each (lambda (d) + (test (/ n d) + (/ n d) + (exact->inexact (/ n d)))) + '(3 5 6 7 9 11 13 17 19 23 0.0 -0.0 +nan.0 +inf.0 -inf.0)))) + (test "round up to odd" ;; ===================================================== ;; 11111111111111111111111111111111111111111111111111000101 -> diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index 16a45336a..047417b4c 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -34,25 +34,6 @@ ;'(keyword-argument-error . ".*") '(#t . ".*")) -(define-syntax c&e - (syntax-rules (pass-if pass-if-exception) - ((_ (pass-if test-name exp)) - (begin (pass-if (string-append test-name " (eval)") - (primitive-eval 'exp)) - (pass-if (string-append test-name " (compile)") - (compile 'exp #:to 'value #:env (current-module))))) - ((_ (pass-if-exception test-name exc exp)) - (begin (pass-if-exception (string-append test-name " (eval)") - exc (primitive-eval 'exp)) - (pass-if-exception (string-append test-name " (compile)") - exc (compile 'exp #:to 'value - #:env (current-module))))))) - -(define-syntax with-test-prefix/c&e - (syntax-rules () - ((_ section-name exp ...) - (with-test-prefix section-name (c&e exp) ...)))) - (with-test-prefix/c&e "optional argument processing" (pass-if "local defines work with optional arguments" (eval '(begin @@ -165,10 +146,21 @@ (let ((f (lambda* (#:key x) x))) (f 1 2 #:x 'x))) - (pass-if-exception "unrecognized keyword" - exception:unrecognized-keyword - (let ((f (lambda* (#:key x) x))) - (f #:y 'not-recognized))) + (pass-if-equal "unrecognized keyword" '(#:y) + (catch 'keyword-argument-error + (lambda () + (let ((f (lambda* (#:key x) x))) + (f #:y 'not-recognized))) + (lambda (key proc fmt args data) + data))) + + (pass-if-equal "invalid keyword" '(not-a-keyword) + (catch 'keyword-argument-error + (lambda () + (let ((f (lambda* (#:key x) x))) + (f 'not-a-keyword 'something))) + (lambda (key proc fmt args data) + data))) (pass-if "rest given before keywords" ;; Passing the rest argument before the keyword arguments should not @@ -177,6 +169,22 @@ (equal? (f 1 2 3 #:x 'x #:z 'z) '(x #f z (1 2 3 #:x x #:z z)))))) +(with-test-prefix "scm_c_bind_keyword_arguments" + + (pass-if-equal "unrecognized keyword" '(#:y) + (catch 'keyword-argument-error + (lambda () + (open-file "/dev/null" "r" #:y 'not-recognized)) + (lambda (key proc fmt args data) + data))) + + (pass-if-equal "invalid keyword" '(not-a-keyword) + (catch 'keyword-argument-error + (lambda () + (open-file "/dev/null" "r" 'not-a-keyword 'something)) + (lambda (key proc fmt args data) + data)))) + (with-test-prefix/c&e "lambda* inits" (pass-if "can bind lexicals within inits" (begin diff --git a/test-suite/tests/r6rs-arithmetic-bitwise.test b/test-suite/tests/r6rs-arithmetic-bitwise.test index a61fef8c4..c864f3b68 100644 --- a/test-suite/tests/r6rs-arithmetic-bitwise.test +++ b/test-suite/tests/r6rs-arithmetic-bitwise.test @@ -43,7 +43,9 @@ (with-test-prefix "bitwise-bit-count" (pass-if "bitwise-bit-count simple" - (eqv? (bitwise-bit-count #b101) 2))) + (eqv? (bitwise-bit-count #b101) 2)) + (pass-if "bitwise-bit-count negative" + (eqv? (bitwise-bit-count #b-101) -2))) (with-test-prefix "bitwise-length" (pass-if "bitwise-length simple" diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 3f6e7e3ab..3d14d9d46 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -259,5 +259,5 @@ (with-test-prefix "encode" (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))) - (pass-if (equal? "foo%0a%00bar" (uri-encode "foo\n\x00bar"))) - (pass-if (equal? "%3c%3e%5c%5e" (uri-encode "<>\\^")))) + (pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar"))) + (pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^")))) |