Changeset 37075 in project
- Timestamp:
- 01/19/19 05:30:25 (4 weeks ago)
- Location:
- release/4/uri-generic/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/uri-generic/trunk/tests/run.scm
r36547 r37075 13 13 ("http://ex/x/y/z" "http://ex/x/r" "../r") 14 14 15 ("http://ex/x/y" "http://ex/x/q/r" " ./q/r")16 ("http://ex/x/y" "http://ex/x/q/r#s" " ./q/r#s")17 ("http://ex/x/y" "http://ex/x/q/r#s/t" " ./q/r#s/t")15 ("http://ex/x/y" "http://ex/x/q/r" "q/r") 16 ("http://ex/x/y" "http://ex/x/q/r#s" "q/r#s") 17 ("http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t") 18 18 ("http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r") 19 ("http://ex/x/y" "http://ex/x/y" " ")20 ("http://ex/x/y/" "http://ex/x/y/" " ")21 ("http://ex/x/y/pdq" "http://ex/x/y/pdq" " ")22 ("http://ex/x/y/" "http://ex/x/y/z/" " ./z/")23 ("file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" " #Animal")19 ("http://ex/x/y" "http://ex/x/y" "y") 20 ("http://ex/x/y/" "http://ex/x/y/" ".") 21 ("http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq") 22 ("http://ex/x/y/" "http://ex/x/y/z/" "z/") 23 ("file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal") 24 24 ("file:/e/x/y/z" "file:/e/x/abc" "../abc") 25 ("file:/example2/x/y/z" "file:/example/x/abc" " /example/x/abc")25 ("file:/example2/x/y/z" "file:/example/x/abc" "../../../example/x/abc") 26 26 ("file:/ex/x/y/z" "file:/ex/x/r" "../r") 27 ("file:/ex/x/y/z" "file:/r" " /r")28 ("file:/ex/x/y" "file:/ex/x/q/r" " ./q/r")29 ("file:/ex/x/y" "file:/ex/x/q/r#s" " ./q/r#s")30 ("file:/ex/x/y" "file:/ex/x/q/r#" " ./q/r#")31 ("file:/ex/x/y" "file:/ex/x/q/r#s/t" " ./q/r#s/t")27 ("file:/ex/x/y/z" "file:/r" "../../../r") 28 ("file:/ex/x/y" "file:/ex/x/q/r" "q/r") 29 ("file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s") 30 ("file:/ex/x/y" "file:/ex/x/q/r#" "q/r#") 31 ("file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t") 32 32 ("file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r") 33 ("file:/ex/x/y" "file:/ex/x/y" " ")34 ("file:/ex/x/y/" "file:/ex/x/y/" " ")35 ("file:/ex/x/y/pdq" "file:/ex/x/y/pdq" " ")36 ("file:/ex/x/y/" "file:/ex/x/y/z/" " ./z/")33 ("file:/ex/x/y" "file:/ex/x/y" "y") 34 ("file:/ex/x/y/" "file:/ex/x/y/" ".") 35 ("file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq") 36 ("file:/ex/x/y/" "file:/ex/x/y/z/" "z/") 37 37 ("file:/devel/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" 38 38 "//meetings.example.com/cal#m1") 39 39 ("file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" 40 40 "//meetings.example.com/cal#m1") 41 ("file:/some/dir/foo" "file:/some/dir/#blort" ". /#blort")42 ("file:/some/dir/foo" "file:/some/dir/#" ". /#")41 ("file:/some/dir/foo" "file:/some/dir/#blort" ".#blort") 42 ("file:/some/dir/foo" "file:/some/dir/#" ".#") 43 43 ;; From Graham Klyne Thu 20 Feb 2003 18:08:17 +0000 44 ("http://example/x/y%2Fz" "http://example/x/abc" " ./abc")45 ("http://example/x/y/z" "http://example/x%2Fabc" " /x%2Fabc")46 ("http://example/x/y%2Fz" "http://example/x%2Fabc" " /x%2Fabc")47 ("http://example/x%2Fy/z" "http://example/x%2Fy/abc" " ./abc")44 ("http://example/x/y%2Fz" "http://example/x/abc" "abc") 45 ("http://example/x/y/z" "http://example/x%2Fabc" "../../x%2Fabc") 46 ("http://example/x/y%2Fz" "http://example/x%2Fabc" "../x%2Fabc") 47 ("http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc") 48 48 ;; Ryan Lee 49 ("http://example/x/abc.efg" "http://example/x/" ". /")49 ("http://example/x/abc.efg" "http://example/x/" ".") 50 50 )) 51 51 … … 147 147 148 148 (define reverse-extra-cases 149 `((,base ,base " ")150 (,base "http://a/b/c/e" " ./e")151 (,base "http://a/b/c/" ". /") ;; Not sure if the trailing slash belongs here149 `((,base ,base "d;p") 150 (,base "http://a/b/c/e" "e") 151 (,base "http://a/b/c/" ".") 152 152 (,base "http://a/b/e" "../e") 153 153 (,base "http://a/b/c" "../c") ;; Slightly weird: dir in base, file in target 154 (,base "http://a/b/" ".. /")155 (,base "http://a/" " /") ;; or "../../"154 (,base "http://a/b/" "..") 155 (,base "http://a/" "../..") ;; or "/", but that's not convenient 156 156 (,base "http://a" "//a") ; No relative representation possible 157 157 (,base "http://b" "//b") … … 159 159 (,base "http://b/c" "//b/c") 160 160 (,base "ftp://a/b/c/d;p?q" "ftp://a/b/c/d;p?q") 161 (,base "ftp://x/y/z;a?b" "ftp://x/y/z;a?b"))) 161 (,base "ftp://x/y/z;a?b" "ftp://x/y/z;a?b") 162 ;; Found by Jim Ursetto. This would become "", which is not 163 ;; right when both are directories (see second case) 164 ("/foo/bar" "/foo/bar" "bar") 165 ("/foo/bar/" "/foo/bar/" "."))) 162 166 163 167 (test-group "uri test" -
release/4/uri-generic/trunk/uri-generic.scm
r36558 r37075 1188 1188 1189 1189 (define (uri-relative-from uabs base) 1190 (cond ((ucdiff? uri-scheme uabs base) 1190 (cond ((ucdiff? uri-scheme uabs base) (update-URI uabs)) 1191 1191 ((ucdiff? uri-authority uabs base) (update-URI uabs 'scheme #f)) 1192 1192 ;; Special case: no relative representation for http://a/ -> http://a … … 1207 1207 'path (list))) 1208 1208 (else 1209 1209 (update-URI uabs 1210 1210 'scheme #f 1211 1211 'authority #f 1212 1212 'query #f 1213 'path (list))))) 1213 'path (match (uri-path uabs) 1214 (("") (list "")) 1215 ((p ... "") (list ".")) 1216 ((p ... last) (list last))))))) 1214 1217 1215 1218 (define (ucdiff? sel u1 u2) … … 1226 1229 ((pabs ()) pabs) 1227 1230 ((() base) (list)) 1228 ;; Construct a relative path segment if the paths share a 1229 ;; leading segment other than a leading '/' 1230 ((('/ . (and sa1 (ra1 . ra2))) ('/ . (and sb1 (rb1 . rb2)))) 1231 (make-rel-path 1232 (if (string=? ra1 rb1) 1233 (rel-path-from1 sa1 sb1) 1234 pabs))) 1231 ;; Construct a relative path segment 1232 ((('/ . sa1) ('/ . sb1)) 1233 (rel-path-from1 sa1 sb1)) 1235 1234 (else (uri-error 'rel-path-from "Both URI paths must be absolute" pabs base)))) 1236 1237 (define (make-rel-path x)1238 (match x1239 ((or ('/ . rst) ("." . rst) (".." . rst)) x)1240 (else (cons "." x))))1241 1235 1242 1236 ;; rel-path-from1 strips off trailing names from the supplied paths, … … 1245 1239 (match-let* (((na . sa) (reverse pabs)) 1246 1240 ((nb . sb) (reverse base))) 1247 (let ((rp (rel-segs-from (reverse sa) (reverse sb)))) 1248 (if (null? rp) (cond ((string=? na nb) (list)) 1249 (else (list na))) 1250 (append rp (list na)))))) 1241 (let ((rp (rel-segs-from (reverse sa) (reverse sb)))) 1242 (match rp 1243 (() (cond ((string=? na nb) (list)) 1244 ((string=? na "") (list ".")) 1245 (else (list na)))) 1246 ((rp1 ... (or ".." ".")) 1247 (if (string=? na "") rp (append rp (list na)))) 1248 (else (append rp (list na)) ))))) 1251 1249 1252 1250 -
release/4/uri-generic/trunk/uri-generic.setup
r36559 r37075 1 1 ;; -*- Scheme -*- 2 2 3 (standard-extension 'uri-generic "2.4 5")3 (standard-extension 'uri-generic "2.46")
Note: See TracChangeset
for help on using the changeset viewer.