Attachment "latest3.diff" to
ticket [639036ffff]
added by
davidw
2002-11-16 02:59:25.
? latest.diff
? latest2.diff
? latest3.diff
Index: uri.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.tcl,v
retrieving revision 1.15
diff -u -r1.15 uri.tcl
--- uri.tcl 26 Feb 2002 04:59:44 -0000 1.15
+++ uri.tcl 15 Nov 2002 19:56:38 -0000
@@ -552,20 +574,21 @@
https -
ftp -
file {
- if {[string match /* $url]} {
- array set relparts [split "$baseparts(scheme)://$url"]
- array set baseparts [list path $relparts(path)]
- catch {array set baseparts [list query $relparts(query)]}
- return [eval join [array get baseparts]]
- } elseif {[string match */ $baseparts(path)]} {
- return ${base}$url
+ array set relparts [split $url]
+ if { [string match /* $url] } {
+ catch { set baseparts(path) $relparts(path) }
+ } elseif { [string match */ $baseparts(path)] } {
+ set baseparts(path) "$baseparts(path)$relparts(path)"
} else {
- set path [lreplace [::split $baseparts(path) /] end end]
- array set baseparts [list path [::join $path /]/$url]
- return [eval join [array get baseparts]]
+ if { [string length $relparts(path)] > 0 } {
+ set path [lreplace [::split $baseparts(path) /] end end]
+ set baseparts(path) "[::join $path /]/$relparts(path)"
+ }
}
+ catch { set baseparts(query) $relparts(query) }
+ catch { set baseparts(fragment) $relparts(fragment) }
+ return [eval join [array get baseparts]]
}
-
default {
return -code error "unable to resolve relative URL \"$url\""
}
Index: uri.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/uri/uri.test,v
retrieving revision 1.11
diff -u -r1.11 uri.test
--- uri.test 5 Jun 2002 22:59:07 -0000 1.11
+++ uri.test 15 Nov 2002 19:56:38 -0000
@@ -149,6 +166,24 @@
uri::resolve http://www.w3.org/path/ http://test.net/test.html
} http://test.net/test.html
+test uri-3.7 {uri::resolve - two queries - one sans path} {
+ uri::resolve http://www.example.com/foo/bar.rvt?foo=bar ?shoo=bee
+} http://www.example.com/foo/bar.rvt?shoo=bee
+
+test uri-3.8 {uri::resolve - two queries} {
+ uri::resolve http://www.example.com/baz/?foo=bar ?shoo=bee
+} http://www.example.com/baz/?shoo=bee
+
+test uri-3.9 {uri::resolve - two absolute URL's with queries} {
+ uri::resolve http://www.example.com/?foo=bar http://www.example.com/?shoo=bee
+} http://www.example.com/?shoo=bee
+
+test uri-3.10 {uri::resolve - two queries,
+ one absolute URL, one absolute path} {
+ uri::resolve http://www.example.com/baz?foo=bar /baz?shoo=bee
+} http://www.example.com/baz?shoo=bee
+
+
# -------------------------------------------------------------------------
# NB: This test fails on windows as there is an extra character for each
