summary refs log tree commit diff stats
path: root/tests/stdlib/tos.nim
diff options
context:
space:
mode:
Diffstat (limited to 'tests/stdlib/tos.nim')
-rw-r--r--tests/stdlib/tos.nim531
1 files changed, 505 insertions, 26 deletions
diff --git a/tests/stdlib/tos.nim b/tests/stdlib/tos.nim
index 03fc1f1e9..611659fdb 100644
--- a/tests/stdlib/tos.nim
+++ b/tests/stdlib/tos.nim
@@ -22,10 +22,13 @@ __really_obscure_dir_name/test
 Raises
 Raises
 '''
+  matrix: "--mm:refc; --mm:orc"
+  joinable: false
 """
 # test os path creation, iteration, and deletion
 
-import os, strutils, pathnorm
+from stdtest/specialpaths import buildDir
+import std/[syncio, assertions, osproc, os, strutils, pathnorm]
 
 block fileOperations:
   let files = @["these.txt", "are.x", "testing.r", "files.q"]
@@ -36,6 +39,30 @@ block fileOperations:
   createDir(dname)
   doAssert dirExists(dname)
 
+  block: # copyFile, copyFileToDir
+    doAssertRaises(OSError): copyFile(dname/"nonexistent.txt", dname/"nonexistent.txt")
+    let fname = "D20201009T112235"
+    let fname2 = "D20201009T112235.2"
+    let str = "foo1\0foo2\nfoo3\0"
+    let file = dname/fname
+    let file2 = dname/fname2
+    writeFile(file, str)
+    doAssert readFile(file) == str
+    let sub = "sub"
+    doAssertRaises(OSError): copyFile(file, dname/sub/fname2)
+    doAssertRaises(OSError): copyFileToDir(file, dname/sub)
+    doAssertRaises(ValueError): copyFileToDir(file, "")
+    copyFile(file, file2)
+    doAssert fileExists(file2)
+    doAssert readFile(file2) == str
+    createDir(dname/sub)
+    copyFileToDir(file, dname/sub)
+    doAssert fileExists(dname/sub/fname)
+    removeDir(dname/sub)
+    doAssert not dirExists(dname/sub)
+    removeFile(file)
+    removeFile(file2)
+
   # Test creating files and dirs
   for dir in dirs:
     createDir(dname/dir)
@@ -130,6 +157,172 @@ block fileOperations:
   doAssert fileExists("../dest/a/file.txt")
   removeDir("../dest")
 
+  # createDir should not fail if `dir` is empty
+  createDir("")
+
+
+  when defined(linux): # bug #24174
+    createDir("a/b")
+    open("a/file.txt", fmWrite).close
+
+    if not fileExists("a/fifoFile"):
+      doAssert execCmd("mkfifo -m 600 a/fifoFile") == 0
+
+    copyDir("a/", "../dest/a/", skipSpecial = true)
+    copyDirWithPermissions("a/", "../dest2/a/", skipSpecial = true)
+    removeDir("a")
+
+  # Symlink handling in `copyFile`, `copyFileWithPermissions`, `copyFileToDir`,
+  # `copyDir`, `copyDirWithPermissions`, `moveFile`, and `moveDir`.
+  block:
+    const symlinksAreHandled = not defined(windows)
+    const dname = buildDir/"D20210116T140629"
+    const subDir = dname/"sub"
+    const subDir2 = dname/"sub2"
+    const brokenSymlinkName = "D20210101T191320_BROKEN_SYMLINK"
+    const brokenSymlink = dname/brokenSymlinkName
+    const brokenSymlinkSrc = "D20210101T191320_nonexistent"
+    const brokenSymlinkCopy = brokenSymlink & "_COPY"
+    const brokenSymlinkInSubDir = subDir/brokenSymlinkName
+    const brokenSymlinkInSubDir2 = subDir2/brokenSymlinkName
+
+    createDir(subDir)
+    createSymlink(brokenSymlinkSrc, brokenSymlink)
+
+    # Test copyFile
+    when symlinksAreHandled:
+      doAssertRaises(OSError):
+        copyFile(brokenSymlink, brokenSymlinkCopy)
+      doAssertRaises(OSError):
+        copyFile(brokenSymlink, brokenSymlinkCopy, {cfSymlinkFollow})
+    copyFile(brokenSymlink, brokenSymlinkCopy, {cfSymlinkIgnore})
+    doAssert not fileExists(brokenSymlinkCopy)
+    copyFile(brokenSymlink, brokenSymlinkCopy, {cfSymlinkAsIs})
+    when symlinksAreHandled:
+      doAssert expandSymlink(brokenSymlinkCopy) == brokenSymlinkSrc
+      removeFile(brokenSymlinkCopy)
+    else:
+      doAssert not fileExists(brokenSymlinkCopy)
+    doAssertRaises(AssertionDefect):
+      copyFile(brokenSymlink, brokenSymlinkCopy,
+               {cfSymlinkAsIs, cfSymlinkFollow})
+
+    # Test copyFileWithPermissions
+    when symlinksAreHandled:
+      doAssertRaises(OSError):
+        copyFileWithPermissions(brokenSymlink, brokenSymlinkCopy)
+      doAssertRaises(OSError):
+        copyFileWithPermissions(brokenSymlink, brokenSymlinkCopy,
+                                options = {cfSymlinkFollow})
+    copyFileWithPermissions(brokenSymlink, brokenSymlinkCopy,
+                            options = {cfSymlinkIgnore})
+    doAssert not fileExists(brokenSymlinkCopy)
+    copyFileWithPermissions(brokenSymlink, brokenSymlinkCopy,
+                            options = {cfSymlinkAsIs})
+    when symlinksAreHandled:
+      doAssert expandSymlink(brokenSymlinkCopy) == brokenSymlinkSrc
+      removeFile(brokenSymlinkCopy)
+    else:
+      doAssert not fileExists(brokenSymlinkCopy)
+    doAssertRaises(AssertionDefect):
+      copyFileWithPermissions(brokenSymlink, brokenSymlinkCopy,
+                              options = {cfSymlinkAsIs, cfSymlinkFollow})
+
+    # Test copyFileToDir
+    when symlinksAreHandled:
+      doAssertRaises(OSError):
+        copyFileToDir(brokenSymlink, subDir)
+      doAssertRaises(OSError):
+        copyFileToDir(brokenSymlink, subDir, {cfSymlinkFollow})
+    copyFileToDir(brokenSymlink, subDir, {cfSymlinkIgnore})
+    doAssert not fileExists(brokenSymlinkInSubDir)
+    copyFileToDir(brokenSymlink, subDir, {cfSymlinkAsIs})
+    when symlinksAreHandled:
+      doAssert expandSymlink(brokenSymlinkInSubDir) == brokenSymlinkSrc
+      removeFile(brokenSymlinkInSubDir)
+    else:
+      doAssert not fileExists(brokenSymlinkInSubDir)
+
+    createSymlink(brokenSymlinkSrc, brokenSymlinkInSubDir)
+
+    # Test copyDir
+    copyDir(subDir, subDir2)
+    when symlinksAreHandled:
+      doAssert expandSymlink(brokenSymlinkInSubDir2) == brokenSymlinkSrc
+    else:
+      doAssert not fileExists(brokenSymlinkInSubDir2)
+    removeDir(subDir2)
+
+    # Test copyDirWithPermissions
+    copyDirWithPermissions(subDir, subDir2)
+    when symlinksAreHandled:
+      doAssert expandSymlink(brokenSymlinkInSubDir2) == brokenSymlinkSrc
+    else:
+      doAssert not fileExists(brokenSymlinkInSubDir2)
+    removeDir(subDir2)
+
+    # Test moveFile
+    moveFile(brokenSymlink, brokenSymlinkCopy)
+    when not defined(windows):
+      doAssert expandSymlink(brokenSymlinkCopy) == brokenSymlinkSrc
+    else:
+      doAssert symlinkExists(brokenSymlinkCopy)
+    removeFile(brokenSymlinkCopy)
+
+    # Test moveDir
+    moveDir(subDir, subDir2)
+    when not defined(windows):
+      doAssert expandSymlink(brokenSymlinkInSubDir2) == brokenSymlinkSrc
+    else:
+      doAssert symlinkExists(brokenSymlinkInSubDir2)
+
+    removeDir(dname)
+
+block: # moveFile
+  let tempDir = getTempDir() / "D20210609T151608"
+  createDir(tempDir)
+  defer: removeDir(tempDir)
+
+  writeFile(tempDir / "a.txt", "")
+  moveFile(tempDir / "a.txt", tempDir / "b.txt")
+  doAssert not fileExists(tempDir / "a.txt")
+  doAssert fileExists(tempDir / "b.txt")
+  removeFile(tempDir / "b.txt")
+
+  createDir(tempDir / "moveFile_test")
+  writeFile(tempDir / "moveFile_test/a.txt", "")
+  moveFile(tempDir / "moveFile_test/a.txt", tempDir / "moveFile_test/b.txt")
+  doAssert not fileExists(tempDir / "moveFile_test/a.txt")
+  doAssert fileExists(tempDir / "moveFile_test/b.txt")
+  removeDir(tempDir / "moveFile_test")
+
+  createDir(tempDir / "moveFile_test")
+  writeFile(tempDir / "a.txt", "")
+  moveFile(tempDir / "a.txt", tempDir / "moveFile_test/b.txt")
+  doAssert not fileExists(tempDir / "a.txt")
+  doAssert fileExists(tempDir / "moveFile_test/b.txt")
+  removeDir(tempDir / "moveFile_test")
+
+block: # moveDir
+  let tempDir = getTempDir() / "D20210609T161443"
+  createDir(tempDir)
+  defer: removeDir(tempDir)
+
+  createDir(tempDir / "moveDir_test")
+  moveDir(tempDir / "moveDir_test/", tempDir / "moveDir_test_dest")
+  doAssert not dirExists(tempDir / "moveDir_test")
+  doAssert dirExists(tempDir / "moveDir_test_dest")
+  removeDir(tempDir / "moveDir_test_dest")
+
+  createDir(tempDir / "moveDir_test")
+  writeFile(tempDir / "moveDir_test/a.txt", "")
+  moveDir(tempDir / "moveDir_test", tempDir / "moveDir_test_dest")
+  doAssert not dirExists(tempDir / "moveDir_test")
+  doAssert not fileExists(tempDir / "moveDir_test/a.txt")
+  doAssert dirExists(tempDir / "moveDir_test_dest")
+  doAssert fileExists(tempDir / "moveDir_test_dest/a.txt")
+  removeDir(tempDir / "moveDir_test_dest")
+
 import times
 block modificationTime:
   # Test get/set modification times
@@ -154,7 +347,7 @@ block walkDirRec:
     doAssert p.startsWith("walkdir_test")
 
   var s: seq[string]
-  for p in walkDirRec("walkdir_test", {pcFile}, {pcDir}, relative=true):
+  for p in walkDirRec("walkdir_test", {pcFile}, {pcDir}, relative = true):
     s.add(p)
 
   doAssert s.len == 2
@@ -163,13 +356,36 @@ block walkDirRec:
 
   removeDir("walkdir_test")
 
-when not defined(windows):
-  block walkDirRelative:
-    createDir("walkdir_test")
-    createSymlink(".", "walkdir_test/c")
-    for k, p in walkDir("walkdir_test", true):
-      doAssert k == pcLinkToDir
-    removeDir("walkdir_test")
+import std/sequtils
+
+block: # walkDir
+  doAssertRaises(OSError):
+    for a in walkDir("nonexistent", checkDir = true): discard
+  doAssertRaises(OSError):
+    for p in walkDirRec("nonexistent", checkDir = true): discard
+
+  when not defined(windows):
+    block walkDirRelative:
+      createDir("walkdir_test")
+      createSymlink(".", "walkdir_test/c")
+      for k, p in walkDir("walkdir_test", true):
+        doAssert k == pcLinkToDir
+      removeDir("walkdir_test")
+
+  when defined(posix):
+    block walkDirSpecial:
+      createDir("walkdir_test")
+      doAssert execShellCmd("mkfifo walkdir_test/fifo") == 0
+      createSymlink("fifo", "walkdir_test/fifo_link")
+      let withSpecialFiles = toSeq(walkDir("walkdir_test", relative = true))
+      doAssert (withSpecialFiles.len == 2 and
+                (pcFile, "fifo") in withSpecialFiles and
+                (pcLinkToFile, "fifo_link") in withSpecialFiles)
+      # now Unix special files are excluded from walkdir output:
+      let skipSpecialFiles = toSeq(walkDir("walkdir_test", relative = true,
+                                           skipSpecial = true))
+      doAssert skipSpecialFiles.len == 0
+      removeDir("walkdir_test")
 
 block normalizedPath:
   doAssert normalizedPath("") == ""
@@ -216,7 +432,7 @@ block absolutePath:
   doAssertRaises(ValueError): discard absolutePath("a", "b")
   doAssert absolutePath("a") == getCurrentDir() / "a"
   doAssert absolutePath("a", "/b") == "/b" / "a"
-  when defined(Posix):
+  when defined(posix):
     doAssert absolutePath("a", "/b/") == "/b" / "a"
     doAssert absolutePath("a", "/b/c") == "/b/c" / "a"
     doAssert absolutePath("/a", "b/") == "/a"
@@ -325,19 +541,30 @@ block ospaths:
   doAssert relativePath("/Users/me/bar/z.nim", "/Users/other/bad", '/') == "../../me/bar/z.nim"
 
   doAssert relativePath("/Users/me/bar/z.nim", "/Users/other", '/') == "../me/bar/z.nim"
-  doAssert relativePath("/Users///me/bar//z.nim", "//Users/", '/') == "me/bar/z.nim"
+
+  # `//` is a UNC path, `/` is the current working directory's drive, so can't
+  # run this test on Windows.
+  when not doslikeFileSystem:
+    doAssert relativePath("/Users///me/bar//z.nim", "//Users/", '/') == "me/bar/z.nim"
   doAssert relativePath("/Users/me/bar/z.nim", "/Users/me", '/') == "bar/z.nim"
   doAssert relativePath("", "/users/moo", '/') == ""
   doAssert relativePath("foo", "", '/') == "foo"
-  doAssert relativePath("/foo", "/Foo", '/') == (when FileSystemCaseSensitive: "../foo" else: "")
-  doAssert relativePath("/Foo", "/foo", '/') == (when FileSystemCaseSensitive: "../Foo" else: "")
-  doAssert relativePath("/foo", "/fOO", '/') == (when FileSystemCaseSensitive: "../foo" else: "")
-  doAssert relativePath("/foO", "/foo", '/') == (when FileSystemCaseSensitive: "../foO" else: "")
+  doAssert relativePath("/foo", "/Foo", '/') == (when FileSystemCaseSensitive: "../foo" else: ".")
+  doAssert relativePath("/Foo", "/foo", '/') == (when FileSystemCaseSensitive: "../Foo" else: ".")
+  doAssert relativePath("/foo", "/fOO", '/') == (when FileSystemCaseSensitive: "../foo" else: ".")
+  doAssert relativePath("/foO", "/foo", '/') == (when FileSystemCaseSensitive: "../foO" else: ".")
 
   doAssert relativePath("foo", ".", '/') == "foo"
   doAssert relativePath(".", ".", '/') == "."
   doAssert relativePath("..", ".", '/') == ".."
 
+  doAssert relativePath("foo", "foo") == "."
+  doAssert relativePath("", "foo") == ""
+  doAssert relativePath("././/foo", "foo//./") == "."
+
+  doAssert relativePath(getCurrentDir() / "bar", "foo") == "../bar".unixToNativePath
+  doAssert relativePath("bar", getCurrentDir() / "foo") == "../bar".unixToNativePath
+
   when doslikeFileSystem:
     doAssert relativePath(r"c:\foo.nim", r"C:\") == r"foo.nim"
     doAssert relativePath(r"c:\foo\bar\baz.nim", r"c:\foo") == r"bar\baz.nim"
@@ -353,10 +580,50 @@ block ospaths:
     doAssert relativePath(r"\\foo\bar\baz.nim", r"\foo") == r"\\foo\bar\baz.nim"
     doAssert relativePath(r"c:\foo.nim", r"\foo") == r"c:\foo.nim"
 
-  doAssert joinPath("usr", "") == unixToNativePath"usr/"
+  doAssert joinPath("usr", "") == unixToNativePath"usr"
   doAssert joinPath("", "lib") == "lib"
   doAssert joinPath("", "/lib") == unixToNativePath"/lib"
   doAssert joinPath("usr/", "/lib") == unixToNativePath"usr/lib"
+  doAssert joinPath("", "") == unixToNativePath"" # issue #13455
+  doAssert joinPath("", "/") == unixToNativePath"/"
+  doAssert joinPath("/", "/") == unixToNativePath"/"
+  doAssert joinPath("/", "") == unixToNativePath"/"
+  doAssert joinPath("/" / "") == unixToNativePath"/" # weird test case...
+  doAssert joinPath("/", "/a/b/c") == unixToNativePath"/a/b/c"
+  doAssert joinPath("foo/", "") == unixToNativePath"foo/"
+  doAssert joinPath("foo/", "abc") == unixToNativePath"foo/abc"
+  doAssert joinPath("foo//./", "abc/.//") == unixToNativePath"foo/abc/"
+  doAssert joinPath("foo", "abc") == unixToNativePath"foo/abc"
+  doAssert joinPath("", "abc") == unixToNativePath"abc"
+
+  doAssert joinPath("zook/.", "abc") == unixToNativePath"zook/abc"
+
+  # controversial: inconsistent with `joinPath("zook/.","abc")`
+  # on linux, `./foo` and `foo` are treated a bit differently for executables
+  # but not `./foo/bar` and `foo/bar`
+  doAssert joinPath(".", "/lib") == unixToNativePath"./lib"
+  doAssert joinPath(".", "abc") == unixToNativePath"./abc"
+
+  # cases related to issue #13455
+  doAssert joinPath("foo", "", "") == "foo"
+  doAssert joinPath("foo", "") == "foo"
+  doAssert joinPath("foo/", "") == unixToNativePath"foo/"
+  doAssert joinPath("foo/", ".") == "foo"
+  doAssert joinPath("foo", "./") == unixToNativePath"foo/"
+  doAssert joinPath("foo", "", "bar/") == unixToNativePath"foo/bar/"
+
+  # issue #13579
+  doAssert joinPath("/foo", "../a") == unixToNativePath"/a"
+  doAssert joinPath("/foo/", "../a") == unixToNativePath"/a"
+  doAssert joinPath("/foo/.", "../a") == unixToNativePath"/a"
+  doAssert joinPath("/foo/.b", "../a") == unixToNativePath"/foo/a"
+  doAssert joinPath("/foo///", "..//a/") == unixToNativePath"/a/"
+  doAssert joinPath("foo/", "../a") == unixToNativePath"a"
+
+  when doslikeFileSystem:
+    doAssert joinPath("C:\\Program Files (x86)\\Microsoft Visual Studio 14.0\\Common7\\Tools\\", "..\\..\\VC\\vcvarsall.bat") == r"C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat"
+    doAssert joinPath("C:\\foo", "..\\a") == r"C:\a"
+    doAssert joinPath("C:\\foo\\", "..\\a") == r"C:\a"
 
 block getTempDir:
   block TMPDIR:
@@ -372,16 +639,8 @@ block getTempDir:
       else:
         doAssert getTempDir() == "/tmp/"
 
-block osenv:
-  block delEnv:
-    const dummyEnvVar = "DUMMY_ENV_VAR" # This env var wouldn't be likely to exist to begin with
-    doAssert existsEnv(dummyEnvVar) == false
-    putEnv(dummyEnvVar, "1")
-    doAssert existsEnv(dummyEnvVar) == true
-    delEnv(dummyEnvVar)
-    doAssert existsEnv(dummyEnvVar) == false
-    delEnv(dummyEnvVar)         # deleting an already deleted env var
-    doAssert existsEnv(dummyEnvVar) == false
+block: # getCacheDir
+  doAssert getCacheDir().dirExists
 
 block isRelativeTo:
   doAssert isRelativeTo("/foo", "/")
@@ -394,3 +653,223 @@ block isRelativeTo:
   doAssert isRelativeTo("foo/bar", ".")
   doAssert not isRelativeTo("foo/bar.nims", "foo/bar.nim")
   doAssert not isRelativeTo("/foo2", "/foo")
+
+block: # quoteShellWindows
+  doAssert quoteShellWindows("aaa") == "aaa"
+  doAssert quoteShellWindows("aaa\"") == "aaa\\\""
+  doAssert quoteShellWindows("") == "\"\""
+
+block: # quoteShellCommand
+  when defined(windows):
+    doAssert quoteShellCommand(["a b c", "d", "e"]) == """"a b c" d e"""
+    doAssert quoteShellCommand(["""ab"c""", r"\", "d"]) == """ab\"c \ d"""
+    doAssert quoteShellCommand(["""ab"c""", """ \""", "d"]) == """ab\"c " \\" d"""
+    doAssert quoteShellCommand(["""a\\\b""", """de fg""", "h"]) == """a\\\b "de fg" h"""
+    doAssert quoteShellCommand(["""a\"b""", "c", "d"]) == """a\\\"b c d"""
+    doAssert quoteShellCommand(["""a\\b c""", "d", "e"]) == """"a\\b c" d e"""
+    doAssert quoteShellCommand(["""a\\b\ c""", "d", "e"]) == """"a\\b\ c" d e"""
+    doAssert quoteShellCommand(["ab", ""]) == """ab """""
+
+block: # quoteShellPosix
+  doAssert quoteShellPosix("aaa") == "aaa"
+  doAssert quoteShellPosix("aaa a") == "'aaa a'"
+  doAssert quoteShellPosix("") == "''"
+  doAssert quoteShellPosix("a'a") == "'a'\"'\"'a'"
+
+block: # quoteShell
+  when defined(posix):
+    doAssert quoteShell("") == "''"
+
+block: # normalizePathEnd
+  # handle edge cases correctly: shouldn't affect whether path is
+  # absolute/relative
+  doAssert "".normalizePathEnd(true) == ""
+  doAssert "".normalizePathEnd(false) == ""
+  doAssert "/".normalizePathEnd(true) == $DirSep
+  doAssert "/".normalizePathEnd(false) == $DirSep
+
+  when defined(posix):
+    doAssert "//".normalizePathEnd(false) == "/"
+    doAssert "foo.bar//".normalizePathEnd == "foo.bar"
+    doAssert "bar//".normalizePathEnd(trailingSep = true) == "bar/"
+  when defined(windows):
+    doAssert r"C:\foo\\".normalizePathEnd == r"C:\foo"
+    doAssert r"C:\foo".normalizePathEnd(trailingSep = true) == r"C:\foo\"
+    # this one is controversial: we could argue for returning `D:\` instead,
+    # but this is simplest.
+    doAssert r"D:\".normalizePathEnd == r"D:"
+    doAssert r"E:/".normalizePathEnd(trailingSep = true) == r"E:\"
+    doAssert "/".normalizePathEnd == r"\"
+
+
+import sugar
+
+block: # normalizeExe
+  doAssert "".dup(normalizeExe) == ""
+  when defined(posix):
+    doAssert "foo".dup(normalizeExe) == "./foo"
+    doAssert "foo/../bar".dup(normalizeExe) == "foo/../bar"
+  when defined(windows):
+    doAssert "foo".dup(normalizeExe) == "foo"
+
+block: # isAdmin
+  let isAzure = existsEnv("TF_BUILD") # xxx factor with testament.specs.isAzure
+  # In Azure on Windows tests run as an admin user
+  if isAzure and defined(windows): doAssert isAdmin()
+  # In Azure on POSIX tests run as a normal user
+  if isAzure and defined(posix): doAssert not isAdmin()
+
+
+import sugar
+
+block: # normalizeExe
+  doAssert "".dup(normalizeExe) == ""
+  when defined(posix):
+    doAssert "foo".dup(normalizeExe) == "./foo"
+    doAssert "foo/../bar".dup(normalizeExe) == "foo/../bar"
+  when defined(windows):
+    doAssert "foo".dup(normalizeExe) == "foo"
+
+block: # isAdmin
+  let isAzure = existsEnv("TF_BUILD") # xxx factor with testament.specs.isAzure
+  # In Azure on Windows tests run as an admin user
+  if isAzure and defined(windows): doAssert isAdmin()
+  # In Azure on POSIX tests run as a normal user
+  if isAzure and defined(posix): doAssert not isAdmin()
+
+when doslikeFileSystem:
+  import std/private/ntpath
+
+  block: # Bug #19103 UNC paths
+
+    # Easiest way of generating a valid, readable and writable UNC path
+    let tempDir = r"\\?\" & getTempDir()
+    doAssert dirExists tempDir
+    createDir tempDir / "test"
+    removeDir tempDir / "test"
+    createDir tempDir / "recursive" / "test"
+    removeDir tempDir / "recursive" / "test"
+
+    let tempDir2 = getTempDir()
+    let (drive, pathNoDrive) = splitDrive(tempDir2)
+    setCurrentDir drive
+    doAssert cmpIgnoreCase(getCurrentDir().splitDrive.drive, drive) == 0
+
+    # Test `\Users` path syntax on Windows by stripping away drive. `\`
+    # resolves to the drive in current working directory. This drive will be
+    # the same as `tempDir2` because of the `setCurrentDir` above.
+    doAssert pathNoDrive[0] == '\\'
+    createDir pathNoDrive / "test"
+    doAssert dirExists pathNoDrive / "test"
+    removeDir pathNoDrive / "test"
+
+    doAssert splitPath("//?/c:") == ("//?/c:", "")
+
+    doAssert relativePath("//?/c:///Users//me", "//?/c:", '/') == "Users/me"
+
+    doAssert parentDir(r"\\?\c:") == r""
+    doAssert parentDir(r"//?/c:/Users") == r"\\?\c:"
+    doAssert parentDir(r"\\localhost\c$") == r""
+    doAssert parentDir(r"\Users") == r"\"
+
+    doAssert tailDir("//?/c:") == ""
+    doAssert tailDir("//?/c:/Users") == "Users"
+    doAssert tailDir(r"\\localhost\c$\Windows\System32") == r"Windows\System32"
+
+    doAssert isRootDir("//?/c:")
+    doAssert isRootDir("//?/UNC/localhost/c$")
+    doAssert not isRootDir(r"\\?\c:\Users")
+
+    doAssert parentDirs(r"C:\Users", fromRoot = true).toSeq == @[r"C:\", r"C:\Users"]
+    doAssert parentDirs(r"C:\Users", fromRoot = false).toSeq == @[r"C:\Users", r"C:"]
+    doAssert parentDirs(r"\\?\c:\Users", fromRoot = true).toSeq ==
+      @[r"\\?\c:\", r"\\?\c:\Users"]
+    doAssert parentDirs(r"\\?\c:\Users", fromRoot = false).toSeq ==
+      @[r"\\?\c:\Users", r"\\?\c:"]
+    doAssert parentDirs(r"//localhost/c$/Users", fromRoot = true).toSeq ==
+      @[r"//localhost/c$/", r"//localhost/c$/Users"]
+    doAssert parentDirs(r"//?/UNC/localhost/c$/Users", fromRoot = false).toSeq ==
+      @[r"//?/UNC/localhost/c$/Users", r"\\?\UNC\localhost\c$"]
+    doAssert parentDirs(r"\Users", fromRoot = true).toSeq == @[r"\", r"\Users"]
+    doAssert parentDirs(r"\Users", fromRoot = false).toSeq == @[r"\Users", r"\"]
+
+    doAssert r"//?/c:" /../ "d/e" == r"\\?\c:\d\e"
+    doAssert r"//?/c:/Users" /../ "d/e" == r"\\?\c:\d\e"
+    doAssert r"\\localhost\c$" /../ "d/e" == r"\\localhost\c$\d\e"
+
+    doAssert splitFile("//?/c:") == ("//?/c:", "", "")
+    doAssert splitFile("//?/c:/Users") == ("//?/c:", "Users", "")
+    doAssert splitFile(r"\\localhost\c$\test.txt") == (r"\\localhost\c$", "test", ".txt")
+
+else:
+  block: # parentDirs
+    doAssert parentDirs("/home", fromRoot=true).toSeq == @["/", "/home"]
+    doAssert parentDirs("/home", fromRoot=false).toSeq == @["/home", "/"]
+    doAssert parentDirs("home", fromRoot=true).toSeq == @["home"]
+    doAssert parentDirs("home", fromRoot=false).toSeq == @["home"]
+
+    doAssert parentDirs("/home/user", fromRoot=true).toSeq == @["/", "/home/", "/home/user"]
+    doAssert parentDirs("/home/user", fromRoot=false).toSeq == @["/home/user", "/home", "/"]
+    doAssert parentDirs("home/user", fromRoot=true).toSeq == @["home/", "home/user"]
+    doAssert parentDirs("home/user", fromRoot=false).toSeq == @["home/user", "home"]
+
+
+# https://github.com/nim-lang/Nim/pull/19643#issuecomment-1235102314
+block:  # isValidFilename
+  # Negative Tests.
+  doAssert not isValidFilename("abcd", maxLen = 2)
+  doAssert not isValidFilename("0123456789", maxLen = 8)
+  doAssert not isValidFilename("con")
+  doAssert not isValidFilename("aux")
+  doAssert not isValidFilename("prn")
+  doAssert not isValidFilename("OwO|UwU")
+  doAssert not isValidFilename(" foo")
+  doAssert not isValidFilename("foo ")
+  doAssert not isValidFilename("foo.")
+  doAssert not isValidFilename("con.txt")
+  doAssert not isValidFilename("aux.bat")
+  doAssert not isValidFilename("prn.exe")
+  doAssert not isValidFilename("nim>.nim")
+  doAssert not isValidFilename(" foo.log")
+  # Positive Tests.
+  doAssert isValidFilename("abcd", maxLen = 42.Positive)
+  doAssert isValidFilename("c0n")
+  doAssert isValidFilename("foo.aux")
+  doAssert isValidFilename("bar.prn")
+  doAssert isValidFilename("OwO_UwU")
+  doAssert isValidFilename("cron")
+  doAssert isValidFilename("ux.bat")
+  doAssert isValidFilename("nim.nim")
+  doAssert isValidFilename("foo.log")
+
+block: # searchExtPos
+  doAssert "foo.nim".searchExtPos == 3
+  doAssert "/foo.nim".searchExtPos == 4
+  doAssert "".searchExtPos == -1
+  doAssert "/".searchExtPos == -1
+  doAssert "a.b/foo".searchExtPos == -1
+  doAssert ".".searchExtPos == -1
+  doAssert "foo.".searchExtPos == 3
+  doAssert "foo..".searchExtPos == 4
+  doAssert "..".searchExtPos == -1
+  doAssert "...".searchExtPos == -1
+  doAssert "./".searchExtPos == -1
+  doAssert "../".searchExtPos == -1
+  doAssert "/.".searchExtPos == -1
+  doAssert "/..".searchExtPos == -1
+  doAssert ".b".searchExtPos == -1
+  doAssert "..b".searchExtPos == -1
+  doAssert "/.b".searchExtPos == -1
+  doAssert "a/.b".searchExtPos == -1
+  doAssert ".a.b".searchExtPos == 2
+  doAssert "a/.b.c".searchExtPos == 4
+  doAssert "a/..b".searchExtPos == -1
+  doAssert "a/b..c".searchExtPos == 4
+
+  when doslikeFileSystem:
+    doAssert "c:a.b".searchExtPos == 3
+    doAssert "c:.a".searchExtPos == -1
+    doAssert r"c:\.a".searchExtPos == -1
+    doAssert "c:..a".searchExtPos == -1
+    doAssert r"c:\..a".searchExtPos == -1
+    doAssert "c:.a.b".searchExtPos == 4