diff options
-rw-r--r-- | libguile/deprecation.c | 4 | ||||
-rw-r--r-- | libguile/gc-malloc.c | 3 | ||||
-rw-r--r-- | libguile/load.c | 20 | ||||
-rw-r--r-- | libguile/numbers.c | 8 | ||||
-rw-r--r-- | libguile/poll.c | 1 | ||||
-rw-r--r-- | libguile/ports.c | 24 | ||||
-rw-r--r-- | libguile/ports.h | 2 | ||||
-rw-r--r-- | libguile/print.c | 23 | ||||
-rw-r--r-- | libguile/private-options.h | 5 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 82 | ||||
-rw-r--r-- | module/ice-9/poll.scm | 3 | ||||
-rw-r--r-- | module/system/base/message.scm | 12 | ||||
-rw-r--r-- | module/system/repl/command.scm | 1 | ||||
-rw-r--r-- | module/system/repl/repl.scm | 5 | ||||
-rw-r--r-- | module/web/client.scm | 2 | ||||
-rw-r--r-- | module/web/uri.scm | 20 | ||||
-rw-r--r-- | test-suite/Makefile.am | 1 | ||||
-rw-r--r-- | test-suite/tests/parameters.test | 69 | ||||
-rw-r--r-- | test-suite/tests/web-uri.test | 19 |
19 files changed, 254 insertions, 50 deletions
diff --git a/libguile/deprecation.c b/libguile/deprecation.c index 1622406a8..5c1a246c2 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -89,8 +89,8 @@ scm_c_issue_deprecation_warning (const char *msg) fprintf (stderr, "%s\n", msg); else { - scm_puts_unlocked (msg, scm_current_error_port ()); - scm_newline (scm_current_error_port ()); + scm_puts_unlocked (msg, scm_current_warning_port ()); + scm_newline (scm_current_warning_port ()); } } } diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 3b64159cb..39e82ef1e 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -153,7 +153,8 @@ scm_strdup (const char *str) void scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) { - /* Nothing to do. */ + scm_gc_register_allocation (size); + #ifdef GUILE_DEBUG_MALLOC if (mem) scm_malloc_register (mem, what); diff --git a/libguile/load.c b/libguile/load.c index 14f411aa7..b28e30b2a 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -738,18 +738,18 @@ auto_compile_catch_handler (void *data, SCM tag, SCM throw_args) oport = scm_open_output_string (); scm_print_exception (oport, SCM_BOOL_F, tag, throw_args); - scm_puts_unlocked (";;; WARNING: compilation of ", scm_current_error_port ()); - scm_display (source, scm_current_error_port ()); - scm_puts_unlocked (" failed:\n", scm_current_error_port ()); + scm_puts_unlocked (";;; WARNING: compilation of ", scm_current_warning_port ()); + scm_display (source, scm_current_warning_port ()); + scm_puts_unlocked (" failed:\n", scm_current_warning_port ()); lines = scm_string_split (scm_get_output_string (oport), SCM_MAKE_CHAR ('\n')); for (; scm_is_pair (lines); lines = scm_cdr (lines)) if (scm_c_string_length (scm_car (lines))) { - scm_puts_unlocked (";;; ", scm_current_error_port ()); - scm_display (scm_car (lines), scm_current_error_port ()); - scm_newline (scm_current_error_port ()); + scm_puts_unlocked (";;; ", scm_current_warning_port ()); + scm_display (scm_car (lines), scm_current_warning_port ()); + scm_newline (scm_current_warning_port ()); } scm_close_port (oport); @@ -767,7 +767,7 @@ SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabl { scm_puts_unlocked (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n" ";;; or pass the --no-auto-compile argument to disable.\n", - scm_current_error_port ()); + scm_current_warning_port ()); message_shown = 1; } @@ -933,9 +933,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, if (stat_ret == 0 && compiled_is_fresh (full_filename, fallback, &stat_source, &stat_compiled)) { - scm_puts_unlocked (";;; found fresh local cache at ", scm_current_error_port ()); - scm_display (fallback, scm_current_error_port ()); - scm_newline (scm_current_error_port ()); + scm_puts_unlocked (";;; found fresh local cache at ", scm_current_warning_port ()); + scm_display (fallback, scm_current_warning_port ()); + scm_newline (scm_current_warning_port ()); return scm_load_compiled_with_vm (fallback); } } diff --git a/libguile/numbers.c b/libguile/numbers.c index f15c724de..46a195a98 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -5321,8 +5321,14 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0, else if (SCM_BIGP (n)) { char *str = mpz_get_str (NULL, base, SCM_I_BIG_MPZ (n)); + size_t len = strlen (str); + void (*freefunc) (void *, size_t); + SCM ret; + mp_get_memory_functions (NULL, NULL, &freefunc); scm_remember_upto_here_1 (n); - return scm_take_locale_string (str); + ret = scm_from_latin1_stringn (str, len); + freefunc (str, len + 1); + return ret; } else if (SCM_FRACTIONP (n)) { diff --git a/libguile/poll.c b/libguile/poll.c index d61d51979..1bb75727b 100644 --- a/libguile/poll.c +++ b/libguile/poll.c @@ -184,6 +184,7 @@ scm_init_poll (void) { #if HAVE_POLL scm_c_define_gsubr ("primitive-poll", 4, 0, 0, scm_primitive_poll); + scm_c_define ("%sizeof-struct-pollfd", scm_from_size_t (sizeof (struct pollfd))); #else scm_misc_error ("%init-poll", "`poll' unavailable on this platform", SCM_EOL); #endif diff --git a/libguile/ports.c b/libguile/ports.c index bee2c8687..9eb6d3b9c 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -328,6 +328,17 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0, } #undef FUNC_NAME +SCM +scm_current_warning_port (void) +{ + static SCM cwp_var = SCM_BOOL_F; + + if (scm_is_false (cwp_var)) + cwp_var = scm_c_private_lookup ("guile", "current-warning-port"); + + return scm_call_0 (scm_variable_ref (cwp_var)); +} + SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0, (), "Return the current-load-port.\n" @@ -382,6 +393,19 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, } #undef FUNC_NAME + +SCM +scm_set_current_warning_port (SCM port) +{ + static SCM cwp_var = SCM_BOOL_F; + + if (scm_is_false (cwp_var)) + cwp_var = scm_c_private_lookup ("guile", "current-warning-port"); + + return scm_call_1 (scm_variable_ref (cwp_var), port); +} + + void scm_dynwind_current_input_port (SCM port) #define FUNC_NAME NULL diff --git a/libguile/ports.h b/libguile/ports.h index 8c578a6df..f4a1908e0 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -241,10 +241,12 @@ SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SC SCM_API SCM scm_current_input_port (void); SCM_API SCM scm_current_output_port (void); SCM_API SCM scm_current_error_port (void); +SCM_API SCM scm_current_warning_port (void); SCM_API SCM scm_current_load_port (void); SCM_API SCM scm_set_current_input_port (SCM port); SCM_API SCM scm_set_current_output_port (SCM port); SCM_API SCM scm_set_current_error_port (SCM port); +SCM_API SCM scm_set_current_warning_port (SCM port); SCM_API void scm_dynwind_current_input_port (SCM port); SCM_API void scm_dynwind_current_output_port (SCM port); SCM_API void scm_dynwind_current_error_port (SCM port); diff --git a/libguile/print.c b/libguile/print.c index cdb923793..d8dd24c06 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -106,8 +106,9 @@ scm_t_option scm_print_opts[] = { { SCM_OPTION_SCM, "quote-keywordish-symbols", (scm_t_bits)SCM_BOOL_F_BITS, "How to print symbols that have a colon as their first or last character. " "The value '#f' does not quote the colons; '#t' quotes them; " - "'reader' quotes them when the reader option 'keywords' is not '#f'." - }, + "'reader' quotes them when the reader option 'keywords' is not '#f'." }, + { SCM_OPTION_BOOLEAN, "escape-newlines", 1, + "Render newlines as \\n when printing using `write'." }, { 0 }, }; @@ -1104,6 +1105,12 @@ write_character (scm_t_wchar ch, SCM port, int string_escapes_p) display_character (ch, port, strategy); printed = 1; } + else if (ch == '\n' && SCM_PRINT_ESCAPE_NEWLINES_P) + { + display_character ('\\', port, iconveh_question_mark); + display_character ('n', port, strategy); + printed = 1; + } else if (ch == ' ' || ch == '\n') { display_character (ch, port, strategy); @@ -1522,13 +1529,6 @@ scm_init_print () { SCM type; - scm_init_opts (scm_print_options, scm_print_opts); - - scm_print_options (scm_list_4 (scm_from_latin1_symbol ("highlight-prefix"), - scm_from_locale_string ("{"), - scm_from_latin1_symbol ("highlight-suffix"), - scm_from_locale_string ("}"))); - type = scm_make_vtable (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT), SCM_BOOL_F); scm_set_struct_vtable_name_x (type, scm_from_latin1_symbol ("print-state")); @@ -1540,6 +1540,11 @@ scm_init_print () #include "libguile/print.x" + scm_init_opts (scm_print_options, scm_print_opts); + scm_print_opts[SCM_PRINT_HIGHLIGHT_PREFIX_I].val = + SCM_UNPACK (scm_from_locale_string ("{")); + scm_print_opts[SCM_PRINT_HIGHLIGHT_SUFFIX_I].val = + SCM_UNPACK (scm_from_locale_string ("}")); scm_print_opts[SCM_PRINT_KEYWORD_STYLE_I].val = SCM_UNPACK (sym_reader); } diff --git a/libguile/private-options.h b/libguile/private-options.h index c095688c3..9d2d43cf5 100644 --- a/libguile/private-options.h +++ b/libguile/private-options.h @@ -45,11 +45,14 @@ SCM_INTERNAL scm_t_option scm_debug_opts[]; */ SCM_INTERNAL scm_t_option scm_print_opts[]; +#define SCM_PRINT_HIGHLIGHT_PREFIX_I 0 #define SCM_PRINT_HIGHLIGHT_PREFIX (SCM_PACK (scm_print_opts[0].val)) +#define SCM_PRINT_HIGHLIGHT_SUFFIX_I 1 #define SCM_PRINT_HIGHLIGHT_SUFFIX (SCM_PACK (scm_print_opts[1].val)) #define SCM_PRINT_KEYWORD_STYLE_I 2 #define SCM_PRINT_KEYWORD_STYLE (SCM_PACK (scm_print_opts[2].val)) -#define SCM_N_PRINT_OPTIONS 3 +#define SCM_PRINT_ESCAPE_NEWLINES_P scm_print_opts[3].val +#define SCM_N_PRINT_OPTIONS 4 /* diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index cf3f5d8c0..3ae933aec 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -213,9 +213,11 @@ If there is no handler at all, Guile prints an error and then exits." (define pk peek) +;; Temporary definition; replaced later. +(define current-warning-port current-error-port) (define (warn . stuff) - (with-output-to-port (current-error-port) + (with-output-to-port (current-warning-port) (lambda () (newline) (display ";;; WARNING ") @@ -1373,7 +1375,7 @@ VALUE." (define (%load-announce file) (if %load-verbosely - (with-output-to-port (current-error-port) + (with-output-to-port (current-warning-port) (lambda () (display ";;; ") (display "loading ") @@ -2825,6 +2827,68 @@ module '(ice-9 q) '(make-q q-length))}." +;;; {Parameters} +;;; + +(define <parameter> + ;; Three fields: the procedure itself, the fluid, and the converter. + (make-struct <applicable-struct-vtable> 0 'pwprpr)) +(set-struct-vtable-name! <parameter> '<parameter>) + +(define* (make-parameter init #:optional (conv (lambda (x) x))) + (let ((fluid (make-fluid (conv init)))) + (make-struct <parameter> 0 + (case-lambda + (() (fluid-ref fluid)) + ((x) (let ((prev (fluid-ref fluid))) + (fluid-set! fluid (conv x)) + prev))) + fluid conv))) + +(define (parameter? x) + (and (struct? x) (eq? (struct-vtable x) <parameter>))) + +(define (parameter-fluid p) + (if (parameter? p) + (struct-ref p 1) + (scm-error 'wrong-type-arg "parameter-fluid" + "Not a parameter: ~S" (list p) #f))) + +(define (parameter-converter p) + (if (parameter? p) + (struct-ref p 2) + (scm-error 'wrong-type-arg "parameter-fluid" + "Not a parameter: ~S" (list p) #f))) + +(define-syntax parameterize + (lambda (x) + (syntax-case x () + ((_ ((param value) ...) body body* ...) + (with-syntax (((p ...) (generate-temporaries #'(param ...)))) + #'(let ((p param) ...) + (if (not (parameter? p)) + (scm-error 'wrong-type-arg "parameterize" + "Not a parameter: ~S" (list p) #f)) + ... + (with-fluids (((struct-ref p 1) ((struct-ref p 2) value)) + ...) + body body* ...))))))) + + +;;; +;;; Warnings. +;;; + +(define current-warning-port + (make-parameter (current-error-port) + (lambda (x) + (if (output-port? x) + x + (error "expected an output port" x))))) + + + + ;;; {Running Repls} ;;; @@ -3288,7 +3352,7 @@ module '(ice-9 q) '(make-q q-length))}." #f)) (define (warn module name int1 val1 int2 val2 var val) - (format (current-error-port) + (format (current-warning-port) "WARNING: ~A: `~A' imported from both ~A and ~A\n" (module-name module) name @@ -3310,7 +3374,7 @@ module '(ice-9 q) '(make-q q-length))}." (define (warn-override-core module name int1 val1 int2 val2 var val) (and (eq? int1 the-scm-module) (begin - (format (current-error-port) + (format (current-warning-port) "WARNING: ~A: imported module ~A overrides core binding `~A'\n" (module-name module) (module-name int2) @@ -3432,13 +3496,13 @@ module '(ice-9 q) '(make-q q-length))}." go-path (begin (if gostat - (format (current-error-port) + (format (current-warning-port) ";;; note: source file ~a\n;;; newer than compiled ~a\n" name go-path)) (cond (%load-should-auto-compile (%warn-auto-compilation-enabled) - (format (current-error-port) ";;; compiling ~a\n" name) + (format (current-warning-port) ";;; compiling ~a\n" name) (let ((cfn ((module-ref (resolve-interface '(system base compile)) @@ -3446,15 +3510,15 @@ module '(ice-9 q) '(make-q q-length))}." name #:opts %auto-compilation-options #:env (current-module)))) - (format (current-error-port) ";;; compiled ~a\n" cfn) + (format (current-warning-port) ";;; compiled ~a\n" cfn) cfn)) (else #f)))))) (lambda (k . args) - (format (current-error-port) + (format (current-warning-port) ";;; WARNING: compilation of ~a failed:\n" name) (for-each (lambda (s) (if (not (string-null? s)) - (format (current-error-port) ";;; ~a\n" s))) + (format (current-warning-port) ";;; ~a\n" s))) (string-split (call-with-output-string (lambda (port) (print-exception port #f k args))) diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm index cf61294d7..2ba868748 100644 --- a/module/ice-9/poll.scm +++ b/module/ice-9/poll.scm @@ -38,6 +38,9 @@ (load-extension (string-append "libguile-" (effective-version)) "scm_init_poll")) +(if (not (= %sizeof-struct-pollfd 8)) + (error "Unexpected struct pollfd size" %sizeof-struct-pollfd)) + (if (defined? 'POLLIN) (export POLLIN)) diff --git a/module/system/base/message.scm b/module/system/base/message.scm index aed35021c..75e14ea1e 100644 --- a/module/system/base/message.scm +++ b/module/system/base/message.scm @@ -54,11 +54,13 @@ ;;; Warnings ;;; +;; This name existed before %current-warning-port was introduced, but +;; otherwise it is a deprecated binding. (define *current-warning-port* - ;; The port where warnings are sent. - (make-fluid (current-error-port))) - -(fluid-set! *current-warning-port* (current-error-port)) + ;; Can't play the identifier-syntax deprecation game in Guile 2.0, as + ;; other modules might depend on this being a normal binding and not a + ;; syntax binding. + (parameter-fluid current-warning-port)) (define *current-warning-prefix* ;; Prefix string when emitting a warning. @@ -194,7 +196,7 @@ "Emit a warning of type TYPE for source location LOCATION (a source property alist) using the data in ARGS." (let ((wt (lookup-warning-type type)) - (port (fluid-ref *current-warning-port*))) + (port (current-warning-port))) (if (warning-type? wt) (apply (warning-type-printer wt) port (location-string location) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 3fead7cac..a709c8dd6 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -441,6 +441,7 @@ Change languages." (cur (repl-language repl))) (format #t "Happy hacking with ~a! To switch back, type `,L ~a'.\n" (language-title lang) (language-name cur)) + (fluid-set! *current-language* lang) (set! (repl-language repl) lang))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 1cffa7187..f7b022999 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -132,7 +132,10 @@ ;;; (define* (start-repl #:optional (lang (current-language)) #:key debug) - (run-repl (make-repl lang debug))) + ;; ,language at the REPL will fluid-set! the *current-language*. Make + ;; sure that it does so in a new scope. + (with-fluids ((*current-language* lang)) + (run-repl (make-repl lang debug)))) ;; (put 'abort-on-error 'scheme-indent-function 1) (define-syntax-rule (abort-on-error string exp) diff --git a/module/web/client.scm b/module/web/client.scm index 6a04497cf..b0356680d 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -27,7 +27,7 @@ ;;; the web server. ;;; ;;; Another option, good but not as performant, would be to use threads, -;;; possibly via par-map or futures. +;;; possibly via a thread pool. ;;; ;;; Code: diff --git a/module/web/uri.scm b/module/web/uri.scm index 6f9377c19..67ecbaeb2 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -125,14 +125,18 @@ consistency checks to make sure that the constructed URI is valid." userinfo-pat host-pat port-pat))) (define (parse-authority authority fail) - (let ((m (regexp-exec authority-regexp authority))) - (if (and m (valid-host? (match:substring m 3))) - (values (match:substring m 2) - (match:substring m 3) - (let ((port (match:substring m 5))) - (and port (not (string-null? port)) - (string->number port)))) - (fail)))) + (if (equal? authority "//") + ;; Allow empty authorities: file:///etc/hosts is a synonym of + ;; file:/etc/hosts. + (values #f #f #f) + (let ((m (regexp-exec authority-regexp authority))) + (if (and m (valid-host? (match:substring m 3))) + (values (match:substring m 2) + (match:substring m 3) + (let ((port (match:substring m 5))) + (and port (not (string-null? port)) + (string->number port)))) + (fail))))) ;;; RFC 3986, #3. diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 05aee7837..f825cc73c 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -74,6 +74,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/numbers.test \ tests/optargs.test \ tests/options.test \ + tests/parameters.test \ tests/print.test \ tests/procprop.test \ tests/procs.test \ diff --git a/test-suite/tests/parameters.test b/test-suite/tests/parameters.test new file mode 100644 index 000000000..9d0a092ab --- /dev/null +++ b/test-suite/tests/parameters.test @@ -0,0 +1,69 @@ +;;;; srfi-39.test --- -*- scheme -*- +;;;; +;;;; Copyright (C) 2004, 2005, 2006, 2008, 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 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 + +;; Testing the parameters implementation in boot-9. +;; +(define-module (test-parameters) + #:use-module (srfi srfi-34) + #:use-module (test-suite lib)) + +(define a (make-parameter 3)) +(define b (make-parameter 4)) + +(define (check a b a-val b-val) + (and (eqv? (a) a-val)) (eqv? (b) b-val)) + +(define c (make-parameter 2 (lambda (x) (if (< x 10) x 10)))) +(define d (make-parameter 15 (lambda (x) (if (< x 10) x 10)))) + +(with-test-prefix "parameters" + + (pass-if "test 1" + (check a b 3 4)) + + (pass-if "test 2" + (parameterize ((a 2) (b 1)) + (and (check a b 2 1) + (parameterize ((b 8)) + (check a b 2 8))))) + + (pass-if "test 3" + (check a b 3 4)) + + (pass-if "test 4" + (check c d 2 10)) + + (pass-if "test 5" + (parameterize ((a 0) (b 1) (c 98) (d 9)) + (and (check a b 0 1) + (check c d 10 9) + (parameterize ((c (a)) (d (b))) + (and (check a b 0 1) + (check c d 0 1)))))) + + (pass-if "SRFI-34" + (let ((inside? (make-parameter #f))) + (call/cc (lambda (return) + (with-exception-handler + (lambda (c) + ;; This handler should be called in the dynamic + ;; environment installed by `parameterize'. + (return (inside?))) + (lambda () + (parameterize ((inside? #t)) + (raise 'some-exception))))))))) diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 534380af7..9118eea4b 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -1,6 +1,6 @@ ;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 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 @@ -150,7 +150,22 @@ (not (string->uri "http://:10"))) (pass-if "http://foo@" - (not (string->uri "http://foo@")))) + (not (string->uri "http://foo@"))) + + (pass-if "file:/" + (uri=? (string->uri "file:/") + #:scheme 'file + #:path "/")) + + (pass-if "file:/etc/hosts" + (uri=? (string->uri "file:/etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "file:///etc/hosts" + (uri=? (string->uri "file:///etc/hosts") + #:scheme 'file + #:path "/etc/hosts"))) (with-test-prefix "uri->string" (pass-if "ftp:" |