summaryrefslogtreecommitdiffstats
path: root/tests/018
diff options
context:
space:
mode:
Diffstat (limited to 'tests/018')
-rw-r--r--tests/018/chmod.expected0
-rw-r--r--tests/018/chmod.tl36
-rw-r--r--tests/018/clean.expected100
-rw-r--r--tests/018/clean.tl10
-rw-r--r--tests/018/close-delegate.expected6
-rw-r--r--tests/018/close-delegate.tl40
-rw-r--r--tests/018/close-lazy.tl3
-rw-r--r--tests/018/combine-tlo.tl27
-rw-r--r--tests/018/crypt.tl23
-rw-r--r--tests/018/errno.tl8
-rw-r--r--tests/018/forkflush.expected12
-rw-r--r--tests/018/forkflush.tl36
-rw-r--r--tests/018/format.tl273
-rw-r--r--tests/018/getput.tl33
-rw-r--r--tests/018/glob.tl142
-rw-r--r--tests/018/gzip.tl59
-rw-r--r--tests/018/noclose.expected1
-rw-r--r--tests/018/noclose.txr16
-rw-r--r--tests/018/path-equal.tl17
-rw-r--r--tests/018/path-safe.tl105
-rw-r--r--tests/018/path-test.tl22
-rw-r--r--tests/018/path.tl320
-rw-r--r--tests/018/process.tl36
-rw-r--r--tests/018/rel-path.tl25
-rw-r--r--tests/018/sh-esc.tl58
25 files changed, 1393 insertions, 15 deletions
diff --git a/tests/018/chmod.expected b/tests/018/chmod.expected
deleted file mode 100644
index e69de29b..00000000
--- a/tests/018/chmod.expected
+++ /dev/null
diff --git a/tests/018/chmod.tl b/tests/018/chmod.tl
index ada3f0be..d8663b5e 100644
--- a/tests/018/chmod.tl
+++ b/tests/018/chmod.tl
@@ -7,7 +7,9 @@
(with-stream (s (open-file tgt "w")))
(umask #o022)
-(defvarl test-sticky (progn
+(defvarl os (os-symbol))
+
+(defvarl test-sticky (unless (meq os :bsd :openbsd)
(chmod tgt s-isvtx)
(let ((st (stat tgt)))
(plusp (logand s-isvtx st.mode)))))
@@ -19,19 +21,19 @@
(when (or test-sticky
(not (find #\t `@init@mode@expected`)))
(let ((ini (dec-perm init))
- (exp (dec-perm expected)))
+ (exp (dec-perm expected)))
(chmod tgt ini)
(let* ((st (stat tgt))
- (m (mode-bits st.mode)))
- (unless (eql m ini)
- (error "failed to set initial mode: expected: ~s, actual: ~s "
- init (enc-perm m))))
+ (m (mode-bits st.mode)))
+ (unless (eql m ini)
+ (error "failed to set initial mode: expected: ~s, actual: ~s "
+ init (enc-perm m))))
(chmod tgt mode)
(let* ((st (stat tgt))
- (m (mode-bits st.mode)))
- (unless (eql m exp)
- (error "failed to set mode with ~s: expected ~s, actual ~s"
- mode expected (enc-perm m)))))))
+ (m (mode-bits st.mode)))
+ (unless (eql m exp)
+ (error "failed to set mode with ~s: expected ~s, actual ~s"
+ mode expected (enc-perm m)))))))
(cht "------------" "a+strwx" "sgtrwxrwxrwx")
(cht "------------" "+strwx" "sgtrwxr-xr-x")
@@ -39,15 +41,19 @@
(cht "------------" "g+s" "-g----------")
(cht "------------" "+t" "--t---------")
(cht "sgtrwxrwxrwx" "=" "------------")
-(cht "sgtrwxrwxrwx" "u=" "-gt---rwxrwx")
-(cht "sgtrwxrwxrwx" "g=" "s-trwx---rwx")
-(cht "sgtrwxrwxrwx" "o=" "sg-rwxrwx---")
+;; These tests don't work on Cygwin 3.1.7, Windows 10.
+;; They worked on Cygwin 2.5 on Windows 7.
+(unless (eq os :cygwin)
+ (cht "sgtrwxrwxrwx" "u=" "-gt---rwxrwx")
+ (cht "sgtrwxrwxrwx" "g=" "s-trwx---rwx")
+ (cht "sgtrwxrwxrwx" "o=" "sg-rwxrwx---"))
(cht "------------" "u+s,g+s" "sg----------")
(cht "------------" "u+r,g+r,o+r,+t,+s" "sgtr--r--r--")
(cht "------------" "+rwx,g-r+w,o-r+w" "---rwx-wx-wx")
(cht "---------rwx" "u=rwsx" "s--rwx---rwx")
-(cht "---------rwx" "u=rwsx,g=rwx,go-x" "s--rwxrw-rw-")
-(cht "---------rwx" "g=o,g-w+s,u=g,o-x" "-g-r-xr-xrw-")
+(unless (eq os :cygwin)
+ (cht "---------rwx" "u=rwsx,g=rwx,go-x" "s--rwxrw-rw-")
+ (cht "---------rwx" "g=o,g-w+s,u=g,o-x" "-g-r-xr-xrw-"))
(cht "---------rwx" "o=o" "---------rwx")
(cht "-----x------" "a+X" "-----x--x--x")
(cht "-----x------" "=,a+X" "------------")
diff --git a/tests/018/clean.expected b/tests/018/clean.expected
new file mode 100644
index 00000000..25b0c86c
--- /dev/null
+++ b/tests/018/clean.expected
@@ -0,0 +1,100 @@
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor.tl"))
+-->
+(remove-path ("nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor.txr"))
+-->
+(remove-path ("nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor.tlo"))
+-->
+(remove-path ("nabuchodonosor.tlo" nil)
+ nil)
+
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor.tlo.gz"))
+-->
+(remove-path ("nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor.abc"))
+-->
+(remove-path ("nabuchodonosor.abc.tlo" nil)
+ nil)
+(remove-path ("nabuchodonosor.abc.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ ()))
+ (clean-file "nabuchodonosor"))
+-->
+(remove-path ("nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor.tl"))
+-->
+(remove-path ("/tmp/nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("/tmp/nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor.txr"))
+-->
+(remove-path ("/tmp/nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("/tmp/nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor.tlo"))
+-->
+(remove-path ("/tmp/nabuchodonosor.tlo" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor.tlo.gz"))
+-->
+(remove-path ("/tmp/nabuchodonosor.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor.abc"))
+-->
+(remove-path ("/tmp/nabuchodonosor.abc.tlo" nil)
+ nil)
+(remove-path ("/tmp/nabuchodonosor.abc.tlo.gz" nil)
+ nil)
+
+(let ((*load-path*
+ "/tmp/foo.tlo"))
+ (clean-file "nabuchodonosor"))
+-->
+(remove-path ("/tmp/nabuchodonosor.tlo" nil)
+ nil)
+(remove-path ("/tmp/nabuchodonosor.tlo.gz" nil)
+ nil)
+
diff --git a/tests/018/clean.tl b/tests/018/clean.tl
new file mode 100644
index 00000000..ed6f29a3
--- /dev/null
+++ b/tests/018/clean.tl
@@ -0,0 +1,10 @@
+(trace remove-path)
+
+(each ((*load-path* '(nil "/tmp/foo.tlo")))
+ (each ((name '#"nabuchodonosor.tl nabuchodonosor.txr \
+ nabuchodonosor.tlo nabuchodonosor.tlo.gz \
+ nabuchodonosor.abc nabuchodonosor"))
+ (prinl ^(let ((*load-path* , *load-path*)) (clean-file ,name)))
+ (put-line "-->")
+ (clean-file name)
+ (put-line)))
diff --git a/tests/018/close-delegate.expected b/tests/018/close-delegate.expected
new file mode 100644
index 00000000..de68447f
--- /dev/null
+++ b/tests/018/close-delegate.expected
@@ -0,0 +1,6 @@
+close called, count 2
+close called, count 1
+40
+close called, count 2
+close called, count 1
+40
diff --git a/tests/018/close-delegate.tl b/tests/018/close-delegate.tl
new file mode 100644
index 00000000..64a1dc91
--- /dev/null
+++ b/tests/018/close-delegate.tl
@@ -0,0 +1,40 @@
+(load "../common")
+
+(defstruct refcount-close stream-wrap
+ stream
+ (count 1)
+
+ (:method close (me throw-on-error-p)
+ (put-line `close called, count @{me.count}`)
+ (when (plusp me.count)
+ (if (zerop (dec me.count))
+ (close-stream me.stream throw-on-error-p)))))
+
+(flow
+ (with-stream (s (make-struct-delegate-stream
+ (new refcount-close
+ count 2
+ stream (open-file *load-path*))))
+ (get-lines s))
+ len
+ prinl)
+
+(defstruct refcount-close-alt stream-wrap
+ stream
+ (count 1)
+
+ (:method close (me throw-on-error-p)
+ (put-line `close called, count @{me.count}`)
+ (when (plusp me.count)
+ (if (zerop (dec me.count))
+ (close-stream me.stream throw-on-error-p)
+ :))))
+
+(flow
+ (with-stream (s (make-struct-delegate-stream
+ (new refcount-close-alt
+ count 2
+ stream (open-file *load-path*))))
+ (get-lines s))
+ len
+ prinl)
diff --git a/tests/018/close-lazy.tl b/tests/018/close-lazy.tl
new file mode 100644
index 00000000..c6b08e72
--- /dev/null
+++ b/tests/018/close-lazy.tl
@@ -0,0 +1,3 @@
+(dotimes (i 20000)
+ (close-lazy-streams
+ (file-get-lines self-path)))
diff --git a/tests/018/combine-tlo.tl b/tests/018/combine-tlo.tl
new file mode 100644
index 00000000..e2dc0f83
--- /dev/null
+++ b/tests/018/combine-tlo.tl
@@ -0,0 +1,27 @@
+(load "../common")
+
+(push-after-load
+ (remove-path "libfile.tl")
+ (remove-path "libfile.tlo")
+ (remove-path "mainfile.tl")
+ (remove-path "mainfile.tlo")
+ (remove-path "progfile"))
+
+(file-put-lines
+ "libfile.tl"
+ ^(,`#!@{txr-exe-path} --lisp`
+ "(defun libfun ()"
+ " (put-line \"libfun\"))"))
+
+(file-put-lines
+ "mainfile.tl"
+ '("(compile-only (libfun))"))
+
+(compile-file "./libfile")
+(compile-file "./mainfile")
+
+(cat-files "progfile" "libfile.tlo" "mainfile.tlo")
+
+(chmod "progfile" "+x")
+
+(test (command-get-lines "./progfile") ("libfun"))
diff --git a/tests/018/crypt.tl b/tests/018/crypt.tl
new file mode 100644
index 00000000..dc044878
--- /dev/null
+++ b/tests/018/crypt.tl
@@ -0,0 +1,23 @@
+(load "../common")
+
+(if (meq (os-symbol) :android :cygwin)
+ (exit))
+
+(mtest
+ (crypt nil nil) :error)
+
+(if (neq :openbsd (os-symbol))
+ (mtest
+ (crypt "a" "bc") "bcshMw5X24ayQ"
+ (crypt "a" "bcd") "bcshMw5X24ayQ"))
+
+(if (eq :linux (os-symbol))
+ (mtest
+ (crypt "a" "b") :error
+ (crypt "a" "::") :error
+ (crypt "a" "$1$") "$1$$Ij31LCAysPM23KuPlm1wA/"
+ (crypt "a" "$1$bcd$") "$1$bcd$cgz778Ks3pkbWfyW.CWae/"
+ (crypt "a" "$5$") "$5$$QG6CCM7eJAxpUPcBpn0Z2K29NHtaI6Mk1fCpPrpjdj3"
+ (crypt "a" "$5$bcd$") "$5$bcd$OGt98FNCHtKIrT6qWAKLXOQ8eIApFT5dJngrYreMwF3"
+ (crypt "a" "$6$") "$6$$ek/ucQg0IM8SQLyD2D66mpoW0vAF26eA0/pqoN95V.F0nZh1IFuENNo0OikacRkDBk5frNqziMYMdVVrQ0o.51"
+ (crypt "a" "$6$bcd$") "$6$bcd$RK8RFj8wSE1NBJi8s.KDjGQK3EbpI474a6f4UP0LGOkQU50ZQrwykBaSjx7tZFVEpanpL44zd1p6A9q.sy.YH0"))
diff --git a/tests/018/errno.tl b/tests/018/errno.tl
new file mode 100644
index 00000000..ec204b23
--- /dev/null
+++ b/tests/018/errno.tl
@@ -0,0 +1,8 @@
+(load "../common")
+
+(vtest
+ (catch
+ (open-file "/NoNeXiStEnT")
+ (error (msg)
+ (string-get-code msg)))
+ enoent)
diff --git a/tests/018/forkflush.expected b/tests/018/forkflush.expected
new file mode 100644
index 00000000..475f87b1
--- /dev/null
+++ b/tests/018/forkflush.expected
@@ -0,0 +1,12 @@
+A
+B
+C
+D
+E
+F
+G
+H
+I
+J
+K
+L
diff --git a/tests/018/forkflush.tl b/tests/018/forkflush.tl
new file mode 100644
index 00000000..296cec02
--- /dev/null
+++ b/tests/018/forkflush.tl
@@ -0,0 +1,36 @@
+(load "../common")
+
+(defvarl os (os-symbol))
+
+(push-after-load (remove-path "tmpfile"))
+
+(with-stream (*stdout* (open-file "tmpfile" "w"))
+ (cond
+ ((eq os :cygwin)
+ (put-string "A\nB\nC\nD\n"))
+ (t (put-line "A")
+ (sh "echo B")
+ (put-line "C")
+ (sh "echo D"))))
+
+(put-string (file-get-string "tmpfile"))
+
+(with-stream (*stdout* (open-file "tmpfile" "w"))
+ (put-line "E")
+ (with-stream (s (open-process "cat" "w"))
+ (put-line "F" s))
+ (put-line "G")
+ (with-stream (s (open-process "cat" "w"))
+ (put-line "H" s)))
+
+(put-string (file-get-string "tmpfile"))
+
+(with-stream (*stdout* (open-file "tmpfile" "w"))
+ (put-line "I")
+ (with-stream (s (open-command "cat" "w"))
+ (put-line "J" s))
+ (put-line "K")
+ (with-stream (s (open-command "cat" "w"))
+ (put-line "L" s)))
+
+(put-string (file-get-string "tmpfile"))
diff --git a/tests/018/format.tl b/tests/018/format.tl
new file mode 100644
index 00000000..6fc27b4e
--- /dev/null
+++ b/tests/018/format.tl
@@ -0,0 +1,273 @@
+(load "../common")
+
+(mtest
+ (fmt "~x" #b'') ""
+ (fmt "~4x" #b'') " "
+ (fmt "~4,02x" #b'') " 00"
+ (fmt "~x" #b'AF') "af"
+ (fmt "~4x" #b'AF') " af"
+ (fmt "~-4x" #b'AF') "af "
+ (fmt "~4,03x" #b'AF') " 0af"
+ (fmt "~-4,03X" #b'AF') "0AF ")
+
+(mtest
+ (fmt "~x" #\xaf) "af"
+ (fmt "~4x" #\xaf) " af"
+ (fmt "~-4x" #\xaf) "af "
+ (fmt "~4,03x" #\xaf) " 0af"
+ (fmt "~-4,03X" #\xaf) "0AF ")
+
+(mtest
+ (fmt "~x" #xaf) "af"
+ (fmt "~4x" #xaf) " af"
+ (fmt "~-4x" #xaf) "af "
+ (fmt "~4,03x" #xaf) " 0af"
+ (fmt "~-4,03X" #xaf) "0AF ")
+
+(test
+ (fmt "~x" (sha256 "abc"))
+ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad")
+
+(mtest
+ (fmt "~8,02f" 12) " 0012.00"
+ (fmt "~8,+02f" 12) "+0012.00"
+ (fmt "~8,-02f" 12) "00012.00"
+ (fmt "~8, 02f" 12) " 0012.00"
+ (fmt "~8,-02f" -12) "-0012.00"
+ (fmt "~6,02f" 12) " 12.00"
+ (fmt "~6,+02f" 12) "+12.00"
+ (fmt "~6,-02f" 12) "012.00"
+ (fmt "~6,- 2f" 12) " 12.00"
+ (fmt "~6,-02f" -12) "-12.00"
+ (fmt "~5,02f" 12) "12.00"
+ (fmt "~5,+02f" 12) "+12.00"
+ (fmt "~5,-02f" 12) "12.00"
+ (fmt "~5,- 2f" 12) "12.00"
+ (fmt "~5,-02f" -12) "-12.00")
+
+(mtest
+ (fmt "~<8,02f" 12) "0012.00 "
+ (fmt "~<8,+02f" 12) "+0012.00"
+ (fmt "~<8,-02f" 12) "00012.00"
+ (fmt "~<8, 02f" 12) " 0012.00"
+ (fmt "~<8,-02f" -12) "-0012.00"
+ (fmt "~<6,02f" 12) "12.00 "
+ (fmt "~<6,+02f" 12) "+12.00"
+ (fmt "~<6,-02f" 12) "012.00"
+ (fmt "~<6,- 2f" 12) " 12.00"
+ (fmt "~<6,-02f" -12) "-12.00"
+ (fmt "~<5,02f" 12) "12.00"
+ (fmt "~<5,+02f" 12) "+12.00"
+ (fmt "~<5,-02f" 12) "12.00"
+ (fmt "~<5,- 2f" 12) "12.00"
+ (fmt "~<5,-02f" -12) "-12.00")
+
+(mtest
+ (fmt "~<8,2a" 12) "12 "
+ (fmt "~<8,02a" 12) "12 "
+ (fmt "~<8,+02a" 12) "+12 "
+ (fmt "~<8,-02a" 12) "012 "
+ (fmt "~<8, 02a" 12) " 12 "
+ (fmt "~<8,2a" 12.0) "12 "
+ (fmt "~<8,02a" 12.0) "12 "
+ (fmt "~<8,+02a" 12.0) "+12 "
+ (fmt "~<8,-02a" 12.0) "012 "
+ (fmt "~<8, 02a" 12.0) " 12 "
+ (fmt "~<8,4a" 12.0) " 12 "
+ (fmt "~<8,04a" 12.0) "0012 "
+ (fmt "~<8,+04a" 12.0) "+0012 "
+ (fmt "~<8,-04a" 12.0) "00012 "
+ (fmt "~<8, 04a" 12.0) " 0012 "
+ (fmt "~<8,8a" 12.0) " 12 "
+ (fmt "~<8,08a" 12.0) "0000012 "
+ (fmt "~<8,+08a" 12.0) "+0000012"
+ (fmt "~<8,-08a" 12.0) "00000012"
+ (fmt "~<8, 08a" 12.0) " 0000012")
+
+(mtest
+ (fmt "~,04a" 1) "0001"
+ (fmt "~,4a" 1) " 1"
+ (fmt "~4,a" 1) " 1"
+ (fmt "~<8,a" 1) "1 "
+ (fmt "~<8,0a" 1) "1 "
+ (fmt "~<8,4a" 1) " 1 "
+ (fmt "~<8,04a" 1) "0001 "
+ (fmt "~<8,+04a" 1) "+0001 "
+ (fmt "~<,4a" 1) " 1")
+
+(mtest
+ (fmt "~,04a" 1) "0001"
+ (fmt "~,4a" 1) " 1"
+ (fmt "~4,a" 1) " 1"
+ (fmt "~<8,a" 1) "1 "
+ (fmt "~<8,0a" 1) "1 "
+ (fmt "~<8,4a" 1) " 1 "
+ (fmt "~<8,04a" 1) "0001 "
+ (fmt "~<8,+04a" 1) "+0001 "
+ (fmt "~<,4a" 1) " 1")
+
+(mtest
+ (fmt "~e" 1.2e13) "1.200e13"
+ (fmt "~,2e" 1.2e13) "1.20e13"
+ (fmt "~,0e" 1.2e13) "1e13"
+ (fmt "~8,0e" 1.2e13) " 1e13"
+ (fmt "~8,00e" 1.2e13) " 0001e13"
+ (fmt "~8,-0e" 1.2e13) " 01e13"
+ (fmt "~8,-00e" 1.2e13) "00001e13"
+ (fmt "~8, 00e" 1.2e13) " 0001e13"
+ (fmt "~8,+00e" 1.2e13) "+0001e13"
+ (fmt "~8,+00e" -1.2e13) "-0001e13"
+ (fmt "~8,00e" -1.2e13) "-0001e13"
+ (fmt "~<8,0e" 1.2e13) " 1e13 "
+ (fmt "~<8,00e" 1.2e13) "0001e13 "
+ (fmt "~<8,-0e" 1.2e13) " 01e13"
+ (fmt "~<8,-00e" 1.2e13) "00001e13"
+ (fmt "~<8,+00e" 1.2e13) "+0001e13")
+
+(mtest
+ (pic "") ""
+ (pic "~") :error
+ (pic "~z") :error
+ (pic "#") :error
+ (pic "# #" 1) :error
+ (pic "# # #" 1 2) :error
+ (pic "# # #" 1 2 3 4) :warning
+ (pic "~<") "<"
+ (pic "~>") ">"
+ (pic "~|") "|"
+ (pic "~#") "#"
+ (pic "~0") "0"
+ (pic "~+") "+"
+ (pic "~-") "-"
+ (pic "~.") "."
+ (pic "~!") "!"
+ (pic "~~") "~"
+ (pic "x~~y") "x~y"
+ (pic "~~x~~~~y~~") "~x~~y~")
+
+(mtest
+ (pic "<" "a") "a"
+ (pic "<<" "a") "a "
+ (pic "<<<" "a") "a "
+ (pic "~<<~>" "a") "<a>"
+ (pic "~<<<~>" "a") "<a >"
+ (pic "~<<<<~>" "a") "<a >")
+
+(mtest
+ (pic ">" "a") "a"
+ (pic ">>" "a") " a"
+ (pic ">>>" "a") " a"
+ (pic "~>>~<" "a") ">a<"
+ (pic "~>>>~<" "a") "> a<"
+ (pic "~>>>>~<" "a") "> a<")
+
+(mtest
+ (pic "|" "a") "a"
+ (pic "||" "a") "a "
+ (pic "|||" "a") " a "
+ (pic "||||" "a") " a "
+ (pic "|||||" "a") " a "
+ (pic "|||||" "aaa") " aaa "
+ (pic "|||||" "aaaaa") "aaaaa"
+ (pic "|||||" "aaaaaa") "aaaaaa"
+ (pic "~||~|" "a") "|a|"
+ (pic "~|||~|" "a") "|a |"
+ (pic "~||||~|" "a") "| a |")
+
+(mtest
+ (pic "#" 0) "0"
+ (pic "#" 0.0) "0"
+ (pic "#" 0.1) "0"
+ (pic "#" 0.7) "1"
+ (pic "+#" 0.7) "+1"
+ (pic "-#" -0.7) "-1"
+ (pic "+#" -0.7) "-1"
+ (pic "-#" 0.7) " 1")
+
+(mtest
+ (pic "####" 1234) "1234"
+ (pic "####" 1234.1) "1234"
+ (pic "#" 1) "1"
+ (pic "#.#" 1) "1.0"
+ (pic "######" 1234.1) " 1234"
+ (pic "######.#" 1234.1) " 1234.1"
+ (pic "#######.##" 1234.1) " 1234.10"
+ (pic "#######.##" -1234.1) " -1234.10"
+ (pic "0######.##" 1234.1) "0001234.10"
+ (pic "+######.##" 1234.1) " +1234.10"
+ (pic "-######.##" 1234.1) " 1234.10"
+ (pic "+0#####.##" 1234.1) "+001234.10"
+ (pic "-0#####.##" 1234.1) " 001234.10")
+
+(mtest
+ (pic "#!#" 1234) "#.#"
+ (pic "#!#" 123) "#.#"
+ (pic "#.#" 123) "123.0")
+
+(mtest
+ (pic "-##!#" 12) " 12.0"
+ (pic "+##!#" 12) "+12.0"
+ (pic "-##!#" -123) "###.#"
+ (pic "+##!#" 123) "###.#")
+
+(mtest
+ (pic "###!" 123) "123"
+ (pic "###." 123) "123."
+ (pic "###!" 1234) "###")
+
+(mtest
+ (pic "X##.#Y<<<Z>>>W" 1 2 3) "X 1.0Y2 Z 3W"
+ (pic "~###.#~#<<<~#>>>~#" 1 2 3) "# 1.0#2 # 3#")
+
+(mtest
+ (pic "#,#,#,#" 1234) "1,2,3,4"
+ (pic "#,##,#" 1234) "1,23,4"
+ (pic "##,##" 1234) "12,34"
+ (pic "###," 1234) "1234,"
+ (pic ",###" 1234) ",1234"
+ (pic "##,##" 1234.1) "12,34"
+ (pic "#,###,###.###,###" 1234.1) " 1,234.100,000"
+ (pic "#,###,###.##" -1234.1) " -1,234.10"
+ (pic "0,###,###.##" 1234.1) "0,001,234.10"
+ (pic "+#,##,###.##" 234.1) " +234.10"
+ (pic "+#,##,###.##"
+ 123456.7) "+1,23,456.70"
+ (pic "+#,##,###.##" 1234.1) " +1,234.10"
+ (pic "-#,##,###.##" 1234.1) " 1,234.10"
+ (pic "+0,#####.##" 1234.1) "+0,01234.10"
+ (pic "-0,#####.##" 1234.1) " 0,01234.10")
+
+(mtest
+ (pic "$###,###!##" 234567.89) "$234,567.89"
+ (pic "$###,###!##" 1234567.89) "$###,###.##"
+ (pic "#,#,#!" 123) "1,2,3"
+ (pic "#,#,#!" 1234) "#,#,#")
+
+(mtest
+ (pic "(#,###,###.##)" 123456.56) " 123,456.56 "
+ (pic "(#,###,###.##)" 1234566.56) " 1,234,566.56 "
+ (pic "(#,###,###.##)" 12345667.56) "12,345,667.56 "
+ (pic "(#,###,###.##)" 123456678.56) "123,456,678.56"
+ (pic "(#,###,###.##)" -123456.56) "( 123,456.56)"
+ (pic "(#,###,###.##)" -1234566.56) "(1,234,566.56)"
+ (pic "(#,###,###.##)" -12345667.56) "(12,345,667.56)"
+ (pic "(#,###,###.##)" -123456678.56) "(123,456,678.56)")
+
+(mtest
+ (pic "(0,###,###.##)" 123456.56) " 0,123,456.56 "
+ (pic "(0,###,###.##)" 1234566.56) " 1,234,566.56 "
+ (pic "(0,###,###.##)" 12345667.56) "12,345,667.56 "
+ (pic "(0,###,###.##)" 123456678.56) "123,456,678.56"
+ (pic "(0,###,###.##)" -123456.56) "(0,123,456.56)"
+ (pic "(0,###,###.##)" -1234566.56) "(1,234,566.56)"
+ (pic "(0,###,###.##)" -12345667.56) "(12,345,667.56)"
+ (pic "(0,###,###.##)" -123456678.56) "(123,456,678.56)")
+
+(test
+ (let ((a 2) (b "###") (c 13.5))
+ (pic `abc@(+ a a)###.##@b>>>>` c "x"))
+ "abc4 13.50### x")
+
+(test
+ (pic "+0####.## <<<<<" 123 1)
+ "+00123.00 1 ")
diff --git a/tests/018/getput.tl b/tests/018/getput.tl
new file mode 100644
index 00000000..7e8e2be1
--- /dev/null
+++ b/tests/018/getput.tl
@@ -0,0 +1,33 @@
+(load "../common")
+
+(defvarl file "getput.data")
+
+(push-after-load (remove-path file))
+
+(file-put-objects file '(1 2.3 (a . b) "foo"))
+
+(test
+ (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\""))
+
+(file-append-objects file '(#(nil)))
+
+(mtest
+ (file-get-lines file) ("1" "2.3" "(a . b)" "\"foo\"" "#(nil)")
+ (file-get-objects file) (1 2.3 (a . b) "foo" #(nil)))
+
+(mtest
+ (read-objects "(a . b) #\\c") ((a . b) #\c)
+ (read-objects "(a") :error)
+
+(file-put-string file "(a")
+
+(mtest
+ (file-get file) :error
+ (file-get-objects file) :error)
+
+(let ((errors (with-out-string-stream (err)
+ (ignerr (file-get-objects file : err)))))
+ (mtest
+ (true (contains "syntax error" errors)) t
+ (true (contains "unterminated" errors)) t
+ (true (contains ":1" errors)) t))
diff --git a/tests/018/glob.tl b/tests/018/glob.tl
new file mode 100644
index 00000000..438e4c65
--- /dev/null
+++ b/tests/018/glob.tl
@@ -0,0 +1,142 @@
+(load "../common")
+
+;; Passes on Cygwin, but too slow!
+(if (eq (os-symbol) :cygwin)
+ (exit))
+
+(mtest
+ (sys:brace-expand "~/{Downloads,Pictures}/*.{jpg,gif,png}")
+ #"~/Downloads/*.jpg ~/Downloads/*.gif ~/Downloads/*.png \
+ ~/Pictures/*.jpg ~/Pictures/*.gif ~/Pictures/*.png"
+ (sys:brace-expand "It{{em,alic}iz,erat}e{d,}, please.")
+ ("Itemized, please." "Itemize, please." "Italicized, please."
+ "Italicize, please." "Iterated, please." "Iterate, please.")
+ (sys:brace-expand "{,{,gotta have{ ,\\, again\\, }}more }cowbell!")
+ ("cowbell!" "more cowbell!" "gotta have more cowbell!"
+ "gotta have\\, again\\, more cowbell!")
+ (sys:brace-expand "{}} some }{,{\\\\{ edge, edge} \\,}{ cases, {here} \\\\\\\\\\}")
+ ("{}} some }{,{\\\\ edge \\,}{ cases, {here} \\\\\\\\\\}"
+ "{}} some }{,{\\\\ edge \\,}{ cases, {here} \\\\\\\\\\}"))
+
+(mtest
+ (glob* "tests/**/002") ("tests/002")
+ (glob* "tests/**/{003,004}") ("tests/003" "tests/004"))
+
+(chdir "tests/002/proc")
+
+(mtest
+ (glob* "**")
+ ("1" "1/status" "1/tasks" "103" "103/status" "103/tasks" "1068"
+ "1068/status" "1068/tasks" "1235" "1235/status" "1235/tasks"
+ "1236" "1236/status" "1236/tasks" "15812" "15812/status" "15812/tasks"
+ "16" "16/status" "16/tasks" "1620" "1620/status" "1620/tasks"
+ "1624" "1624/status" "1624/tasks" "16248" "16248/status" "16248/tasks"
+ "16249" "16249/status" "16249/tasks" "1645" "1645/status" "1645/tasks"
+ "16598" "16598/tasks" "1665" "1665/status" "1665/tasks" "1698"
+ "1698/status" "1698/tasks" "17" "17/status" "17/tasks" "175"
+ "175/status" "175/tasks" "1766" "1766/status" "1766/tasks" "1790"
+ "1790/status" "1790/tasks" "1791" "1791/status" "1791/tasks"
+ "1821" "1821/status" "1821/tasks" "1839" "1839/status" "1839/tasks"
+ "1851" "1851/status" "1851/tasks" "186" "186/status" "186/tasks"
+ "18614" "18614/tasks" "1887" "1887/status" "1887/tasks" "1902"
+ "1902/status" "1902/tasks" "1921" "1921/status" "1921/tasks"
+ "1925" "1925/status" "1925/tasks" "1926" "1926/status" "1926/tasks"
+ "1927" "1927/status" "1927/tasks" "1928" "1928/status" "1928/tasks"
+ "1929" "1929/status" "1929/tasks" "1930" "1930/status" "1930/tasks"
+ "1931" "1931/status" "1931/tasks" "1932" "1932/status" "1932/tasks"
+ "1936" "1936/status" "1936/tasks" "1963" "1963/status" "1963/tasks"
+ "1989" "1989/status" "1989/tasks" "2" "2/status" "2/tasks" "2008"
+ "2008/status" "2008/tasks" "2027" "2027/status" "2027/tasks"
+ "2041" "2041/status" "2041/tasks" "2052" "2052/status" "2052/tasks"
+ "2062" "2062/status" "2062/tasks" "2124" "2124/status" "2124/tasks"
+ "2184" "2184/status" "2184/tasks" "2354" "2354/status" "2354/tasks"
+ "24134" "24134/tasks" "2551" "2551/status" "2551/tasks" "2579"
+ "2579/status" "2579/tasks" "2625" "2625/status" "2625/tasks"
+ "2626" "2626/status" "2626/tasks" "2631" "2631/status" "2631/tasks"
+ "2634" "2634/status" "2634/tasks" "2636" "2636/status" "2636/tasks"
+ "2638" "2638/status" "2638/tasks" "2644" "2644/status" "2644/tasks"
+ "2661" "2661/status" "2661/tasks" "2685" "2685/status" "2685/tasks"
+ "2689" "2689/status" "2689/tasks" "2691" "2691/status" "2691/tasks"
+ "2693" "2693/status" "2693/tasks" "2695" "2695/status" "2695/tasks"
+ "2698" "2698/status" "2698/tasks" "2701" "2701/status" "2701/tasks"
+ "2707" "2707/status" "2707/tasks" "27121" "27121/status" "27121/tasks"
+ "2717" "2717/status" "2717/tasks" "2718" "2718/status" "2718/tasks"
+ "2720" "2720/status" "2720/tasks" "2722" "2722/status" "2722/tasks"
+ "27243" "27243/status" "27243/tasks" "2726" "2726/status" "2726/tasks"
+ "2728" "2728/status" "2728/tasks" "27682" "27682/status" "27682/tasks"
+ "27684" "27684/status" "27684/tasks" "27685" "27685/status" "27685/tasks"
+ "28" "28/status" "28/tasks" "29" "29/status" "29/tasks" "29840"
+ "29840/status" "29840/tasks" "3" "3/status" "3/tasks" "30737"
+ "30737/status" "30737/tasks" "31905" "31905/status" "31905/tasks"
+ "31907" "31907/status" "31907/tasks" "31908" "31908/status" "31908/tasks"
+ "32672" "32672/status" "32672/tasks" "32674" "32674/status" "32674/tasks"
+ "32675" "32675/status" "32675/tasks" "4" "4/status" "4/tasks"
+ "5" "5/status" "5/tasks" "870" "870/status" "870/tasks")
+ (glob "**/")
+ ("1/" "103/" "1068/" "1235/" "1236/" "15812/" "16/" "1620/" "1624/"
+ "16248/" "16249/" "1645/" "16598/" "1665/" "1698/" "17/" "175/"
+ "1766/" "1790/" "1791/" "1821/" "1839/" "1851/" "186/" "18614/"
+ "1887/" "1902/" "1921/" "1925/" "1926/" "1927/" "1928/" "1929/"
+ "1930/" "1931/" "1932/" "1936/" "1963/" "1989/" "2/" "2008/"
+ "2027/" "2041/" "2052/" "2062/" "2124/" "2184/" "2354/" "24134/"
+ "2551/" "2579/" "2625/" "2626/" "2631/" "2634/" "2636/" "2638/"
+ "2644/" "2661/" "2685/" "2689/" "2691/" "2693/" "2695/" "2698/"
+ "2701/" "2707/" "27121/" "2717/" "2718/" "2720/" "2722/" "27243/"
+ "2726/" "2728/" "27682/" "27684/" "27685/" "28/" "29/" "29840/"
+ "3/" "30737/" "31905/" "31907/" "31908/" "32672/" "32674/" "32675/"
+ "4/" "5/" "870/"))
+
+(chdir "../..")
+
+(mtest
+ (glob* "**/3*/**")
+ ("002/proc/3/" "002/proc/3/status" "002/proc/3/tasks" "002/proc/30737/"
+ "002/proc/30737/status" "002/proc/30737/tasks" "002/proc/31905/"
+ "002/proc/31905/status" "002/proc/31905/tasks" "002/proc/31907/"
+ "002/proc/31907/status" "002/proc/31907/tasks" "002/proc/31908/"
+ "002/proc/31908/status" "002/proc/31908/tasks" "002/proc/32672/"
+ "002/proc/32672/status" "002/proc/32672/tasks" "002/proc/32674/"
+ "002/proc/32674/status" "002/proc/32674/tasks" "002/proc/32675/"
+ "002/proc/32675/status" "002/proc/32675/tasks")
+ (glob* "**/{3,4,5}*/**")
+ ("002/proc/3/" "002/proc/3/status" "002/proc/3/tasks" "002/proc/30737/"
+ "002/proc/30737/status" "002/proc/30737/tasks" "002/proc/31905/"
+ "002/proc/31905/status" "002/proc/31905/tasks" "002/proc/31907/"
+ "002/proc/31907/status" "002/proc/31907/tasks" "002/proc/31908/"
+ "002/proc/31908/status" "002/proc/31908/tasks" "002/proc/32672/"
+ "002/proc/32672/status" "002/proc/32672/tasks" "002/proc/32674/"
+ "002/proc/32674/status" "002/proc/32674/tasks" "002/proc/32675/"
+ "002/proc/32675/status" "002/proc/32675/tasks" "002/proc/4/"
+ "002/proc/4/status" "002/proc/4/tasks" "002/proc/5/" "002/proc/5/status"
+ "002/proc/5/tasks")
+ (glob* "**/{3,4,5}*/**" glob-xnobrace)
+ nil
+ (len (glob* "**/proc/**/**"))
+ 366)
+
+(if (neq (os-symbol) :solaris)
+ (test
+ (glob* "002/proc\\/**")
+ ("002/proc/1" "002/proc/103" "002/proc/1068" "002/proc/1235" "002/proc/1236"
+ "002/proc/15812" "002/proc/16" "002/proc/1620" "002/proc/1624"
+ "002/proc/16248" "002/proc/16249" "002/proc/1645" "002/proc/16598"
+ "002/proc/1665" "002/proc/1698" "002/proc/17" "002/proc/175"
+ "002/proc/1766" "002/proc/1790" "002/proc/1791" "002/proc/1821"
+ "002/proc/1839" "002/proc/1851" "002/proc/186" "002/proc/18614"
+ "002/proc/1887" "002/proc/1902" "002/proc/1921" "002/proc/1925"
+ "002/proc/1926" "002/proc/1927" "002/proc/1928" "002/proc/1929"
+ "002/proc/1930" "002/proc/1931" "002/proc/1932" "002/proc/1936"
+ "002/proc/1963" "002/proc/1989" "002/proc/2" "002/proc/2008"
+ "002/proc/2027" "002/proc/2041" "002/proc/2052" "002/proc/2062"
+ "002/proc/2124" "002/proc/2184" "002/proc/2354" "002/proc/24134"
+ "002/proc/2551" "002/proc/2579" "002/proc/2625" "002/proc/2626"
+ "002/proc/2631" "002/proc/2634" "002/proc/2636" "002/proc/2638"
+ "002/proc/2644" "002/proc/2661" "002/proc/2685" "002/proc/2689"
+ "002/proc/2691" "002/proc/2693" "002/proc/2695" "002/proc/2698"
+ "002/proc/2701" "002/proc/2707" "002/proc/27121" "002/proc/2717"
+ "002/proc/2718" "002/proc/2720" "002/proc/2722" "002/proc/27243"
+ "002/proc/2726" "002/proc/2728" "002/proc/27682" "002/proc/27684"
+ "002/proc/27685" "002/proc/28" "002/proc/29" "002/proc/29840"
+ "002/proc/3" "002/proc/30737" "002/proc/31905" "002/proc/31907"
+ "002/proc/31908" "002/proc/32672" "002/proc/32674" "002/proc/32675"
+ "002/proc/4" "002/proc/5" "002/proc/870")))
diff --git a/tests/018/gzip.tl b/tests/018/gzip.tl
new file mode 100644
index 00000000..712ade3c
--- /dev/null
+++ b/tests/018/gzip.tl
@@ -0,0 +1,59 @@
+(load "../common")
+
+(if (not (fboundp 'usr:buf-compress))
+ (exit))
+
+(defvarl %have-gzip% (sh "gzip -h > /dev/null 2> /dev/null"))
+
+(defun shchk (cmd)
+ (unless (zerop (sh cmd))
+ (throw `command @cmd failed`)))
+
+(defun gzip (. files)
+ (each ((file files))
+ (file-put-string `@file.gz` (file-get-string file) "z")))
+
+(defun cat (dest . files)
+ (remove-path dest)
+ (each ((file files))
+ (file-append-string dest (file-get-string file))))
+
+(push-after-load
+ (each ((file '#"test-file test-file.gz \
+ test-file-a.tl test-file-a.tlo test-file-a.tlo.gz \
+ test-file-b.tl test-file-b.tlo test-file-b.tlo.gz \
+ test-file-combined.tlo.gz"))
+ (remove-path file)))
+
+(when %have-gzip%
+ (file-put-string "test-file" "Hello, World!")
+ (remove-path "test-file.gz")
+ (cond ((eq (os-symbol) :openbsd)
+ (shchk "gzip -f test-file"))
+ (t (shchk "gzip test-file")))
+ (test (file-get-string "test-file.gz" "z") "Hello, World!")
+
+ (each ((mode (cons "z" (list-seq "z0".."z9"))))
+ (file-put-string "test-file.gz" "Goodbye, World!" mode)
+ (remove-path "test-file")
+ (shchk "gunzip test-file.gz")
+ (test (file-get-string "test-file") "Goodbye, World!"))
+
+ (file-put "test-file-a.tl" '(compile-only (put-line "a")))
+ (file-put "test-file-b.tl" '(compile-only (put-line "b")))
+
+ (compile-update-file "./test-file-a")
+ (compile-update-file "./test-file-b")
+
+ (gzip "test-file-a.tlo" "test-file-b.tlo")
+
+ (cat "test-file-combined.tlo.gz" "test-file-a.tlo.gz" "test-file-b.tlo.gz")
+
+ (test
+ (with-out-string-stream (*stdout*)
+ (load "./test-file-combined.tlo.gz"))
+ "a\nb\n"))
+
+(when %have-gzip%
+ (with-stream (s (open-command "echo abc | gzip -c" "z"))
+ (test (get-line s) "abc")))
diff --git a/tests/018/noclose.expected b/tests/018/noclose.expected
new file mode 100644
index 00000000..cad99e12
--- /dev/null
+++ b/tests/018/noclose.expected
@@ -0,0 +1 @@
+caught
diff --git a/tests/018/noclose.txr b/tests/018/noclose.txr
new file mode 100644
index 00000000..cf39b702
--- /dev/null
+++ b/tests/018/noclose.txr
@@ -0,0 +1,16 @@
+@(next :list [mapcar tostring (range 1 20000)])
+@(collect)
+@num
+@(next self-path)
+@line
+@(end)
+@(try)
+@(next :list [mapcar tostring (range 1 20000)])
+@(collect)
+@num
+@(next "data")
+@line
+@(end)
+@(catch)
+@(do (put-line "caught"))
+@(end)
diff --git a/tests/018/path-equal.tl b/tests/018/path-equal.tl
new file mode 100644
index 00000000..704c414a
--- /dev/null
+++ b/tests/018/path-equal.tl
@@ -0,0 +1,17 @@
+(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)
diff --git a/tests/018/path-safe.tl b/tests/018/path-safe.tl
new file mode 100644
index 00000000..77b92321
--- /dev/null
+++ b/tests/018/path-safe.tl
@@ -0,0 +1,105 @@
+(load "../common")
+
+;; only root can do this test
+(unless (zerop (geteuid))
+ (exit))
+
+(defvarl testdir (mkdtemp `/tmp/txr-path-safe-test`))
+
+(push-after-load (remove-path-rec testdir))
+
+(chmod testdir "a+rX")
+
+(defvarl atestdir (realpath testdir))
+(defvarl tmpdir (path-cat testdir "tmp"))
+
+(mkdir tmpdir)
+(defvarl atmpdir (realpath tmpdir))
+(ensure-dir tmpdir)
+(chmod tmpdir "a+rwt")
+
+(seteuid 10000)
+(touch (path-cat tmpdir "10000"))
+(symlink "/" (path-cat tmpdir "10000-link"))
+(seteuid 0)
+
+(seteuid 20000)
+(touch (path-cat tmpdir "20000"))
+(symlink "/" (path-cat tmpdir "20000-link"))
+(seteuid 0)
+
+(mtest
+ (path-components-safe tmpdir) t
+ (path-components-safe (path-cat tmpdir "10000")) nil
+ (path-components-safe (path-cat tmpdir "10000-link")) nil
+ (path-components-safe (path-cat tmpdir "20000")) nil)
+
+(mtest
+ (path-components-safe atmpdir) t
+ (path-components-safe (path-cat atmpdir "10000")) nil
+ (path-components-safe (path-cat atmpdir "10000-link")) nil
+ (path-components-safe (path-cat atmpdir "20000")) nil)
+
+(seteuid 10000)
+
+(mtest
+ (path-components-safe atmpdir) t
+ (path-components-safe (path-cat tmpdir "10000")) t
+ (path-components-safe (path-cat tmpdir "10000-link")) t
+ (path-components-safe (path-cat tmpdir "20000")) nil
+ (path-components-safe (path-cat tmpdir "20000-link")) nil)
+
+(mtest
+ (path-components-safe atmpdir) t
+ (path-components-safe (path-cat atmpdir "10000")) t
+ (path-components-safe (path-cat atmpdir "10000-link")) t
+ (path-components-safe (path-cat atmpdir "20000")) nil
+ (path-components-safe (path-cat atmpdir "20000-link")) nil)
+
+(symlink "loop/x/y" (path-cat tmpdir "loop"))
+
+(test
+ (path-components-safe (path-cat tmpdir "loop/z")) :error)
+
+(chdir tmpdir)
+(symlink "b/c" "a")
+(ensure-dir "b")
+(symlink "x" "b/c")
+(touch "b/x")
+
+(test
+ (path-components-safe "a") t)
+
+(remove-path "b/c")
+
+(test
+ (path-components-safe "a") :error)
+
+(seteuid 0)
+(seteuid 20000)
+(symlink "x" "z")
+
+(seteuid 0)
+(rename-path "z" "b/c")
+
+(each ((uid '(10000 0)))
+ (mtest
+ (path-components-safe "a") nil
+ (path-components-safe "/proc/1") t
+ (path-components-safe "/proc/1/fd") t
+ (path-components-safe "/proc/sys/../1") t
+ (path-components-safe "/proc/1/cwd") nil
+ (path-components-safe "/proc/1/cwd/foo") nil
+ (path-components-safe "/proc/self/cwd") nil
+ (path-components-safe "/proc/self/cwd/foo") nil
+ (path-components-safe "/proc/1/root") nil
+ (path-components-safe "/proc/1/root/foo") nil
+ (path-components-safe "/proc/1/fd/0") nil
+ (path-components-safe "/proc/1/fd/0/bar") nil
+ (path-components-safe "/proc/1/map_files") nil
+ (path-components-safe "/proc/1/map_files/bar") nil
+ (path-components-safe "/proc/sys/../1/cwd") nil
+ (path-components-safe "/proc/1/task/1") t
+ (path-components-safe "/proc/1/task/1/fd/0") nil
+ (path-components-safe "/proc/1/task/1/cwd") nil
+ (path-components-safe "/proc/1/task/1/root") nil))1
diff --git a/tests/018/path-test.tl b/tests/018/path-test.tl
new file mode 100644
index 00000000..d3aa6dce
--- /dev/null
+++ b/tests/018/path-test.tl
@@ -0,0 +1,22 @@
+(load "../common")
+
+(unless (path-executable-to-me-p "/bin/sh")
+ (exit 0))
+
+(mtest
+ (ends-with "/bin/sh" (path-search "sh")) t
+ (path-search "AlMoStCeRtAiNlLyNoNeXisTenT") nil
+ (path-search "") nil
+ (path-search "sh" nil) nil
+ (path-search "sh" '("AlMoStCeRtAiNlLyNoNeXisTenT")) nil
+ (path-search "sh" '("AlMoStCeRtAiNlLyNoNeXisTenT" "/bin")) "/bin/sh"
+ (path-search "sh" '("/bin")) "/bin/sh"
+ (path-search "sh" "AlMoStCeRtAiNlLyNoNeXisTenT") nil
+ (path-search "sh" "AlMoStCeRtAiNlLyNoNeXisTenT:/bin") "/bin/sh"
+ (path-search "sh" "/bin") "/bin/sh"
+ (path-search "sh" "/bin/") "/bin/sh"
+ (path-search "sh" ":/bin/") "/bin/sh"
+ (path-search "" "/bin") nil
+ (path-search "." "/bin") nil
+ (path-search ".." "/bin") nil
+ (path-search "foo/bar" "/bin") "foo/bar")
diff --git a/tests/018/path.tl b/tests/018/path.tl
new file mode 100644
index 00000000..dd22339f
--- /dev/null
+++ b/tests/018/path.tl
@@ -0,0 +1,320 @@
+(load "../common")
+
+(mtest
+ (short-suffix 42) :error
+ (short-suffix #\a) :error
+ (short-suffix "") nil
+ (short-suffix "" 0) 0
+ (short-suffix "a") nil
+ (short-suffix "a" 0) 0
+ (short-suffix ".") nil
+ (short-suffix "a.") "."
+ (short-suffix "a.b.") "."
+ (short-suffix ".c") nil
+ (short-suffix "a.c") ".c"
+ (short-suffix ".a.c") ".c"
+ (short-suffix "a.b.c") ".c"
+ (short-suffix "foo.txt.gz") ".gz"
+ (short-suffix "txt.gz") ".gz"
+ (short-suffix ".gz") nil)
+
+(mtest
+ (long-suffix 42) :error
+ (long-suffix #\a) :error
+ (long-suffix "") nil
+ (long-suffix "" 0) 0
+ (long-suffix "a") nil
+ (long-suffix "a" 0) 0
+ (long-suffix ".") nil
+ (long-suffix "a.") "."
+ (long-suffix "a.b.") ".b."
+ (long-suffix ".c") nil
+ (long-suffix "a.c") ".c"
+ (long-suffix "a.b.c") ".b.c"
+ (long-suffix "foo.txt.gz") ".txt.gz"
+ (long-suffix ".gz") nil
+ (long-suffix ".txt.gz") ".gz"
+ (long-suffix "/.txt.gz") ".gz"
+ (long-suffix "a/.txt.gz") ".gz"
+ (long-suffix "a/.txt.tar.gz") ".tar.gz")
+
+(mtest
+ (short-suffix "/") nil
+ (short-suffix "a/") nil
+ (short-suffix "/.") nil
+ (short-suffix "a/.") nil
+ (short-suffix ".a/") nil
+ (short-suffix ".a/b") nil
+ (short-suffix ".a/c.b") ".b"
+ (short-suffix ".a/b/") nil
+ (short-suffix ".a/b/.b") nil
+ (short-suffix ".a/b/.b/") nil
+ (short-suffix ".a/b/c.b") ".b"
+ (short-suffix ".a/b/c.b/") ".b"
+ (short-suffix ".a/b/c.b//") ".b"
+ (short-suffix ".a/b/c.b///") ".b"
+ (short-suffix ".a/b/c.") "."
+ (short-suffix ".a/b/c./") "."
+ (short-suffix ".a/b/c.//") "."
+ (short-suffix ".a/b/c.///") ".")
+
+(mtest
+ (long-suffix "/") nil
+ (long-suffix "a/") nil
+ (long-suffix "/.") nil
+ (long-suffix "a/.") nil
+ (long-suffix ".a/") nil
+ (long-suffix ".a/b") nil
+ (long-suffix ".a/b/") nil
+ (long-suffix ".a/b/.b") nil
+ (long-suffix ".a/b/.b/") nil
+ (long-suffix ".a/b/c.b") ".b"
+ (long-suffix ".a/b/c.b/") ".b"
+ (long-suffix "a.b/c.d.e") ".d.e"
+ (long-suffix "a.b/c.d.e/") ".d.e"
+ (long-suffix "a.b/c.d.e/f") nil
+ (long-suffix "a.b/c.d.e/f.g.h") ".g.h"
+ (long-suffix "a.b/c.d.e//") ".d.e"
+ (long-suffix "a.b/c.d.e///") ".d.e"
+ (long-suffix "a.b/c.d.") ".d."
+ (long-suffix "a.b/c.d./") ".d."
+ (long-suffix "a.b/c.d.//") ".d."
+ (long-suffix "a.b/c.d.///") ".d."
+ (long-suffix "a.b/c.") "."
+ (long-suffix "a.b/c./") "."
+ (long-suffix "a.b/c.//") "."
+ (long-suffix "a.b/c.///") ".")
+
+(mtest
+ (trim-short-suffix "") ""
+ (trim-short-suffix ".") "."
+ (trim-short-suffix "/.") "/."
+ (trim-short-suffix ".b") ".b"
+ (trim-short-suffix ".a.b") ".a"
+ (trim-short-suffix ".a.b.c") ".a.b"
+ (trim-short-suffix "/.b") "/.b"
+ (trim-short-suffix "/.b/") "/.b/"
+ (trim-short-suffix "/.b//") "/.b//"
+ (trim-short-suffix "a.b") "a"
+ (trim-short-suffix "/a.b") "/a"
+ (trim-short-suffix "/a.b/") "/a/"
+ (trim-short-suffix "/a.b//") "/a//"
+ (trim-short-suffix "a.") "a"
+ (trim-short-suffix "/a.") "/a"
+ (trim-short-suffix "/a./") "/a/"
+ (trim-short-suffix "/a.//") "/a//")
+
+(mtest
+ (trim-long-suffix "") ""
+ (trim-long-suffix ".") "."
+ (trim-long-suffix "/.") "/."
+ (trim-long-suffix ".b") ".b"
+ (trim-long-suffix ".a.b") ".a"
+ (trim-long-suffix ".a.b.c") ".a"
+ (trim-long-suffix "/.b") "/.b"
+ (trim-long-suffix "/.b/") "/.b/"
+ (trim-long-suffix "/.b//") "/.b//"
+ (trim-long-suffix "a.b") "a"
+ (trim-long-suffix "/a.b") "/a"
+ (trim-long-suffix "/a.b/") "/a/"
+ (trim-long-suffix "/a.b//") "/a//"
+ (trim-long-suffix "/.b.c") "/.b"
+ (trim-long-suffix "/.b.c/") "/.b/"
+ (trim-long-suffix "/.b.c//") "/.b//"
+ (trim-long-suffix "/.b.c.d") "/.b"
+ (trim-long-suffix "/.b.c.d/") "/.b/"
+ (trim-long-suffix "/.b.c.d//") "/.b//"
+ (trim-long-suffix "a.b.c") "a"
+ (trim-long-suffix "/a.b.c") "/a"
+ (trim-long-suffix "/a.b.c/") "/a/"
+ (trim-long-suffix "/a.b.c//") "/a//"
+ (trim-long-suffix "a.") "a"
+ (trim-long-suffix "/a.") "/a"
+ (trim-long-suffix "/a./") "/a/"
+ (trim-long-suffix "/a.//") "/a//")
+
+(mtest
+ (add-suffix "" "") ""
+ (add-suffix "" "a") "a"
+ (add-suffix "." "a") ".a"
+ (add-suffix "." ".a") "..a"
+ (add-suffix "/" ".b") "/.b"
+ (add-suffix "//" ".b") "/.b/"
+ (add-suffix "//" "b") "/b/"
+ (add-suffix "a" "") "a"
+ (add-suffix "a" ".b") "a.b"
+ (add-suffix "a/" ".b") "a.b/"
+ (add-suffix "a//" ".b") "a.b//"
+
+ (add-suffix "c://" "x") "c:/x/"
+ (add-suffix "0://" "x") "0:/x/"
+ (add-suffix "host://" "x") "host://x"
+ (add-suffix "host:///" "x") "host://x/"
+ (add-suffix "1234:///" "x") "1234://x/")
+
+(mtest
+ (base-name "") ""
+ (base-name "/") "/"
+ (base-name ".") "."
+ (base-name "./") "."
+ (base-name "a") "a"
+ (base-name "a/") "a"
+ (base-name "/a") "a"
+ (base-name "/a/") "a"
+ (base-name "/a/b") "b"
+ (base-name "/a/b/") "b"
+ (base-name "/a/b//") "b"
+ (base-name "/a/b///") "b")
+
+(mtest
+ (base-name "" "") ""
+ (base-name "/" "/") "/"
+ (base-name "/" "") "/"
+ (base-name "." ".") "."
+ (base-name "." "") "."
+ (base-name "./" "/") "."
+ (base-name "a" "a") "a"
+ (base-name "a" "") "a"
+ (base-name "a.b" ".b") "a"
+ (base-name "a.b/" ".b") "a"
+ (base-name "a.b/" ".b/") "a.b"
+ (base-name "a.b/" "a.b") "a.b")
+
+(mtest
+ (path-cat "" "") ""
+ (path-cat "" ".") "."
+ (path-cat "." "") "."
+ (path-cat "." ".") "."
+ (path-cat "abc" ".") "abc"
+ (path-cat "." "abc") "abc"
+ (path-cat "./" ".") "./"
+ (path-cat "." "./") "./"
+ (path-cat "abc/" ".") "abc/"
+ (path-cat "./" "abc") "abc"
+ (path-cat "/" ".") "/"
+ (path-cat "/" "abc") "/abc"
+ (path-cat "ab/cd" "ef") "ab/cd/ef"
+ (path-cat "a" "b" "c") "a/b/c"
+ (path-cat "a" "b" "" "c" "/") "a/b/c/")
+
+(mtest
+ (path-cat) "."
+ (path-cat 3) :error
+ (path-cat "") ""
+ (path-cat "/") "/"
+ (path-cat ".") "."
+ (path-cat "" "" "") ""
+ (path-cat "." "" "") "."
+ (path-cat "" "." "") "."
+ (path-cat "" "" ".") "."
+ (path-cat "." "." ".") "."
+ (path-cat "abc/" "/def/" "g") "abc/def/g"
+ (path-cat "abc/" "/def/" "g/") "abc/def/g/"
+ (path-cat "" "abc/" "/def/" "g/") "abc/def/g/")
+
+(mtest
+ (abs-path-p "") nil
+ (abs-path-p "/") t
+ (abs-path-p "/abc") t
+ (abs-path-p "abc") nil
+ (abs-path-p ".") nil)
+
+(if (eql [path-sep-chars 0] #\\)
+ (mtest
+ (abs-path-p "\\abc") t
+ (abs-path-p "a:\\abc") t
+ (abs-path-p "0:\\abc") t
+ (abs-path-p "AB0:\\abc") t
+ (abs-path-p "cd5:\\abc") t
+ (abs-path-p "a:/abc") t
+ (abs-path-p "0:/abc") t
+ (abs-path-p "AB0:/abc") t
+ (abs-path-p "cd5:/abc") t)
+ (mtest
+ (abs-path-p "\\abs") nil
+ (abs-path-p "a:\\abc") nil
+ (abs-path-p "0:\\abc") nil
+ (abs-path-p "AB0:\\abc") nil
+ (abs-path-p "cd5:\\abc") nil
+ (abs-path-p "a:/abc") nil
+ (abs-path-p "0:/abc") nil
+ (abs-path-p "AB0:/abc") nil
+ (abs-path-p "cd5:/abc") nil))
+
+(mtest
+ (portable-abs-path-p "") nil
+ (portable-abs-path-p "/") t
+ (portable-abs-path-p "/abc") t
+ (portable-abs-path-p "\\abc") t
+ (portable-abs-path-p "abc") nil
+ (portable-abs-path-p ".") nil
+ (portable-abs-path-p "\\abc") t
+ (portable-abs-path-p "a:\\abc") t
+ (portable-abs-path-p "0:\\abc") t
+ (portable-abs-path-p "AB0:\\abc") t
+ (portable-abs-path-p "cd5:\\abc") t
+ (portable-abs-path-p "a:/abc") t
+ (portable-abs-path-p "0:/abc") t
+ (portable-abs-path-p "AB0:/abc") t
+ (portable-abs-path-p "cd5:/abc") t)
+
+(mtest
+ (pure-rel-path-p "") t
+ (pure-rel-path-p "/") nil
+ (pure-rel-path-p "\\") nil
+ (pure-rel-path-p "/abc") nil
+ (pure-rel-path-p ".") nil
+ (pure-rel-path-p "./") nil
+ (pure-rel-path-p ".\\") nil
+ (pure-rel-path-p ".abc") t
+ (pure-rel-path-p ".abc/") t
+ (pure-rel-path-p ".abc\\") t
+ (pure-rel-path-p ":") t
+ (pure-rel-path-p "a:") nil
+ (pure-rel-path-p "A:") nil
+ (pure-rel-path-p "0:") nil
+ (pure-rel-path-p "9:") nil
+ (pure-rel-path-p "_:") t
+ (pure-rel-path-p "abc") t
+ (pure-rel-path-p "abc/def") t
+ (pure-rel-path-p "abc/.") t
+ (pure-rel-path-p "abc\\def") t
+ (pure-rel-path-p "abc\\.") t)
+
+(mtest
+ (trim-path-seps "") ""
+ (trim-path-seps "/") "/"
+ (trim-path-seps "//") "/"
+ (trim-path-seps "///") "/"
+ (trim-path-seps "a///") "a"
+ (trim-path-seps "/a///") "/a")
+
+(mtest
+ (trim-path-seps "c:/") "c:/"
+ (trim-path-seps "c://") "c:/"
+ (trim-path-seps "c:///") "c:/"
+ (trim-path-seps "c:a///") "c:a"
+ (trim-path-seps "/c:/a///") "/c:/a"
+ (trim-path-seps "/c://///") "/c:")
+
+(mtest
+ (trim-path-seps "\\") "\\"
+ (trim-path-seps "\\\\") "\\"
+ (trim-path-seps "\\\\\\") "\\"
+ (trim-path-seps "a\\\\\\") "a"
+ (trim-path-seps "\\a\\\\\\") "\\a")
+
+(mtest
+ (trim-path-seps "c:\\") "c:\\"
+ (trim-path-seps "c:\\\\") "c:\\"
+ (trim-path-seps "c:\\\\\\") "c:\\"
+ (trim-path-seps "c:a\\\\\\") "c:a"
+ (trim-path-seps "\\c:\\a\\\\\\") "\\c:\\a"
+ (trim-path-seps "\\c:\\\\\\\\\\") "\\c:")
+
+(mtest
+ (trim-path-seps "/c:\\") "/c:"
+ (trim-path-seps "c:/\\/\\/") "c:/"
+ (trim-path-seps "c:a\\\\\\") "c:a"
+ (trim-path-seps "\\c:\\a/\\\\\\") "\\c:\\a"
+ (trim-path-seps "/c:\\\\\\\\\\") "/c:")
diff --git a/tests/018/process.tl b/tests/018/process.tl
new file mode 100644
index 00000000..58a12fa2
--- /dev/null
+++ b/tests/018/process.tl
@@ -0,0 +1,36 @@
+(load "../common")
+
+(unless (path-executable-to-me-p "/bin/sh")
+ (exit 0))
+
+(defun cmd (c : (m "r"))
+ (with-stream (s (open-command c m))
+ (get-string s)))
+
+(mtest
+ (cmd "echo foo") "foo\n"
+ (cmd "echo foo" ">1n") ""
+ (cmd "echo foo 1>&2" ">21") "foo\n")
+
+(defmacro fcmd (. forms)
+ ^(with-stream (s (open-subprocess nil "r" nil (lambda () ,*forms)))
+ (get-string s)))
+
+(mtest
+ (fcmd (let ((*stdout* *stdnull*)) (sh "echo foo"))) ""
+ (fcmd (let ((*stderr* *stdout*)) (sh "echo foo 1>&2"))) "foo\n")
+
+(caseq (os-symbol)
+ ((:cygwin :cygnal))
+ (t (mtest
+ (let ((*child-env* '("a=b")))
+ (get-lines (open-process "/usr/bin/env" "r")))
+ ("a=b")
+ (let ((*child-env* nil))
+ (get-lines (open-process "/usr/bin/env" "r")))
+ nil)
+ (test
+ (fcmd
+ (let ((*child-env* '("a=b")))
+ (run "/usr/bin/env")))
+ "a=b\n")))
diff --git a/tests/018/rel-path.tl b/tests/018/rel-path.tl
new file mode 100644
index 00000000..11651c17
--- /dev/null
+++ b/tests/018/rel-path.tl
@@ -0,0 +1,25 @@
+(load "../common")
+
+(mtest
+ (rel-path "/abc" "abc") :error
+ (rel-path "abc" "/abc") :error
+ (rel-path "." ".") "."
+ (rel-path "./abc" "abc") "."
+ (rel-path "abc" "./abc") "."
+ (rel-path "./abc" "./abc") "."
+ (rel-path "abc" "abc") "."
+ (rel-path "." "abc") "abc"
+ (rel-path "abc/def" "abc/ghi") "../ghi"
+ (rel-path "xyz/../abc/def" "abc/ghi") "../ghi"
+ (rel-path "abc" "d/e/f/g/h") "../d/e/f/g/h"
+ (rel-path "abc" "d/e/../g/h") "../d/g/h"
+ (rel-path "d/e/../g/h" ".") "../../.."
+ (rel-path "d/e/../g/h" "a/b") "../../../a/b"
+ (rel-path "x" "../../../y") "../../../../y"
+ (rel-path "x///" "x") "."
+ (rel-path "x" "x///") "."
+ (rel-path "///x" "/x") "."
+ (rel-path "../../x" "y") :error
+ (rel-path "" "") "."
+ (rel-path "a" "") ".."
+ (rel-path "" "a") "a")
diff --git a/tests/018/sh-esc.tl b/tests/018/sh-esc.tl
new file mode 100644
index 00000000..f508475e
--- /dev/null
+++ b/tests/018/sh-esc.tl
@@ -0,0 +1,58 @@
+(load "../common")
+
+(mtest
+ (sh-esc "") ""
+ (sh-esc "a") "a")
+
+(mtest
+ (sh-esc "|") "\"|\""
+ (sh-esc "&") "\"&\""
+ (sh-esc ";") "\";\""
+ (sh-esc "<") "\"<\""
+ (sh-esc ">") "\">\""
+ (sh-esc "(") "\"(\""
+ (sh-esc ")") "\")\""
+ (sh-esc " ") "\" \""
+ (sh-esc "\t") "\"\t\""
+ (sh-esc "\n") "\"\n\""
+ (sh-esc "*") "\"*\""
+ (sh-esc "?") "\"?\""
+ (sh-esc "[") "\"[\""
+ (sh-esc "#") "\"#\""
+ (sh-esc "~") "\"~\"")
+
+(mtest
+ (sh-esc "'") "\"'\"")
+
+(mtest
+ (sh-esc "\"") "'\"'"
+ (sh-esc "$") "'$'"
+ (sh-esc "`") "'`'"
+ (sh-esc "\\") "'\\'")
+
+(mtest
+ (sh-esc "=") "="
+ (sh-esc "%") "%"
+ (sh-esc-all "=") "\"=\""
+ (sh-esc-all "%") "\"%\"")
+
+(test
+ (sh-esc "a\"b'c") "'a\"b'\\''c'")
+
+(mtest
+ (sh-esc "|'") "\"|'\""
+ (sh-esc "|\"") "'|\"'"
+ (sh-esc "'$") "''\\''$'")
+
+(mtest
+ (sh-esc-all "|=") "\"|=\""
+ (sh-esc-all "'=") "\"'=\""
+ (sh-esc-all "\"=") "'\"='")
+
+(mtest
+ (sh-esc "|&;<>() \t\n*?[#~") "\"|&;<>() \t\n*?[#~\""
+ (sh-esc "\"$`\\") "'\"$`\\'")
+
+(mtest
+ (sh-esc-dq "$`\\\"\n'abc()*~") "\\$\\`\\\\\\\"\n'abc()*~"
+ (sh-esc-sq "$`\\\"\n'abc()*~") "$`\\\"\n'\\''abc()*~")
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-18 13:45:26 +0000