1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00

Make URI handling locale independent.

Fixes <https://bugs.gnu.org/35785>.

* module/web/uri.scm (digits, hex-digits, letters): New variables.
(ipv4-regexp, ipv6-regexp, domain-label-regexp, top-label-regexp,
userinfo-pat, host-pat, ipv6-host-pat, port-pat, scheme-pat): Explicitly
list each character instead of using character ranges.
* test-suite/tests/web-uri.test: Add corresponding tests.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Timothy Sample 2019-06-02 14:41:20 -04:00 committed by Ludovic Courtès
parent 36ad1d24b3
commit 420c2632bb
2 changed files with 51 additions and 13 deletions

View file

@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010-2012, 2014, 2017 Free Software Foundation, Inc.
;;;; Copyright (C) 2010-2012, 2014, 2017, 2019 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
@ -121,7 +121,21 @@
(pass-if-uri-exception "http://foo@"
"Expected.*host"
(build-uri 'http #:userinfo "foo")))
(build-uri 'http #:userinfo "foo"))
;; In this test, we need to reload the '(web uri)' module with a
;; different locale. This is because some locale-dependent things
;; (e.g., compiled regexes) are computed when the module is loaded.
(pass-if-uri-exception "http://illégal.com"
"Expected.*host"
(dynamic-wind
(lambda () #t)
(lambda ()
(with-locale "en_US.utf8"
(reload-module (resolve-module '(web uri)))
(build-uri 'http #:host "illégal.com")))
(lambda ()
(reload-module (resolve-module '(web uri)))))))
(with-test-prefix "build-uri-reference"
(pass-if "//host/etc/foo"
@ -290,7 +304,20 @@
#:port 100
#:path "/"
#:query "q"
#:fragment "bar")))
#:fragment "bar"))
;; This test reproduces bug #35785. See the 'illégal' test above for
;; why we reload the module.
(pass-if "http://www.example.com (sv_SE)"
(dynamic-wind
(lambda () #t)
(lambda ()
(with-locale "sv_SE.utf8"
(reload-module (resolve-module '(web uri)))
(uri=? (string->uri "http://www.example.com")
#:scheme 'http #:host "www.example.com" #:path "")))
(lambda ()
(reload-module (resolve-module '(web uri)))))))
(with-test-prefix "string->uri-reference"
(pass-if "/foo"