Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 11:46:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Normalizing trailing /. in paths.

Browse source
This commit is contained in:
Alex Shinn 2014-02-10 21:44:40 +09:00
parent be778009e2
commit 5c00c4a8df
2 changed files with 20 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
lib/chibi/pathname.scm
View file

@ -153,25 +153,27 @@
(boundary i (+ j 1) res)
(inside i (+ j 1) res))))
(define (boundary i j res)
(if (>= j len-1)
(if (>= j len)
(finish i res)
(case (string-ref path j)
((#\.)
(case (string-ref path (+ j 1))
((#\.)
(if (or (>= j (- len 2)) (eqv? #\/ (string-ref path (+ j 2))))
(if (>= i (- j 1))
(if (null? res)
(backup j "" '())
(backup j (car res) (cdr res)))
(backup j (substring path i j) res))
(inside i (+ j 2) res)))
((#\/)
(if (= i j)
(boundary (+ j 2) (+ j 2) res)
(let ((s (substring path i j)))
(boundary (+ j 2) (+ j 2) (cons s res)))))
(else (inside i (+ j 1) res))))
(cond
((or (= j len-1) (eqv? #\/ (string-ref path (+ j 1))))
(if (= i j)
(boundary (+ j 2) (+ j 2) res)
(let ((s (substring path i j)))
(boundary (+ j 2) (+ j 2) (cons s res)))))
((eqv? #\. (string-ref path (+ j 1)))
(if (or (>= j (- len 2))
(eqv? #\/ (string-ref path (+ j 2))))
(if (>= i (- j 1))
(if (null? res)
(backup j "" '())
(backup j (car res) (cdr res)))
(backup j (substring path i j) res))
(inside i (+ j 2) res)))
(else
(inside i (+ j 1) res))))
((#\/) (boundary (+ j 1) (+ j 1) (collect i j res)))
(else (inside i (+ j 1) res)))))
(define (backup j s res)

2
tests/path-tests.scm
View file

@ -162,10 +162,12 @@
(test "/a/c/e" (path-normalize "/a/b//..///c//d/../e"))
(test "/a/b/c/d/e/"
(path-normalize "/a/b//./../c/d/../../b//c/d/e/f/.."))
(test "/a/b/c/" (path-normalize "/a/b/c/."))
(test "path-normalize:border" "" (path-normalize ""))
(test "." (path-normalize "."))
(test "/" (path-normalize "/"))
(test "/" (path-normalize "/."))
(test "path-normalize:overflow"
"/" (path-normalize "/a/b/c/../../../../.."))