diff options
| -rw-r--r-- | lisplib.c | 1 | ||||
| -rw-r--r-- | stdlib/copy-file.tl | 14 | ||||
| -rw-r--r-- | tests/018/path-equal.tl | 18 | ||||
| -rw-r--r-- | txr.1 | 68 |
4 files changed, 101 insertions, 0 deletions
@@ -829,6 +829,7 @@ static val copy_file_set_entries(val dlt, val fun) lit("copy-path-opts"), lit("copy-file"), lit("copy-files"), lit("copy-path-rec"), lit("remove-path-rec"), lit("chown-rec"), lit("chmod-rec"), lit("touch"), lit("rel-path"), + lit("path-equal"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/stdlib/copy-file.tl b/stdlib/copy-file.tl index fcb7f40c..c8cbe59f 100644 --- a/stdlib/copy-file.tl +++ b/stdlib/copy-file.tl @@ -246,3 +246,17 @@ (down [tcomp ncommon..:])) (cat-str (append (repeat '("..") nup) down) [path-sep-chars 0])))))) + +(defun path-equal (left right) + (cond + ((and (stringp left) (equal left right))) + ((neq (abs-path-p left) (abs-path-p right)) nil) + ((and (macro-time (find #\\ path-sep-chars)) + (if-match `@{fdrv #/[A-Za-z0-9]+:/}@nil` left + (if-match `@{tdrv #/[A-Za-z0-9]+:/}@nil` right + (nequal fdrv tdrv)))) + nil) + (t (let* ((fcomp (path-simplify (spl path-sep-chars left))) + (tcomp (path-simplify (spl path-sep-chars right))) + (ncommon (mismatch fcomp tcomp))) + (null ncommon))))) diff --git a/tests/018/path-equal.tl b/tests/018/path-equal.tl new file mode 100644 index 00000000..cf1fbb63 --- /dev/null +++ b/tests/018/path-equal.tl @@ -0,0 +1,18 @@ +(load "../common") + +(mtest + (path-equal "a" "a") t + (path-equal "a" "b") nil + (path-equal "/a" "a") nil + + (path-equal "a" "a/") t + (path-equal "a/" "a/") t + + (path-equal "a/b/../c" "a/c") t + + (path-equal "a" "a/././.") t + (path-equal "a/." "a/././.") t + + ;;(path-equal "/.." "/") t + ;;(path-equal "/../a" "/a/") t + ) @@ -58302,6 +58302,74 @@ there are no files, then read from standard input: @(end) .brev +.coNP Function @ path-equal +.synb +.mets (path-equal < left-path << right-path ) +.syne +.desc +The +.code path-equal +function determines whether the two paths +.meta left-path +and +.meta right-path +are equal under a certain definition of equivalence, whose requirements are given below. +The function returns +.code t +if the paths are equal, otherwise +.codn nil . + +If +.meta left-path +and +.meta right-path +are strings which are identical under the +.code equal +function, then they are considered equal paths. + +Otherwise, the two paths are equal if the relative path from +.meta left-path +to +.meta right-path +is +.str . +(dot), as would be determined by the +.code path-rel +function, if it were applied to +.meta left-path +and +.meta right-path +as its arguments. If +.code path-rel +would return the dot path, then the two paths are equal. If +.code path-rel +would return any other value, or throw an exception, then the paths are unequal. + +.TP* Examples: + +.verb + ;; simple case + (path-equal "a" "a") -> t + (path-equal "a" "b") -> nil + + ;; trailing slashes don't matter + (path-equal "a" "a/") -> t + (path-equal "a/" "a/") -> t + + ;; .. components resolved: + (path-equal "a/b/../c" "a/c") -> t + + ;; . components resolved: + (path-equal "a" "a/././.") -> t + (path-equal "a/." "a/././.") -> t + + ;; (On Microsoft Windows) + ;; different drive: + (path-equal "c:/a" "d:/b/../a") -> nil + ;; same drive: + (path-equal "c:/a" "c:/b/../a") -> t +.brev + .coNP Functions @ abs-path-p and @ portable-abs-path-p .synb .mets (abs-path-p << path ) |