diff options
| -rw-r--r-- | share/txr/stdlib/pic.tl | 18 | ||||
| -rw-r--r-- | tests/018/format.tl | 88 |
2 files changed, 98 insertions, 8 deletions
diff --git a/share/txr/stdlib/pic.tl b/share/txr/stdlib/pic.tl index 1c28e0df..25a9c70b 100644 --- a/share/txr/stdlib/pic.tl +++ b/share/txr/stdlib/pic.tl @@ -34,7 +34,7 @@ (dot (or exc (pos #\. fmt))) (int (if dot [fmt 0..dot] fmt)) (fra (if dot [fmt (succ dot)..:] ""))) - (let ((code (if (or minus plus) + (let ((code (if (or minus plus (not zero)) ^(fmt ,`~@(len fmt),@(if plus "+")@(if zero "0")@(len fra)f` ,val) (with-gensyms (vg) @@ -42,7 +42,7 @@ (if (minusp ,vg) (fmt ,`~@(len fmt),@(if zero "0")@(len fra)f` ,vg) - (rest (fmt ,`~@(succ (len fmt)),@(if zero "0")@(len fra)f` + (rest (fmt ,`~@(succ (len fmt)),+@(if zero "0")@(len fra)f` ,vg)))))))) (if exc (with-gensyms (str) @@ -65,7 +65,7 @@ ((join (fmt `@fmt1` . @args1) (fmt `@fmt2` . @args2) . @rest) (pic-join-opt ^(join (fmt ,`@fmt1@fmt2` ,*args1 ,*args2) ,*rest))) ((join @(stringp @s1) @(stringp @s2) . @rest) - (pic-join-opt ^(join ,`@s1@s1` ,rest))) + (pic-join-opt ^(join ,`@s1@s2` ,*rest))) ((join "" @item . @rest) (pic-join-opt ^(join ,item ,*rest))) ((join @item "" . @rest) @@ -77,7 +77,9 @@ (unless (stringp fmt) (compile-error f "~s is required to be a format string" fmt)) (cond - ([m^$ #/\~[~#<>\|\-+0.!]/ fmt] [fmt 1]) + ([m^$ #/\~[~#<>\|\-+0.!]/ fmt] [fmt 1..2]) + ([m^$ #/\~./ fmt] (compile-error f "unrecognized escape sequence ~a" fmt)) + ([m^$ #/\~/ fmt] (compile-error f "incomplete ~~ escape")) ([m^$ #/[+\-]?0?#+([.!]#+)?/ fmt] (expand-pic-num fmt val)) ([m^$ #/<+/ fmt] (expand-pic-align "<" fmt val)) ([m^$ #/>+/ fmt] (expand-pic-align nil fmt val)) @@ -91,16 +93,16 @@ <+| \ >+| \ \|+| \ - \~[~#<>\|\-+0.!]/) + \~.|\~/) (items (collect-each ((piece (tok regex t bigfmt))) (cond ((m^$ regex piece) (cond ((starts-with "~" piece) (expand-pic f piece nil)) - (t (unless args - (compile-error f "insufficient arguments for format")) - (expand-pic f piece (pop args))))) + (args + (expand-pic f piece (pop args))) + (t (compile-error f "insufficient arguments for format")))) (t piece))))) (if args (compile-warning f "excess arguments")) diff --git a/tests/018/format.tl b/tests/018/format.tl index 3e9e4f5b..d1038c30 100644 --- a/tests/018/format.tl +++ b/tests/018/format.tl @@ -27,3 +27,91 @@ (test (fmt "~x" (sha256 "abc")) "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad") + +(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 "X##.#Y<<<Z>>>W" 1 2 3) "X 1.0Y2 Z 3W" + (pic "~###.#~#<<<~#>>>~#" 1 2 3) "# 1.0#2 # 3#") + +(test (mapcar (do pic "foo~-0##.jpg") (rlist 0..5 8 12)) + ("foo-000.jpg" "foo-001.jpg" "foo-002.jpg" "foo-003.jpg" + "foo-004.jpg" "foo-005.jpg" "foo-008.jpg" "foo-012.jpg")) |