From 655af0da6688182c7598c4ee85f81265a213062c Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 11 Oct 2021 11:07:31 -0700 Subject: path-equal: propagate fixes from rel-path. * stdlib/copy-file.tl (path-equal): This function is based on rel-path and so suffers the same bugs. Retarget it to use the new functions and approach to volumes from rel-path, so it benefits from the fixes. --- stdlib/copy-file.tl | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/stdlib/copy-file.tl b/stdlib/copy-file.tl index 4e509538..5c87b10f 100644 --- a/stdlib/copy-file.tl +++ b/stdlib/copy-file.tl @@ -282,15 +282,13 @@ [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))))) + (if (and (stringp left) (equal left right)) + t + (let* ((lspl (path-split left)) + (rspl (path-split right)) + (lvol (path-volume lspl)) + (rvol (path-volume rspl))) + (if (nequal lvol rvol) + nil + (equal (path-simplify lspl) + (path-simplify rspl)))))) -- cgit v1.2.3