diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-06-11 07:23:12 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-06-11 07:23:12 -0700 |
| commit | fe4652d2925bd7a2296a6c527c49bd047f78febc (patch) | |
| tree | b0f140ab230d119609525a43518636cfa078fcbf /share | |
| parent | e781c2a91c245bbbc3607b6b16498d99f14ea36b (diff) | |
| download | txr-fe4652d2925bd7a2296a6c527c49bd047f78febc.tar.gz txr-fe4652d2925bd7a2296a6c527c49bd047f78febc.tar.bz2 txr-fe4652d2925bd7a2296a6c527c49bd047f78febc.zip | |
pic: test cases and fixes.
* share/txr/stdlib/pic.tl (expand-pic-num): Bug: when a field
overflows, the (rest ...) call truncates the leftmost digit.
A failing test case is (pic "#.#" 12) which produces "2.0"
instead of "12.0". Firstly, we only need that logic at all in
the zero padding case. When the number is positive, we stick
in the + request, so we are sure to get a + character. The
rest call then predictably chops off the + rather than a
digit.
(pic-join-opt): Fix two bugs here in the string-string combine
case: using s2 instead of s1, and not splicing in rest.
(expand-pic, pic): Implement tightening for escape sequences.
If ~ is not followed by anything, or not followed by the
documented characters for escaping, it is erroneous.
* format.tl: Battery of new tests.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/pic.tl | 18 |
1 files changed, 10 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")) |