This repository has been archived on 2022-08-10. You can view files and clone it, but cannot push or open issues or pull requests.
chez-openbsd/mats/format.ms

1727 lines
76 KiB
Scheme
Raw Normal View History

2022-07-29 15:12:07 +02:00
;;; format.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
; need some for printf and fprintf
; need some when string is not known at compile time
; need some when number of args is not known at compile time, e.g.,
; (apply format "hi ~s" args)
; construct testing mechanism that gives us all of these from a
; single set of directives
; need some tabulate tests
(mat format-errors
(error? (format "hi ~s"))
(error? (format "hi ~s" 'a 'b))
(error? (format "hi ~"))
(error? (format "hi ~23"))
(error? (format "hi ~23@"))
(error? (format "hi ~@"))
(error? (format 7 "hi ~@"))
(error? (format "~@%"))
(error? (format "~@c%"))
(error? (format "~c" 3))
(error? (format "~@~"))
(error? (format "~@@s"))
(error? (format "~@3"))
(error? (format "~q"))
(error? (format "~,,,-3:d" (expt 2 100)))
(error? (format "~,,-3,3e" -3.14159))
(error? (printf 'hello "there"))
(error? (fprintf 'not-a-port "~a ~s" 17 34))
(error? (format 'not-a-string-port-or-boolean "~a ~s" 17 34))
(error? (format "bad~\rdirective"))
(error? (printf "~a~:*"))
)
(mat format-continuation ; like slib tests, but with \r\n for DOS
(equal? (format "abc~\r\n 123") "abc123")
(equal? (format "abc~\r\n ") "abc")
(equal? (format "abc~:\r\n def") "abc def")
(equal? (format "abc~@\r\n def") "abc\ndef")
)
(mat format-plain
(equal? (format "") "")
(equal? (format "a") "a")
(equal? (format "ab") "ab")
(equal? (format "ab~%cd") "ab\ncd")
(equal? (format "ab\ncd") "ab\ncd")
(equal? (format "a\nb\ncc\nddd\neeee") "a\nb\ncc\nddd\neeee")
(equal? (format "a~&b~%cc~&ddd~%eeee") "a\nb\ncc\nddd\neeee")
(equal? (format "a\nb\ncc\nddd\neeee\n") "a\nb\ncc\nddd\neeee\n")
(equal? (format "a~%b~&cc~%ddd~&eeee\n") "a\nb\ncc\nddd\neeee\n")
(equal? (format "\na\nb\ncc\nddd\neeee") "\na\nb\ncc\nddd\neeee")
(equal? (format "~%a~&b~%cc~&ddd~%eeee") "\na\nb\ncc\nddd\neeee")
(equal? (format "\na\nb\ncc\nddd\neeee\n") "\na\nb\ncc\nddd\neeee\n")
(equal? (format "~%a~%b~&cc~%ddd~&eeee\n") "\na\nb\ncc\nddd\neeee\n")
)
(mat format-object
(equal? (format "hi ~s" "a") "hi \"a\"")
(equal? (format "hi ~10s" "a") "hi \"a\" ")
(equal? (format "hi ~10@s" "a") "hi \"a\"")
(equal? (format "~10,3,2,'$@s" 345) "$$$$$$$$345")
(equal? (format "~10,3,2,'$@s" 3456) "$$$$$$$$3456")
(equal? (format "~10,3,2,'$@s" 34567) "$$$$$34567")
(equal? (format "~10,3,2,'$@s" 345678) "$$$$$345678")
(equal? (format "~10,3,2,'$@s" 3456789) "$$$$$3456789")
(equal? (format "~10,3,2,'$@s" 34567890) "$$34567890")
(equal? (format "~10,3,2,'$@s" 345678901) "$$345678901")
(equal? (format "~10,3,2,'$@s" 3456789012) "$$3456789012")
(equal? (format "~7,,4,a~3%~10,3,,'#@s" "hello" 345)
"hello \n\n\n#########345")
(equal? (format "~:s" '#{g0 ymnnefx976kvhp9-a}) "g0")
(equal? (format "~s" '#{g0 ymnnefx976kvhp9-a}) "#{g0 ymnnefx976kvhp9-a}")
(equal? (format "~,,2@s" 345678901) " 345678901")
(equal? (format "~,,2s" 345678901) "345678901 ")
)
(mat format-char
(equal? (format "~c" #\a) "a")
(equal? (format "~c" #\space) " ")
(equal? (format "~:c" #\a) "a")
(equal? (format "~:c" #\space) "<space>")
(equal? (format "~:c" #\034) "^\\")
(equal? (format "~:c" #\003) "^C")
(equal? (format "~@c" #\a) "#\\a")
(equal? (format "~@c" #\space) "#\\space")
(equal? (format "~:@c" #\a) "a")
(equal? (format "~:@c" #\space) "<space>")
(equal? (format "~:@c" #\034) "^\\")
(equal? (format "~:@c" #\003) "^C")
(equal? (format "~@:c" #\a) "a")
(equal? (format "~@:c" #\space) "<space>")
(equal? (format "~@:c" #\034) "^\\")
(equal? (format "~@:c" #\003) "^C")
)
(mat format-plural
(error? (format "abc~:p" 1))
(error? (format "abc~:p"))
(error? (format "abc~:@p"))
(error? (format "abc~:p~s" 2))
(error? (format "abc~:@p~s" 2))
(equal? (format "~s abc~:p" 1) "1 abc")
(equal? (format "~s abc~:p" 2) "2 abcs")
(equal? (format "~s abc~:p" 1.0) "1.0 abcs")
(equal? (format "~s abc~:p" 'one) "one abcs")
(equal? (format "abc~p" 1) "abc")
(equal? (format "abc~p" 2) "abcs")
(equal? (format "abc~p" 'kumquat) "abcs")
(equal? (format "abc~@p" 1) "abcy")
(equal? (format "abc~@p" 'kumquat) "abcies")
(equal? (format "~s~@:p" 1) "1y")
(equal? (format "~s~@:p" 2) "2ies")
)
(mat format-convert-case
(error? (format "~23:(abc)"))
(error? (format "~,:(abc)"))
(error? (format "~(abc"#|)|#))
(error? (format "~:(abc)"))
(error? (format #|(|#"abc~)"))
(error? (format "~(~r ~(~a~)~) ~:@(~a)" 1621 "piNK" "bLuE"))
(equal? (format "~(AbC 123A DEF g~)") "abc 123a def g")
(equal? (format "~:(AbC 123A DEF g~)") "Abc 123a Def G")
(equal? (format "~@(AbC 123A DEF g~)") "Abc 123a def g")
(equal? (format "~:@(AbC 123A DEF g~)") "ABC 123A DEF G")
(equal? (format "~@:(AbC 123A DEF g~)") "ABC 123A DEF G")
(equal? (format "~@:(~r ~a~) ~a" 1621 "piNK" "bLuE")
"SIXTEEN HUNDRED TWENTY-ONE PINK bLuE")
(equal? (format "~:@(~r ~a~) ~a" 1621 "piNK" "bLuE")
"SIXTEEN HUNDRED TWENTY-ONE PINK bLuE")
(equal? (format "~@(~r ~a~) ~a" 1621 "piNK" "bLuE")
"Sixteen hundred twenty-one pink bLuE")
(equal? (format "~:(~r ~a~) ~a" 1621 "piNK" "bLuE")
"Sixteen Hundred Twenty-One Pink bLuE")
(equal? (format "~(~r ~a~) ~a" 1621 "piNK" "bLuE")
"sixteen hundred twenty-one pink bLuE")
(equal? (format "~(~r ~(~a~)~) ~a" 1621 "piNK" "bLuE")
"sixteen hundred twenty-one pink bLuE")
(equal? (format "~(~r ~(~a~)~) ~:@(~a~)" 1621 "piNK" "bLuE")
"sixteen hundred twenty-one pink BLUE")
; cltl2 tests
(equal? (format "~@R ~(~@R~)" 14 14) "XIV xiv")
(begin
(define $f (lambda (n) (format "~@(~R~) error~:P detected." n)))
(procedure? $f))
(equal? ($f 0) "Zero errors detected.")
(equal? ($f 1) "One error detected.")
(equal? ($f 23) "Twenty-three errors detected.")
)
(mat format-indirect
(error? (format "~?" 3))
(error? (format "~@?" 3))
(error? (format "~?" "abc"))
(error? (format "~?" "~a" 4))
(error? (format "~?" "~a" '()))
; (error? (format "~@?" "abc" '())) ; too many args
(error? (format "~@?" "~(abc"#|)|#))
(error? (format "~@?" "~:?"))
(equal? (format "==> ~? <==" "~a" '(5)) "==> 5 <==")
(equal? (format "<~@?>" "abc") "<abc>")
(equal? (format "~:(<~@?>~)" "abc") "<Abc>")
(equal? (format "<~@?>" "~:@(abc~)") "<ABC>")
(equal? (format "<~@?>" "~r ~a" 101 "dalmations")
"<one hundred one dalmations>")
(equal? (format "<~?~a>" "~r ~a" '(101 "dalmations") "!!!")
"<one hundred one dalmations!!!>")
(equal? (format "<~?>" "[~?]" '("(~?)" ("~a" (3)))) "<[(3)]>")
(equal? (format "<~@?>" "[~@?]" "(~@?)" "~a" 3) "<[(3)]>")
(error? (format "<~@?>" "[~@?]" "(~@?)" "~a"))
; (error? (format "<~@?>" "[~@?]" "(~@?)" "~a" 3 4)) ; too many args
; (error? (format "<~?>" "[~?]" '("(~?)" ("~a" (3 4))))) ; too many args
; (error? (format "<~?>" "[~?]" '("(~?)" ("~a" (3) 4)))) ; too many args
; cltl2 tests
(equal? (format "~? ~d" "<~a ~d>" '("Foo" 5) 7) "<Foo 5> 7")
; cltl2 doesn't want us to complain about too many arguments
(equal? (format "~? ~d" "<~a ~d>" '("Foo" 5 14) 7) "<Foo 5> 7")
(equal? (format "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7")
(equal? (format "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14")
(begin
(define (format-error ctl-index ctl-string string . args)
(format "~?~%~v@tv~%~3@t\"~a\"~%"
string args (+ ctl-index 3) ctl-string))
(procedure? format-error))
(equal? (format-error 16 "The item is a ~[Foo~;Bar~;Loser~]."
"ERROR: The argument to the format ~s command must be a number."
"~[")
"ERROR: The argument to the format \"~[\" command must be a number.\n v\n \"The item is a ~[Foo~;Bar~;Loser~].\"\n")
)
(mat format-conditional/at
(error? (format "~@[abc~;def~]"))
(error? (format "~@[abc]"))
(error? (format #|(|# "~@[abc~)"))
(equal? (format "<~@[[in ~s]~]>" #f) "<>")
(equal? (format "<~@[[in ~s]~]>" 'foo) "<[in foo]>")
; (error? (format "<~@[[hey!]~]>" 'foo)) ; too many args
(equal? (format "<~@[~]> ~s" #t) "<> #t")
(error? (format "<~@[~]> ~s" #f))
)
(mat format-conditional/colon
(error? (format "~:[abc~:;def~]"))
(error? (format "~:[abc]"))
(error? (format #|(|# "~:[abc~)"))
(equal? (format "<~:[abc~;def~]>" #f) "<abc>")
(equal? (format "<~:[abc~;def~]>" #t) "<def>")
(error? (format "<~:[abc~;def~;ghi~]>"))
(equal? (format "<~:[abc~;~a~]>" #f) "<abc>")
(equal? (format "<~:[abc~;~a~]>" #t 'yow!) "<yow!>")
(equal? (format "<~:[abc~;~:*~a~]>" #t) "<#t>")
(error? (format "<~:[abc~;~a~]>" #t))
(error? (format "<~:[abc~]>" #f))
)
(mat format-conditional
(error? (format "~[abc~:;def~;ghi~]"))
(error? (format "~[abc]"))
(error? (format #|(|# "~[abc~)"))
(equal? (format "<~[abc~;def~]>" 0) "<abc>")
(equal? (format "<~[abc~;def~]>" 1) "<def>")
(equal? (format "<~[abc~;def~]>" -15) "<>")
(equal? (format "<~[abc~;def~:;ghi~]>" 0) "<abc>")
(equal? (format "<~[abc~;def~:;ghi~]>" 1) "<def>")
(equal? (format "<~[abc~;def~:;ghi~]>" 2) "<ghi>")
(equal? (format "<~[abc~;def~:;ghi~]>" 'huh?) "<ghi>")
(equal? (format "+++~[~s~;~r ~s~]---" 52) "+++---")
; (error? (format "+++~[~s~;~r ~s~]---" 52 23)) ; too many args
; (error? (format "+++~[~s~;~@r~s~]---" 52 23 '*)) ; too many args
(equal? (format "+++~[~s~;~r ~s~]---" 0 23) "+++23---")
(error? (format "+++~[~s~;~r ~s~]---" 0))
(equal? (format "+++~[~s~;~@r~s~]---" 1 23 '*) "+++XXIII*---")
(error? (format "+++~[~s~;~@r~s~]---" 1 23))
(equal? (format "+++~[~]---" 1) "+++---")
)
(mat format-tabulate
(error? (format "~-7t***"))
(error? (format "~8,'xt"))
(error? (format "~8,-3t"))
(error? (format "~8,5,4t"))
(error? (format "~-7@t***"))
(error? (format "~8,'x@t"))
(error? (format "~8,-3@t"))
(error? (format "~8,5,4@t"))
(equal? (format "~t***") " ***")
(equal? (format "x~t***") "x ***")
(equal? (format "~,3t***") " ***")
(equal? (format "xxxx~,3t***") "xxxx ***")
(equal? (format "xxxx~1,3t***") "xxxx ***")
(equal? (format "~0t***") " ***")
(equal? (format "~1t***") " ***")
(equal? (format "~2t***") " ***")
(equal? (format "~7t***") " ***")
(equal? (format "~0,0t***") "***")
(equal? (format "~1,0t***") " ***")
(equal? (format "~2,0t***") " ***")
(equal? (format "~7,0t***") " ***")
(equal? (format "~0,8t***") " ***")
(equal? (format "~1,8t***") " ***")
(equal? (format "~2,8t***") " ***")
(equal? (format "~7,8t***") " ***")
(equal? (format "~8,8t***") " ***")
(equal? (format "~9,8t***") " ***")
(equal? (format "x~0t***") "x ***")
(equal? (format "x~1t***") "x ***")
(equal? (format "x~2t***") "x ***")
(equal? (format "x~7t***") "x ***")
(equal? (format "x~0,0t***") "x***")
(equal? (format "x~1,0t***") "x***")
(equal? (format "x~2,0t***") "x ***")
(equal? (format "x~7,0t***") "x ***")
(equal? (format "x~0,8t***") "x ***")
(equal? (format "x~1,8t***") "x ***")
(equal? (format "x~2,8t***") "x ***")
(equal? (format "x~7,8t***") "x ***")
(equal? (format "x~8,8t***") "x ***")
(equal? (format "x~9,8t***") "x ***")
(equal? (format "xxx~7,0@tyyy") "xxx yyy")
(equal? (format "xxx~7,1@tyyy") "xxx yyy")
(equal? (format "xxx~7,8@tyyy") "xxx yyy")
)
(mat format-justify
(equal? (format "~<ab~^c~>") "") ; not checking to make sure ~^ is at front of segment
(equal? (format "~<abc~>") "abc")
(equal? (format "~:@<abc~>") "abc")
(equal? (format "~,,1,'*:@<abc~>") "*abc*")
(equal? (format "~10<abc~>") " abc")
(equal? (format "~10:<abc~>") " abc")
(equal? (format "~10@<abc~>") "abc ")
(equal? (format "~10:@<abc~>") " abc ")
(equal? (format "~,8<abc~>") " abc")
(equal? (format "~,8<abc~;def~;ghi~>") "abc def ghi")
(equal? (format "~7,8<abc~;def~;ghi~>") "abc def ghi")
(equal? (format "~7,8:<abc~;def~;ghi~>") " abc def ghi")
(equal? (format "~7,8@<abc~;def~;ghi~>") "abc def ghi ")
(equal? (format "~7,8:@<abc~;def~;ghi~>") " abc def ghi ")
(equal? (format "~&~7,8:@<abc~;def~;ghi~>~&~&") " abc def ghi \n")
(equal? (format "~7,8,5,'*<abc~;def~;ghi~>") "abc*******def*******ghi")
(equal? (format "~5,8,4,'*:@<abc~;def~;ghi~>")
"*****abc*****def*****ghi*****")
(equal? (format "~1,8,4,'*:@<abc~;def~;ghi~>")
"****abc****def****ghi****")
(equal? (format "~,,4,'*:@<abc~;def~;ghi~>")
"****abc****def****ghi****")
(equal? (format "~7,8,5,'*<~%~,10:;abc~;def~;ghi~>")
"\nabc*******def*******ghi")
(equal? (format "~7,8,5,'*<~&~,10:;abc~;def~;ghi~>")
"abc*******def*******ghi")
(equal? (format "~7,8,5,'*<~%~,25:;abc~;def~;ghi~>")
"abc*******def*******ghi")
(equal? (format "~7,8,5,'*<~%~2,25:;abc~;def~;ghi~>")
"abc*******def*******ghi")
(equal? (format "~7,8,5,'*<~%~3,25:;abc~;def~;ghi~>")
"\nabc*******def*******ghi")
(equal? (format "~7,8,5,'*<~%~:;abc~;def~;ghi~>")
"abc*******def*******ghi")
(equal? (format "~72,,,'-<~%~:;abc~;def~;ghi~>")
"abc--------------------------------def-------------------------------ghi")
(equal? (format "~73,,,'-<~%~:;abc~;def~;ghi~>")
"\nabc--------------------------------def--------------------------------ghi")
(equal? (format "~73,,,'-:@<~%~:;abc~;def~;ghi~>")
"\n----------------abc----------------def----------------ghi----------------")
(equal? (format "~10<~^~a~;~^~a~>" "abc" "def") "abc def")
(equal? (format "~10<~^~a~;~^~a~>" "abc") " abc")
(equal? (format "~10<~^~a~;~^~a~>") " ")
(equal? (format "~10<~^~a~,9:;~a~;~a~>" "\n" "1" "2") "\n1 2")
(equal? (format "~10<~^~a~,9:;~a~;~a~>") " ")
(equal? (format "~10<~^~a~,9:;~a~;~^~a~>" "\n" "1" "2") "\n1 2")
(equal? (format "~10<~^~a~,9:;~a~;~^~a~;~a~>" "\n" "1" "2" "3")
"\n1 2 3")
(error? (format "~10<~^~a~,9:;~a~;~^~a~;~a~>" "\n" "1" "2"))
(equal? (format "~10<~^~a~,9:;~a~;~^~a~;~a~>" "\n" "1") "\n 1")
(error? (format "~10<~^~a~,9:;~a~;~^~a~;~a~>" "\n"))
(equal? (format "~10<~^~a~,9:;~a~;~^~a~;~a~>") " ")
(error? (format "~10<~^~a~,9:;~a~;~a~:^~;~a~>" "\n"))
(error? (format "~10<~^~a~,9:;~a~;~^~^~a~;~a~>" "\n"))
(error? (format "~10<~^~a~,9:;~a~;~a~@^~;~a~>" "\n" "1"))
(error? (format "~10<~(abc~>def~)"))
(equal? (format "~10<~@:(abc~)~;~@(def~)~>") "ABC Def")
(equal? (format "~(~10<~a~;~x~>~)" "PiEs" 221) "pies dd")
(equal? (format "~13<~s~;~s~;~s~>" 3.4 4.5 5.6) "3.4 4.5 5.6")
(equal? (format "~16<~f~;~e~;~g~>" 3.4 4.5 5.6) "3.4 4.5e+0 5.6")
; test nested ~<...~>
(equal? (format "~20<abc~;d~5<e~;f~>g~>") "abc de fg")
; from cltl2:
(equal? (format "~10<foo~;bar~>") "foo bar")
(equal? (format "~10:<foo~;bar~>") " foo bar")
(equal? (format "~10<foobar~>") " foobar")
(equal? (format "~10:<foobar~>") " foobar")
(equal? (format "~10:@<foo~;bar~>") " foo bar ")
(equal? (format "~10@<foobar~>") "foobar ")
(equal? (format "~10:@<foobar~>") " foobar ")
(equal? (format "~%;; ~{~<~%;; ~1:; ~s~>~^,~}.~%" '(a b c))
"\n;; a, b, c.\n")
(equal? (format "~%;; ~{~<~%;; ~1:; ~s~>~^,~}.~%"
'(list-procedure stack $system-environment $active-threads
#{source yqrk281einmw7sg-a} $c-info placeholder
make-record-type join-subst trace-let set-top-level-value!
integer? error result make-resolved-interface
single->double word eleven clear-input-port reverse!
eighteen zero write-radix-commas? symbol-value exact->inexact
subst! type $apply-procedure loop/p write-radix-sign?))
"\n;; list-procedure, stack, $system-environment, $active-threads,\n;; #{source yqrk281einmw7sg-a}, $c-info, placeholder, make-record-type,\n;; join-subst, trace-let, set-top-level-value!, integer?, error,\n;; result, make-resolved-interface, single->double, word, eleven,\n;; clear-input-port, reverse!, eighteen, zero, write-radix-commas?,\n;; symbol-value, exact->inexact, subst!, type, $apply-procedure,\n;; loop/p, write-radix-sign?.\n")
(equal? (format "~%;; ~{~<~%;; ~1,50:; ~s~>~^,~}.~%"
'(list-procedure stack $system-environment $active-threads
#{source yqrk281einmw7sg-a} $c-info placeholder
make-record-type join-subst trace-let set-top-level-value!
integer? error result make-resolved-interface
single->double word eleven clear-input-port reverse!
eighteen zero write-radix-commas? symbol-value exact->inexact
subst! type $apply-procedure loop/p write-radix-sign?))
"\n;; list-procedure, stack, $system-environment,\n;; $active-threads, #{source yqrk281einmw7sg-a},\n;; $c-info, placeholder, make-record-type,\n;; join-subst, trace-let, set-top-level-value!,\n;; integer?, error, result,\n;; make-resolved-interface, single->double, word,\n;; eleven, clear-input-port, reverse!, eighteen,\n;; zero, write-radix-commas?, symbol-value,\n;; exact->inexact, subst!, type,\n;; $apply-procedure, loop/p, write-radix-sign?.\n")
(equal? (format "~&;; ~{~<~%~&;; ~1:; ~s~>~^,~}.~&"
'(list-procedure stack $system-environment $active-threads
#{source yqrk281einmw7sg-a} $c-info placeholder
make-record-type join-subst trace-let set-top-level-value!
integer? error result make-resolved-interface
single->double word eleven clear-input-port reverse!
eighteen zero write-radix-commas? symbol-value exact->inexact
subst! type $apply-procedure loop/p write-radix-sign?))
";; list-procedure, stack, $system-environment, $active-threads,\n;; #{source yqrk281einmw7sg-a}, $c-info, placeholder, make-record-type,\n;; join-subst, trace-let, set-top-level-value!, integer?, error,\n;; result, make-resolved-interface, single->double, word, eleven,\n;; clear-input-port, reverse!, eighteen, zero, write-radix-commas?,\n;; symbol-value, exact->inexact, subst!, type, $apply-procedure,\n;; loop/p, write-radix-sign?.\n")
(equal? (format "~15<~s~;~^~s~;~^~s~>" 'foo) " foo")
(equal? (format "~15<~s~;~^~s~;~^~s~>" 'foo 'bar) "foo bar")
(equal? (format "~15<~s~;~^~s~;~^~s~>" 'foo 'bar 'baz) "foo bar baz")
)
(mat format-iterate
(error? (format "~{abc~:~}")) ; ~ directive has no : flag
(error? (format "~{abc~;~}")) ; misplaced directive "~;"
; ~{...}
(error? (format "~{|~s~}")) ; too few args
; (error? (format "~{|~s~}" '() "$")) ; too many args
(equal? (format "~{|~s~}" '()) "")
(equal? (format "~a~{|~s~}~a" "^" '(a b c) "$") "^|a|b|c$")
(equal? (format "~a~{|~s~:}~a" "^" '(a b c) "$") "^|a|b|c$")
(equal? (format "~a~{abc~:}~a" "^" '() "$") "^abc$")
(equal? (format "~a~2{|~s~:}~a" "^" '(a b c) "$") "^|a|b$")
(error? (format "~a~2{|~s~:}~a" "^" '() "$")) ; too few args
(equal? (format "+~{<~s~^~s>~}+~{<~s~^~s>~}+" '(a b c d) '(a b c))
"+<ab><cd>+<ab><c+")
(equal? (format "+~{<~s~:^~s>~}+~{<~s~^~s>~}+" '(a b c d) '(a b c))
"+<ab><cd>+<ab><c+")
(error? (format "+~{<~s~:^~s>~}+~{<~s~:^~s>~}+" '(a b c d) '(a b c))) ; too few args
(equal? (format "~a~{~}~a"
"^"
"+~{<~s~^~s>~}+"
'((a b c d) (a b c) () (a))
"$")
"^+<ab><cd>++<ab><c++++<a+$")
(error? (format "~a~{~}~a"
"^"
"+~{<~s~s>~}+"
'((a b c d) (a b c) () (a))
"$")) ; too few args for "+~{<~s~s>~}+"
; ~:{...}
(error? (format "~:{|~s~}")) ; too few args
; (error? (format "~:{|~s~}" '() "$")) ; too many args
(equal? (format "~:{|~s~}" '()) "")
(equal? (format "~a~:{|~s~}~a" "^" '((a) (b) (c)) "$") "^|a|b|c$")
(equal? (format "~a~:{|~s~:}~a" "^" '((a) (b) (c)) "$") "^|a|b|c$")
(equal? (format "~a~:{abc~:}~a" "^" '() "$") "^abc$")
(equal? (format "~a~2:{|~s~:}~a" "^" '((a) (b) (c)) "$") "^|a|b$")
(equal? (format "~:{<~s~^~s>~:}" '((a b) (c) (e f))) "<ab><c<ef>")
(equal? (format "~:{<~s~:^~s>~:}" '((a b) (c d) (e f))) "<ab><cd><e")
(equal? (format "~a~:{~}~a" "^" "<~s~:^~s>" '() "$") "^$")
(error? (format "~a~:{~}~a" "^" "<~s~:^~s>" '(a b) "$")) ; a is not a pair
(equal? (format "~a~:{~}~a" "^" "<~s~^~s>" '((a b)) "$") "^<ab>$")
(equal? (format "~a~:{~}~a" "^" "<~s~:^~s>" '((a b)) "$") "^<a$")
; (error? (format "~a~:{~}~a" "^" "<~s~^~s>" '((a b c)) "$")) ; too many args for "<~s~^~s>"
(equal? (format "~a~:{~}~a" "^" "<~s~^~s>" '((a b) (c)) "$") "^<ab><c$")
(error? (format "~a~:{~}~a" "^" "<~s~:^~s>" '((a b) (c) (d e)) "$")) ; too few args for "<~s~:^~s>"
(equal? (format "~a~:{~}~a" "^" "<~s~:^~s>" '((a b) (c d)) "$") "^<ab><c$")
(equal? (format "~:{~}" "~s" '()) "")
(error? (format "~:{~}" "~s" '(()))) ; too few args for "~s"
(error? (format "~:{~}" "~s" '(a b))) ; a is not a list
; (error? (format "~:{~}" "~s" '((a b)))) ; too many args for "~s"
(error? (format "~:{~s~:}" '())) ; too few args
(error? (format "~:{~s~}" '(a b))) ; a is not a list
; (error? (format "~:{|~s~}" '((a b)))) ; too many args
; ~@{...}
(equal? (format "~@{|~s~}") "")
(equal? (format "~@{|~s~}" 'a 'b 'c) "|a|b|c")
(equal? (format "~@{|~s~:}" '(a) '(b) '(c)) "|(a)|(b)|(c)")
(equal? (format "~@{abc~:}") "abc")
(equal? (format "~2@{|~s~:}~s" 'a 'b 'c) "|a|bc")
(error? (format "~2@{|~s~:}")) ; too few args
(equal? (format "~@{<~s~^~s>~}" 'a 'b 'c 'd) "<ab><cd>")
(equal? (format "~@{<~s~^~s>~}" 'a 'b 'c 'd 'e) "<ab><cd><e")
(equal? (format "~@{<~s~:^~s>~}" 'a 'b 'c 'd) "<ab><cd>")
(error? (format "~@{<~s~:^~s>~}" 'a 'b 'c 'd 'e)) ; too few args
; ~@:{...}
(equal? (format "~@:{|~s~}") "")
(equal? (format "~@:{|~s~}" '(a) '(b) '(c)) "|a|b|c")
(equal? (format "~@:{|~s~:}" '(a) '(b) '(c)) "|a|b|c")
(equal? (format "~@:{abc~:}") "abc")
(equal? (format "~2@:{|~s~:}~s" '(a) '(b) '(c)) "|a|b(c)")
(equal? (format "~@:{<~s~^~s>~:}" '(a b) '(c) '(e f)) "<ab><c<ef>")
(equal? (format "~@:{<~s~:^~s>~:}" '(a b) '(c d) '(e f)) "<ab><cd><e")
(equal? (format "~@:{~:}" "<~s~:^~s>" '(a b) '(c d) '(e f)) "<ab><cd><e")
(error? (format "~@:{~}" "~s" '()))
; (error? (format "~@:{~}" "~s" '(a b))) ; too many args
(error? (format "~@:{~s~}" '()))
; (error? (format "~@:{~s~}" '(a b))) ; too many args
(error? (format "~:@{|~s~}" 'a 'b 'c)) ; a is not a list
; ~{...~} tests from cltl2
(equal? (format "The winners are:~{ ~S~}." '(fred harry jill))
"The winners are: fred harry jill.")
(equal? (format "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
"Pairs: <a,1> <b,2> <c,3>.")
(equal? (format "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
"Pairs: <a,1> <b,2> <c,3>.")
(equal? (format "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3)
"Pairs: <a,1> <b,2> <c,3>.")
(equal? (format "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
"Pairs: <a,1> <b,2> <c,3>.")
(equal? (format "~1{~:}" "a ~b c" '(5)) "a 101 c")
(equal? (format "~1{~:}" "a ~b c" '(5))
(apply format "a ~b c" '(5)))
; ~^ tests from cltl2
(equal? (format "~:{/~s~^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger/ice .../french ...")
(equal? (format "~:{/~s~:^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger .../ice .../french")
; this one appears not to be supported by cltl text, but it's one of
; the examples
(equal? (format "~:{/~s~#:^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger")
; was all screwed up in cltl2, and didn't illustrate ~^ within
; ~[...~] as advertised:
; (begin (define tellstr "~@{~@[~R~]~^ ~A.~}") (string? tellstr))
; (equal? (format tellstr 23) "Twenty-three.")
; (equal? (format tellstr #f "losers") "losers.")
; (equal? (format tellstr 23 "losers") "Twenty-three losers.")
; probably meant something more like this:
(begin (define tellstr "~@{~@[~R~^ ~]~A~}.") (string? tellstr))
(equal? (format tellstr 23) "twenty-three.")
(equal? (format tellstr #f "losers") "losers.")
(equal? (format tellstr 23 "losers") "twenty-three losers.")
)
(mat format-goto
(error? (format "~*"))
(error? (format "~s ~*" 0))
(equal? (format "~*~s" 0 1) "1")
; (error? (format "~0*~s" 0 1)) ; too many args
(error? (format "~2*~s" 0 1))
(error? (format "~3*~s" 0 1))
(error? (format "~-3*~s" 0 1))
; (error? (format "~s ~:*" 0)) ; too many args
(equal? (format "~s~:*~s" 0) "00")
(error? (format "~s~2:*~s" 0))
(error? (format "~s~0:*~s" 0))
(error? (format "~s~:@*~s" 0))
(error? (format "~s~@:*~s" 0))
(error? (format "~:*"))
(error? (format "~:* ~s" 0))
(equal? (format "~@*") "")
; (error? (format "~s~@*" 0)) ; too many args
; (error? (format "~@*" 0)) ; too many args
(equal? (format "~s~:*~s~s~s~2:*~s~3*~s~@*~s~s~1@*~s~5@*~s" 'a 'b 'c 'd 'e 'f)
"aabcbfabbf")
(equal? (format "~s~?~:*~s~s" '< "~s~s~:*~s~*~s" '(a b c d) '>)
"<abbd(a b c d)>")
(equal? (format "~s~@?~:*~s~s" '< "~s~s~:*~s~*~s" 'a 'b 'c 'd '>)
"<abbdd>")
)
(mat format-radix
(equal? (format "~d" 3) "3")
(equal? (format "~3d" 1) " 1")
(equal? (format "~:d" 12345) "12,345")
(equal? (format "~:@d" 12345) "+12,345")
(equal? (format "~@:d" 12345) "+12,345")
(equal? (format "~:d" -12345) "-12,345")
(equal? (format "~:@d" -12345) "-12,345")
(equal? (format "~@:d" -12345) "-12,345")
(equal? (format "~:b" #b10110110101) "10,110,110,101")
(equal? (format "~20,'q,'%,4:@b" #b10110110101) "qqqqqq+101%1011%0101")
(equal? (format "~,,' ,4b" #xface) "1111101011001110") ; cltl2 example: "1111 1010 1100 1110"
(equal? (format "~,,' ,4:b" #xface) "1111 1010 1100 1110")
(equal? (format "~19,,' ,4:b" #x1ce) " 1 1100 1110") ; cltl2 example: "0000 0001 1100 1110"
(equal? (format "~x" #x1ce) "1CE")
(equal? (format "#o~:o" #o1234567076543210) "#o1,234,567,076,543,210")
(equal? (format "~36r" 35) "Z")
(equal? (format "~36,10r and ~26r" #36rzeus #26rapollo)
" ZEUS and APOLLO")
(equal? (format "~,10r" -1234567) " -1234567")
(equal? (format "~3,20,'*,'|,2:@r" #3r20202020) "********+20|20|20|20")
(equal? (format "~10d" '(a 10 c)) " (a 10 c)")
(equal? (format "~10x" '(10 11 12)) " (A B C)")
(equal? (format "~36,10,'*r" '(10 20 30)) "***(A K U)")
)
(mat format-roman
(equal? (format "~@r ~@r ~@r" 1999 -1999 4000) "MCMXCIX -1999 4000")
(equal? (format "~@r ~@r ~@r" 3999 3998 347) "MMMCMXCIX MMMCMXCVIII CCCXLVII")
(equal? (format "~@r" 2599) "MMDXCIX")
(equal? (format "~@r" 4736) "4736")
(equal? (format "~@r" 1782) "MDCCLXXXII")
(equal? (format "~@r" 2251) "MMCCLI")
(equal? (format "~@r" 1009) "MIX")
(equal? (format "~@r" 544) "DXLIV")
(equal? (format "~@r" 7) "VII")
(equal? (format "~@r" 5) "V")
)
(mat format-old-roman
(equal? (format "~@:r ~@:r ~@:r" 1999 -1999 5000)
"MDCCCCLXXXXVIIII -1999 5000")
(equal? (format "~@:r ~@:r ~@:r" 4999 4998 347)
"MMMMDCCCCLXXXXVIIII MMMMDCCCCLXXXXVIII CCCXXXXVII")
(equal? (format "~@:r" 2599) "MMDLXXXXVIIII")
(equal? (format "~@:r" 4736) "MMMMDCCXXXVI")
(equal? (format "~@:r" 1782) "MDCCLXXXII")
(equal? (format "~@:r" 2251) "MMCCLI")
(equal? (format "~@:r" 1009) "MVIIII")
(equal? (format "~@:r" 544) "DXXXXIIII")
(equal? (format "~@:r" 7) "VII")
(equal? (format "~@:r" 5) "V")
)
(mat format-cardinal
(equal? (format "~r" 1000000000) "1,000,000,000")
(equal? (format "~r" 1000000001) "1,000,000,001")
(equal? (format "~r" -2) "minus two")
(equal? (format "~r" -1023) "minus one thousand twenty-three")
(equal? (format "~r" 999999999) "nine hundred ninety-nine million nine hundred ninety-nine thousand nine hundred ninety-nine")
(equal? (format "~r" -954321098) "minus nine hundred fifty-four million three hundred twenty-one thousand ninety-eight")
(equal? (format "~r" 2599) "two thousand five hundred ninety-nine")
(equal? (format "~r" 4736) "four thousand seven hundred thirty-six")
(equal? (format "~r" -4730) "minus four thousand seven hundred thirty")
(equal? (format "~r" -4719) "minus four thousand seven hundred nineteen")
(equal? (format "~r" 1782) "seventeen hundred eighty-two")
(equal? (format "~r" 2251) "two thousand two hundred fifty-one")
(equal? (format "~r" 1009) "one thousand nine")
(equal? (format "~r" 544) "five hundred forty-four")
(equal? (format "~r ~r ~r ~r ~r ~r ~r ~r ~r ~r" 0 1 2 3 4 5 6 7 8 9)
"zero one two three four five six seven eight nine")
(equal? (format "~r ~r ~r ~r ~r ~r ~r ~r ~r ~r" 10 11 12 13 14 15 16 17 18 19)
"ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen")
)
(mat format-ordinal
(equal? (format "~:r" 1000000000) "1,000,000,000th")
(equal? (format "~:r" -1000000001) "-1,000,000,001st")
(equal? (format "~:r" -1000000002) "-1,000,000,002nd")
(equal? (format "~:r" 1000000003) "1,000,000,003rd")
(equal? (format "~:r" 300000000004) "300,000,000,004th")
(equal? (format "~:r" 700000000008) "700,000,000,008th")
(equal? (format "~:r" 800000000010) "800,000,000,010th")
(equal? (format "~:r" 800000000011) "800,000,000,011th")
(equal? (format "~:r" 800000000012) "800,000,000,012th")
(equal? (format "~:r" 800000000013) "800,000,000,013th")
(equal? (format "~:r" 800000000019) "800,000,000,019th")
(equal? (format "~:r" 800000000021) "800,000,000,021st")
(equal? (format "~:r" 800000000073) "800,000,000,073rd")
(equal? (format "~:r" -2) "minus second")
(equal? (format "~:r" -1023) "minus one thousand twenty-third")
(equal? (format "~:r" 999999999) "nine hundred ninety-nine million nine hundred ninety-nine thousand nine hundred ninety-ninth")
(equal? (format "~:r" 999000000) "nine hundred ninety-nine millionth")
(equal? (format "~:r" -999000000) "minus nine hundred ninety-nine millionth")
(equal? (format "~:r" 912304000) "nine hundred twelve million three hundred four thousandth")
(equal? (format "~:r" 912004000) "nine hundred twelve million four thousandth")
(equal? (format "~:r" -312001900) "minus three hundred twelve million nineteen hundredth")
(equal? (format "~:r" 2599) "two thousand five hundred ninety-ninth")
(equal? (format "~:r" 4736) "four thousand seven hundred thirty-sixth")
(equal? (format "~:r" -4730) "minus four thousand seven hundred thirtieth")
(equal? (format "~:r" -4716) "minus four thousand seven hundred sixteenth")
(equal? (format "~:r" 1782) "seventeen hundred eighty-second")
(equal? (format "~:r" 2251) "two thousand two hundred fifty-first")
(equal? (format "~:r" 1009) "one thousand ninth")
(equal? (format "~:r" 544) "five hundred forty-fourth")
(equal? (format "~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r" 0 1 2 3 4 5 6 7 8 9)
"zeroth first second third fourth fifth sixth seventh eighth ninth")
(equal? (format "~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r ~:r" 10 11 12 13 14 15 16 17 18 19)
"tenth eleventh twelfth thirteenth fourteenth fifteenth sixteenth seventeenth eighteenth nineteenth")
)
(mat format-fixed1
(equal? (format "~8,3f" 0.0) " 0.000")
(equal? (format "~8,3f" -0.0) " -0.000")
(equal? (format "~8,3f" 1234567.89) "1234567.890")
(equal? (format "~8,3f" 123456.789) "123456.789")
(equal? (format "~8,3f" 1.23456) " 1.235")
(equal? (format "~8,3f" 1.23456789) " 1.235")
(equal? (format "~8,3f" 321.23456789) " 321.235")
(equal? (format "~8,3f" 4321.23456789) "4321.235")
(equal? (format "~8,3,-2,,'zf" 0.0) "zzz0.000")
(equal? (format "~8,3,-2,,'zf" -0.0) "zz-0.000")
(equal? (format "~8,3,-2,,'0f" 4321.23456789) "0043.212")
(equal? (format "~8,3f" 54321.23456789) "54321.235")
(equal? (format "~8,3f" -1.23456789) " -1.235")
(equal? (format "~8,3@f" 0.0) " +0.000")
(equal? (format "~8,3@f" -0.0) " -0.000")
(equal? (format "~8,3@f" 1.23456789) " +1.235")
(equal? (format "~8,3f" .0023456789) " 0.002")
(equal? (format "~8,3f" .002) " 0.002")
(equal? (format "~8,3@f" 123456789) "+123456789.000")
(equal? (format "~8,3@f" 123456789123456789) "+12345678912345678#.###")
(equal? (format "~8,3f" 12345678912345678) "12345678912345678.###")
(equal? (format "~8,3f" 1234567891234567) "1234567891234567.0##")
(equal? (format "~8,3f" 12345678912345) "12345678912345.000")
(equal? (format "~8,3f" 1e23) "9999999999999999#######.###")
(equal? (format "~8,3,23f" 0.0) " 0.000")
(equal? (format "~8,3,23f" -0.0) " -0.000")
(equal? (format "~8,3,23f" 1.0) "10000000000000000#######.###")
(equal? (format "~8,3f" 1e-23) " 0.000")
(equal? (format "~8,3,-23f" 0.0) " 0.000")
(equal? (format "~8,3,-23f" -0.0) " -0.000")
(equal? (format "~8,3,-23f" 1.0) " 0.000")
(equal? (format "~8,3f" 1e-7) " 0.000")
(equal? (format "~8,3f" 9e-7) " 0.000")
(equal? (format "~8,3f" 1e-6) " 0.000")
(equal? (format "~8,3f" 1e-5) " 0.000")
(equal? (format "~8,3f" 1e-4) " 0.000")
(equal? (format "~8,3f" 1e-3) " 0.001")
(equal? (format "~8,3f" 1e-2) " 0.010")
(equal? (format "~8,3f" 1e-1) " 0.100")
)
(mat format-fixed2
(equal? (format "~10,3,2f" 3.14159) " 314.159")
(equal? (format "~10,3,-1f" 3.14159) " 0.314")
(equal? (format "~6,3,-1f" 3.14159) " 0.314")
(equal? (format "~5,3,-1f" 3.14159) "0.314")
(equal? (format "~4,3,-1f" 3.14159) ".314")
(equal? (format "~3,3,-1f" 3.14159) ".314")
(equal? (format "~10,3,2f" -3.14159) " -314.159")
(equal? (format "~10,3,-1f" -3.14159) " -0.314")
(equal? (format "~6,3,-1f" -3.14159) "-0.314")
(equal? (format "~5,3,-1f" -3.14159) "-.314")
(equal? (format "~3,3,-1f" -3.14159) "-.314")
(equal? (format "~6,3,-1@f" 3.14159) "+0.314")
(equal? (format "~5,3,-1@f" 3.14159) "+.314")
(equal? (format "~,3,-1@f" 3.14159) "+0.314")
(equal? (format "~,3,-8f" 3.14159) "0.000")
(equal? (format "~4,3,-8f" 3.14159) ".000")
)
(mat format-fixed3
(equal? (format "~10,,2f" 3.14159) " 314.159")
(equal? (format "~10,,-1f" 3.14159) " 0.314159")
(equal? (format "~8,,-1f" 3.14159) "0.314159")
(equal? (format "~7,,-1f" 3.14159) ".314159")
(equal? (format "~6,,-1f" 3.14159) ".31416")
(equal? (format "~5,,-1f" 3.14159) ".3142")
(equal? (format "~4,,-1f" 3.14159) ".314")
(equal? (format "~3,,-1f" 3.14159) ".31")
(equal? (format "~2,,-1f" 3.14159) ".3")
(equal? (format "~1f" .314159) ".3")
(equal? (format "~1,,-1f" 3.14159) ".3")
(equal? (format "~0,,-1f" 3.14159) ".3")
(equal? (format "~0,,5f" 3.14159) "314159.")
(equal? (format "~5f" -231.2) "-231.")
(equal? (format "~5f" 231.2) "231.2")
(equal? (format "~5f" -23.12) "-23.1")
(equal? (format "~5f" 23.12) "23.12")
(equal? (format "~5f" -23.1) "-23.1")
(equal? (format "~5f" -231) "-231.")
(equal? (format "~5f" -2.31) "-2.31")
(equal? (format "~5f" -2310) "-2310.")
(equal? (format "~5f" 1e23) "9999999999999999#######.")
(equal? (format "~5,,1f" -231.2) "-2312.")
(equal? (format "~5,,1f" 231.2) "2312.")
(equal? (format "~5,,1f" -23.12) "-231.")
(equal? (format "~5,,1f" 23.12) "231.2")
(equal? (format "~5,,1f" -23.1) "-231.")
(equal? (format "~5,,1f" -231) "-2310.")
(equal? (format "~5,,1f" -2.31) "-23.1")
(equal? (format "~5,,1f" -2310) "-23100.")
(equal? (format "~5,,1f" 1e23) "9999999999999999########.")
(equal? (format "~5,,-1f" -231.2) "-23.1")
(equal? (format "~5,,-1f" 231.2) "23.12")
(equal? (format "~5,,-1f" -23.12) "-2.31")
(equal? (format "~5,,-1f" 23.12) "2.312")
(equal? (format "~5,,-1f" -23.1) "-2.31")
(equal? (format "~5,,-1f" -231) "-23.1")
(equal? (format "~5,,-1f" -2.31) "-.231")
(equal? (format "~5,,-1f" -2310) "-231.")
(equal? (format "~5,,-1f" 1e23) "9999999999999999######.")
(equal? (format "~,,1f" 3.14159) "31.4159")
(equal? (format "~,,5f" 3.14159) "314159.0")
(equal? (format "~,,10f" 3.14159) "31415900000.0")
(equal? (format "~,,-1f" 3.14159) "0.314159")
(equal? (format "~,,-2f" 3.14159) "0.0314159")
)
(mat format-fixed4
(equal? (format "~8f" 0.0) " 0.0")
(equal? (format "~8f" -0.0) " -0.0")
(equal? (format "~8@f" 0.0) " +0.0")
(equal? (format "~8@f" -0.0) " -0.0")
(equal? (format "~8f" 1234567.89) "1234568.")
(equal? (format "~8f" 123456.789) "123456.8")
(equal? (format "~8f" 1.23456) " 1.23456")
(equal? (format "~8f" 1.23456789) "1.234568")
(equal? (format "~8f" 321.23456789) "321.2346")
(equal? (format "~8f" 4321.23456789) "4321.235")
(equal? (format "~8f" 54321.23456789) "54321.23")
(equal? (format "~8f" -1.23456789) "-1.23457")
(equal? (format "~8@f" 1.23456789) "+1.23457")
(equal? (format "~8f" .0023456789) ".0023457")
(equal? (format "~8f" .002) " 0.002")
(equal? (format "~8@f" 123456789) "+123456789.")
(equal? (format "~8@f" 123456789123456789) "+12345678912345678#.")
(equal? (format "~8f" 12345678912345678) "12345678912345678.")
(equal? (format "~8f" 1234567891234567) "1234567891234567.")
(equal? (format "~8f" 12345678912345) "12345678912345.")
(equal? (format "~8f" 1e23) "9999999999999999#######.")
(equal? (format "~8f" 1e-23) " 0.0")
(equal? (format "~8f" 1e-8) " 0.0")
(equal? (format "~8f" 1e-7) ".0000001")
(equal? (format "~8f" 9e-7) ".0000009")
(equal? (format "~8f" 1e-6) "0.000001")
(equal? (format "~7f" 9e-7) ".000001")
(equal? (format "~7f" 1e-6) ".000001")
(equal? (format "~6f" 9e-9) " 0.0")
(equal? (format "~6f" 9e-7) " 0.0")
(equal? (format "~6f" 1e-6) " 0.0")
(equal? (format "~6f" 1e-5) ".00001")
(equal? (format "~6f" 1.0) " 1.0")
(equal? (format "~6f" 10.0) " 10.0")
(equal? (format "~6f" 100.0) " 100.0")
(equal? (format "~6f" 1e3) "1000.0")
(equal? (format "~6f" 123.0) " 123.0")
(equal? (format "~6f" 1234.0) "1234.0")
(equal? (format "~6f" 12345.0) "12345.")
(equal? (format "~6f" 123456.0) "123456.")
(equal? (format "~6f" 10000.0) "10000.")
(equal? (format "~6,,1f" 1e3) "10000.")
(equal? (format "~5,,1f" 1e3) "10000.")
(equal? (format "~7f" -1.0) " -1.0")
(equal? (format "~7f" -10.0) " -10.0")
(equal? (format "~7f" -100.0) " -100.0")
(equal? (format "~7f" -1e3) "-1000.0")
(equal? (format "~7f" -123.0) " -123.0")
(equal? (format "~7f" -1234.0) "-1234.0")
(equal? (format "~7f" -12345.0) "-12345.")
(equal? (format "~7f" -123456.0) "-123456.")
(equal? (format "~7f" -10000.0) "-10000.")
(equal? (format "~7,,1f" -1e3) "-10000.")
(equal? (format "~6,,1f" -1e3) "-10000.")
)
(mat format-fixed5
(equal? (format "~f" 0.0) "0.0")
(equal? (format "~f" -0.0) "-0.0")
(equal? (format "~@f" 0.0) "+0.0")
(equal? (format "~@f" -0.0) "-0.0")
(equal? (format "~f" 1234567.89) "1234567.89")
(equal? (format "~f" 123456.789) "123456.789")
(equal? (format "~f" 1.23456) "1.23456")
(equal? (format "~f" 1.23456789) "1.23456789")
(equal? (format "~f" 321.23456789) "321.23456789")
(equal? (format "~f" 4321.23456789) "4321.23456789")
(equal? (format "~f" 54321.23456789) "54321.23456789")
(equal? (format "~f" -1.23456789) "-1.23456789")
(equal? (format "~@f" 1.23456789) "+1.23456789")
(equal? (format "~f" .0023456789) "0.0023456789")
(equal? (format "~f" .002) "0.002")
(equal? (format "~@f" 123456789) "+123456789.0")
(equal? (format "~@f" 123456789123456789) "+12345678912345678#.#")
(equal? (format "~f" 12345678912345678) "12345678912345678.#")
(equal? (format "~f" 1234567891234567) "1234567891234567.0")
(equal? (format "~f" 12345678912345) "12345678912345.0")
(equal? (format "~f" 1e23) "9999999999999999#######.#")
(equal? (format "~f" 1e-23) "0.00000000000000000000001")
(equal? (format "~f" 1e-7) "0.0000001")
(equal? (format "~f" 9e-7) "0.0000009")
(equal? (format "~f" 1e-6) "0.000001")
)
(mat format-fixed6
(equal? (format "~2,1@f" 0.003) "+.0")
(equal? (format "~2@f" 0.003) "+.0")
(equal? (format "~2@f" 1.34) "+1.")
(equal? (format "~2,1@f" 1.34) "+1.3")
(equal? (format "~2,2@f" 1.34) "+1.34")
(equal? (format "~0f" 1e23) "9999999999999999#######.")
(equal? (format "~0f" 1e-23) ".0")
(equal? (format "~0f" -1e-23) "-.0")
(equal? (format "~0f" 0.0) "0.")
(equal? (format "~0f" -0.0) "-0.")
)
(mat format-fixed7
(equal? (format "~2,1,,'*@f" 0.0) "**")
(equal? (format "~2,1,,'*@f" -0.0) "**")
(equal? (format "~2,1,,'*@f" 0.003) "**")
(equal? (format "~2,,,'*,@f" 0.003) "**")
(equal? (format "~4,2,,'*@f" 1.34) "****")
(equal? (format "~2,1,4,'q,'p@f" 0.0) "qq")
(equal? (format "~2,1,4,'q,'p@f" -0.0) "qq")
(equal? (format "~2,1,4,'q,'p@f" 1.34) "qq")
(equal? (format "~10,1,4,'q,'p@f" 0.0) "pppppp+0.0")
(equal? (format "~10,1,4,'q,'p@f" -0.0) "pppppp-0.0")
(equal? (format "~10,1,4,'q,'p@f" 1.34) "pp+13400.0")
(equal? (format "~10,1,-4,'q,'p@f" 1.34) "pppppp+0.0")
(equal? (format "~10,5,-4,'q,'p@f" 1.34) "pp+0.00013")
(equal? (format "~10,6,-4,'q,'p@f" 1.34) "p+0.000134")
(equal? (format "~10,6,-4,'q,'p@f" 0.0) "p+0.000000")
(equal? (format "~10,6,-4,'q,'p@f" -0.0) "p-0.000000")
(equal? (format "~2,2,,'q,'p@f" 1.34) "qq")
(equal? (format "~10,2,,'q,'p@f" 1.34) "ppppp+1.34")
(equal? (format "~0,,,'*f" 1e23) "")
(equal? (format "~0,,,'*f" 1e-23) "")
(equal? (format "~0,,,'*f" -1e-23) "")
)
(mat format-fixed8
(let () ; example adapted from cltl2
(define (foo x)
(format "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
x x x x x x))
(and (equal? (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159")
(equal? (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159")
(equal? (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0")
(equal? (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0")
(equal? (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006")
(equal? (foo 0.0) " 0.00| 0.00| 0.00| 0.0|0.00|0.0")
(equal? (foo -0.0) " -0.00| -0.00| -0.00| -0.0|-0.00|-0.0")))
)
(mat format-exp1
(equal? (format "~10,5,,2e" 0.0) " 0.0000e+0")
(equal? (format "~10,5,,2e" -0.0) "-0.0000e+0")
(equal? (format "~9,5,,2e" 0.0) "0.0000e+0")
(equal? (format "~9,5,,2e" -0.0) "-.0000e+0")
(equal? (format "~10,5,,2e" 3.14159) "31.4159e-1")
(equal? (format "~10,0e" 3.4e-200) " 3.e-200")
(equal? (format "~10,3,2,0e" 123456789) " 0.123e+09")
(equal? (format "~9,3,2,0e" 123456789) "0.123e+09")
(equal? (format "~8,3,2,0e" 0.0) ".000e+00")
(equal? (format "~8,3,2,0e" -0.0) "-.000e+00")
(equal? (format "~8,3,2,0e" 123456789) ".123e+09")
(equal? (format "~7,3,2,0e" 123456789) ".123e+09")
(equal? (format "~3,3,2,0e" 123456789) ".123e+09")
)
(mat format-exp2
(equal? (format "~10e" 0.0) " 0.0e+0")
(equal? (format "~10e" -0.0) " -0.0e+0")
(equal? (format "~10e" 3.4) " 3.4e+0")
(equal? (format "~10e" 3.4e10) " 3.4e+10")
(equal? (format "~10e" 3.4e-10) " 3.4e-10")
(equal? (format "~10e" 3.4e-200) " 3.4e-200")
(equal? (format "~10,,,2e" 0.0) " 0.0e+0")
(equal? (format "~10,,,2e" -0.0) " -0.0e+0")
(equal? (format "~10,,,2e" 3.4e-200) " 34.0e-201")
(equal? (format "~10,,,3e" 3.4e-200) "340.0e-202")
(equal? (format "~10,,,-2e" 0.0) " 0.0e+0")
(equal? (format "~10,,,-2e" -0.0) " -0.0e+0")
(equal? (format "~10,,,-2e" 3.4e-200) "0.003e-197")
(equal? (format "~10@e" 3.6e99) " +3.6e+99")
(equal? (format "~9@e" 3.6e99) " +3.6e+99")
(equal? (format "~8@e" 3.6e99) "+3.6e+99")
(equal? (format "~7@e" 3.6e99) "+4.e+99")
(equal? (format "~6@e" 3.6e99) "+4.e+99")
(equal? (format "~5@e" 3.6e99) "+4.e+99")
(equal? (format "~0@e" 3.6e99) "+4.e+99")
(equal? (format "~9@e" 0.0) " +0.0e+0")
(equal? (format "~7@e" 0.0) "+0.0e+0")
(equal? (format "~6@e" 0.0) "+0.e+0")
(equal? (format "~0@e" 0.0) "+0.e+0")
(equal? (format "~9@e" -0.0) " -0.0e+0")
(equal? (format "~7@e" -0.0) "-0.0e+0")
(equal? (format "~6@e" -0.0) "-0.e+0")
(equal? (format "~0@e" -0.0) "-0.e+0")
(equal? (format "~9,,,0@e" 0.0) " +0.0e+0")
(equal? (format "~7,,,0@e" 0.0) "+0.0e+0")
(equal? (format "~6,,,0@e" 0.0) "+.0e+0")
(equal? (format "~0,,,0@e" 0.0) "+.0e+0")
(equal? (format "~9,,,0@e" -0.0) " -0.0e+0")
(equal? (format "~7,,,0@e" -0.0) "-0.0e+0")
(equal? (format "~6,,,0@e" -0.0) "-.0e+0")
(equal? (format "~0,,,0@e" -0.0) "-.0e+0")
(equal? (format "~10e" 9.999e9) " 9.999e+9")
(equal? (format "~9e" 9.999e9) " 9.999e+9")
(equal? (format "~8e" 9.999e9) "9.999e+9")
(equal? (format "~7e" 9.999e9) "1.0e+10")
(equal? (format "~6e" 9.999e9) "1.e+10")
(equal? (format "~5e" 9.999e9) "1.e+10")
(equal? (format "~0e" 9.999e9) "1.e+10")
(equal? (format "~10e" 9.999e-10) " 9.999e-10")
(equal? (format "~9e" 9.999e-10) "9.999e-10")
(equal? (format "~8e" 9.999e-10) " 1.0e-9")
(equal? (format "~7e" 9.999e-10) " 1.0e-9")
(equal? (format "~6e" 9.999e-10) "1.0e-9")
(equal? (format "~5e" 9.999e-10) "1.e-9")
(equal? (format "~2e" 9.999e-10) "1.e-9")
(equal? (format "~10e" 1e23) " 1.0e+23")
)
(mat format-exp3
(equal? (format "~e" 0.0) "0.0e+0")
(equal? (format "~e" -0.0) "-0.0e+0")
(equal? (format "~e" 1e23) "1.0e+23")
(equal? (format "~e" .000345) "3.45e-4")
(equal? (format "~e" 345) "3.45e+2")
(equal? (format "~e" 345e20) "3.45e+22")
(equal? (format "~,,3,e" 0.0) "0.0e+000")
(equal? (format "~,,3,e" -0.0) "-0.0e+000")
(equal? (format "~,,3,e" 1e23) "1.0e+023")
(equal? (format "~,,3,3e" 0.0) "0.0e+000")
(equal? (format "~,,3,3e" -0.0) "-0.0e+000")
(equal? (format "~,,3,3e" 1e23) "100.0e+021")
(equal? (format "~,,,3e" 0.0) "0.0e+0")
(equal? (format "~,,,3e" -0.0) "-0.0e+0")
(equal? (format "~,,,3e" 1e23) "100.0e+21")
(equal? (format "~,,,3e" 3.14159) "314.159e-2")
(equal? (format "~,,2,3e" 3.14159) "314.159e-02")
(equal? (format "~,,2,3@e" 3.14159) "+314.159e-02")
(equal? (format "~,,,-3e" 0.0) "0.0e+0")
(equal? (format "~,,,-3e" -0.0) "-0.0e+0")
(equal? (format "~,,,-3e" -3.14159) "-0.000314159e+4")
(equal? (format "~0e" 0.0) "0.e+0")
(equal? (format "~0e" -0.0) "-0.e+0")
(equal? (format "~0,,,0e" 0.0) ".0e+0")
(equal? (format "~0,,,0e" -0.0) "-.0e+0")
(equal? (format "~,,1,,'*e" 3e20) "3.0e+20") ; can't fill with oc; no w
(equal? (format "~,2,1,,'*e" 3e20) "3.00e+20") ; can't fill with oc; no w
(equal? (format "~10,2,1,,'*e" 3e20) "**********") ; no room for exponent
(equal? (format "~10,,1,,'*e" 3e20) "**********") ; no room for exponent
(equal? (format "~10,2,,-2,'*e" 3e20) "**********") ; d to small for given k
(equal? (format "~,2,,-2,'*e" 3e20) "0.003e+23") ; can't fill with oc; no w
)
(mat format-exp4
(let () ; example adapted from cltl2
(define (foo x)
(format "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E"
x x x x))
(and (equal? (foo 3.14159) " 3.14e+0| 31.42$-01|+.003e+03| 3.14e+0")
(equal? (foo -3.14159) " -3.14e+0|-31.42$-01|-.003e+03| -3.14e+0")
(equal? (foo 1100.0) " 1.10e+3| 11.00$+02|+.001e+06| 1.10e+3")
(equal? (foo 1.1E13) "*********| 11.00$+12|+.001e+16| 1.10e+13")
(equal? (foo 1.1E120) "*********|??????????|%%%%%%%%%|1.10e+120")
(equal? (foo 1.1E1200) " +inf.0| +inf.0| +inf.0| +inf.0") ; cltl2 assumes L (128-bit?) floats
(equal? (foo 0.0) " 0.00e+0| 0.00$+00|+.000e+00| 0.00e+0")
(equal? (foo -0.0) " -0.00e+0| -0.00$+00|-.000e+00| -0.00e+0")))
(let () ; like above but without d parameters
(define (foo x)
(format "~9,,1,,'*E|~10,,2,2,'?,,'$E|~9,,2,-2,'%@E|~9E"
x x x x))
(and (equal? (foo 3.14159) "3.1416e+0|31.416$-01|+.003e+03|3.1416e+0")
(equal? (foo -3.14159) "-3.142e+0|-31.42$-01|-.003e+03|-3.142e+0")
(equal? (foo 1100.0) " 1.1e+3| 11.0$+02|+.001e+06| 1.1e+3")
(equal? (foo 1.1E13) "*********| 11.0$+12|+.001e+16| 1.1e+13")
(equal? (foo 1.1E120) "*********|??????????|%%%%%%%%%| 1.1e+120")
(equal? (foo 1.1E1200) " +inf.0| +inf.0| +inf.0| +inf.0") ; cltl2 assumes L (128-bit?) floats
(equal? (foo 0.0) " 0.0e+0| 0.0$+00| +0.0e+00| 0.0e+0")
(equal? (foo -0.0) " -0.0e+0| -0.0$+00| -0.0e+00| -0.0e+0")))
(equal? ; example adapted from cltl2
(with-output-to-string
(lambda ()
(do ([k -5 (fx+ k 1)])
((fx= k 8))
(printf
(format "Scale factor ~2d: |~~13,6,2,~de|~~%" k k)
3.14159))))
(format "Scale factor -5: | 0.000003e+06|~@
Scale factor -4: | 0.000031e+05|~@
Scale factor -3: | 0.000314e+04|~@
Scale factor -2: | 0.003142e+03|~@
Scale factor -1: | 0.031416e+02|~@
Scale factor 0: | 0.314159e+01|~@
Scale factor 1: | 3.141590e+00|~@
Scale factor 2: | 31.41590e-01|~@
Scale factor 3: | 314.1590e-02|~@
Scale factor 4: | 3141.590e-03|~@
Scale factor 5: | 31415.90e-04|~@
Scale factor 6: | 314159.0e-05|~@
Scale factor 7: | 3141590.e-06|\n"))
)
(mat format-general
(equal? (format "~g" 0.0) "0.")
(equal? (format "~g" -0.0) "-0.")
(equal? (format "~10g" 0.0) " 0. ")
(equal? (format "~10g" -0.0) " -0. ")
(let () ; example adapted from cltl2
(define (foo x)
(format "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
x x x x))
(and (equal? (foo 0.0314159) " 3.14e-2|314.2$-04|0.314e-01| 3.14e-2")
(equal? (foo 0.314159) " 0.31 |0.314 |0.314 | 0.31 ")
(equal? (foo 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 ")
(equal? (foo 31.4159) " 31. | 31.4 | 31.4 | 31. ")
(equal? (foo 314.159) " 3.14e+2| 314. | 314. | 3.14e+2")
(equal? (foo 3141.59) " 3.14e+3|314.2$+01|0.314e+04| 3.14e+3")
(equal? (foo 3141.59L0) " 3.14e+3|314.2$+01|0.314e+04| 3.14e+3")
(equal? (foo 3.14E12) "*********|314.0$+10|0.314e+13| 3.14e+12")
(equal? (foo 3.14L120) "*********|?????????|%%%%%%%%%|3.14e+120")
(equal? (foo 3.14L1200) " +inf.0| +inf.0| +inf.0| +inf.0")))
(equal?
(list (format "~,3g" .9999) (format "~,3g" .999) (format "~,3g" 1.0))
'("1.00" "0.999" "1.00"))
)
(mat format-dollar
(equal? (format "~$" 0.0) "0.00")
(equal? (format "~$" -0.0) "-0.00")
(equal? (format "~$" 3.4) "3.40")
(equal? (format "~$" 23.99) "23.99")
(equal? (format "~$" -12345.67830) "-12345.68")
(equal? (format "~$" .153) "0.15")
(equal? (format "~$" -.01) "-0.01")
(equal? (format "~$" .0159) "0.02")
(equal? (format "~3$" 0.0) "0.000")
(equal? (format "~3$" -0.0) "-0.000")
(equal? (format "~3$" 3.4) "3.400")
(equal? (format "~3$" 23.99) "23.990")
(equal? (format "~3$" -12345.67830) "-12345.678")
(equal? (format "~3$" .153) "0.153")
(equal? (format "~3$" -.01) "-0.010")
(equal? (format "~3$" .0159) "0.016")
(equal? (format "~1,2$" 0.0) "00.0")
(equal? (format "~1,2$" -0.0) "-00.0")
(equal? (format "~1,2$" 3.4) "03.4")
(equal? (format "~1,2$" 23.99) "24.0")
(equal? (format "~1,2$" 12345.678) "12345.7")
(equal? (format "~1,2$" .153) "00.2")
(equal? (format "~1,2$" -.01) "-00.0")
(equal? (format "~1,2$" .0159) "00.0")
(equal? (format "~1,2$" .0159) "00.0")
(equal? (format "~1,2,7$" 0.0) " 00.0")
(equal? (format "~1,2,7$" -0.0) " -00.0")
(equal? (format "~1,2,7$" 3.4) " 03.4")
(equal? (format "~1,2,7$" 23.99) " 24.0")
(equal? (format "~1,2,7$" -12345.678) "-12345.7")
(equal? (format "~1,2,7$" .153) " 00.2")
(equal? (format "~1,2,7$" -.01) " -00.0")
(equal? (format "~1,2,7$" .0159) " 00.0")
(equal? (format "~1,2,7$" .0159) " 00.0")
(equal? (format "~1,2,7,'0$" 0.0) "00000.0")
(equal? (format "~1,2,7,'0$" -0.0) "00-00.0")
(equal? (format "~1,2,7,'0$" 3.4) "00003.4")
(equal? (format "~1,2,7,'0$" 23.99) "00024.0")
(equal? (format "~1,2,7,'0$" -12345.678) "-12345.7")
(equal? (format "~1,2,7,'0$" .153) "00000.2")
(equal? (format "~1,2,7,'0$" -.01) "00-00.0")
(equal? (format "~1,2,7,'0$" .0159) "00000.0")
(equal? (format "~1,2,7,'0$" .0159) "00000.0")
(equal? (format "~1,2,7,'0:$" 0.0) "00000.0")
(equal? (format "~1,2,7,'0:$" -0.0) "-0000.0")
(equal? (format "~1,2,7,'0:$" 3.4) "00003.4")
(equal? (format "~1,2,7,'0:$" 23.99) "00024.0")
(equal? (format "~1,2,7,'0:$" -12345.678) "-12345.7")
(equal? (format "~1,2,7,'0:$" .153) "00000.2")
(equal? (format "~1,2,7,'0:$" -.01) "-0000.0")
(equal? (format "~1,2,7,'0:$" .0159) "00000.0")
(equal? (format "~1,2,7,'0:$" .0159) "00000.0")
(equal? (format "~1,2,7,'0@:$" 0.0) "+0000.0")
(equal? (format "~1,2,7,'0@:$" -0.0) "-0000.0")
(equal? (format "~1,2,7,'0@:$" 3.4) "+0003.4")
(equal? (format "~1,2,7,'0@:$" 23.99) "+0024.0")
(equal? (format "~1,2,7,'0@:$" -12345.678) "-12345.7")
(equal? (format "~1,2,7,'0@:$" .153) "+0000.2")
(equal? (format "~1,2,7,'0@:$" -.01) "-0000.0")
(equal? (format "~1,2,7,'0@:$" .0159) "+0000.0")
(equal? (format "~1,2,7,'0@:$" .0159) "+0000.0")
(equal? (format "~1,,7,'*@:$" 0.0) "+***0.0")
(equal? (format "~1,,7,'*@:$" -0.0) "-***0.0")
(equal? (format "~1,,7,'*@:$" 3.4) "+***3.4")
(equal? (format "~,2,7,'*@$" 23.99) "*+23.99")
(equal? (format "~1,,7,@$" -12345.678) "-12345.7")
(equal? (format "~1,2,,'*@:$" .153) "+00.2")
(equal? (format "~,,10,'*$" -.01) "*****-0.01")
(equal? (format "~1,,,'*@:$" .0159) "+0.0")
(equal? (format "~,2,7,'*@:$" 0.0) "+*00.00")
(equal? (format "~,2,7,'*@:$" -0.0) "-*00.00")
(equal? (format "~,2,7,'*@:$" .0159) "+*00.02")
; check to see if exact inputs are accepted
(equal? (format "~1,2,7,'0@:$" #e23.99) "+0024.0")
(equal? (format "~$" #e3.4) "3.40")
(equal? (format "~$" 1/3) "0.33")
; check to see if nonreal inputs are rejected
(error? (format "~$" 'a))
(error? (format "~$" 1.0+3.0i))
(error? (format "~$" 1+3i))
)
(mat format-cltl2 ; misc cltl2 tests
(equal? (format "foo") "foo")
(begin (define fmt-x 5) #t)
(equal? (format "The answer is ~D." fmt-x) "The answer is 5.")
(equal? (format "The answer is ~3D." fmt-x) "The answer is 5.")
(equal? (format "The answer is ~3,'0D." fmt-x) "The answer is 005.")
(equal? (format "The answer is ~:D." (expt 47 fmt-x))
"The answer is 229,345,007.")
(begin (define fmt-y "elephant") #t)
(equal? (format "Look at the ~A!" fmt-y) "Look at the elephant!")
(equal? (format "Type ~:C to ~A." #\004 "delete all your files")
"Type ^D to delete all your files.")
(begin (define fmt-n 3) #t)
(equal? (format "~D item~:P found." fmt-n) "3 items found.")
(equal? (format "~R dog~:[s are~; is~] here." fmt-n (= fmt-n 1))
"three dogs are here.")
(equal? (format "~R dog~:*~[s are~; is~:;s are~] here." fmt-n)
"three dogs are here.")
(equal? (format "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." fmt-n)
"Here are three puppies.")
(begin (define fmt-n 1) #t)
(equal? (format "~D item~:P found." fmt-n) "1 item found.")
(equal? (format "~R dog~:[s are~; is~] here." fmt-n (= fmt-n 1))
"one dog is here.")
(equal? (format "~R dog~:*~[s are~; is~:;s are~] here." fmt-n)
"one dog is here.")
(equal? (format "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." fmt-n)
"Here is one puppy.")
(begin (define fmt-n 0) #t)
(equal? (format "~D item~:P found." fmt-n) "0 items found.")
(equal? (format "~R dog~:[s are~; is~] here." fmt-n (= fmt-n 1))
"zero dogs are here.")
(equal? (format "~R dog~:*~[s are~; is~:;s are~] here." fmt-n)
"zero dogs are here.")
(equal? (format "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." fmt-n)
"Here are zero puppies.")
)
; format-slib* tests are adapted from:
;; "formatst.scm" SLIB FORMAT Version 3.0 conformance test
; Written by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de)
;
; This code is in the public domain.
(mat format-slib1
(equal? (format "abc") "abc")
(equal? (format "~a" 10) "10")
(equal? (format "~a" -1.2) "-1.2")
(equal? (format "~a" 'a) "a")
(equal? (format "~a" #t) "#t")
(equal? (format "~a" #f) "#f")
(equal? (format "~a" "abc") "abc")
(equal? (format "~a" '#(1 2 3)) "#(1 2 3)") ; ans was "#(1 2 3)"
(equal? (format "~a" '()) "()")
(equal? (format "~a" '(a)) "(a)")
(equal? (format "~a" '(a b)) "(a b)")
(equal? (format "~a" '(a (b c) d)) "(a (b c) d)")
(equal? (format "~a" '(a . b)) "(a . b)")
)
(mat format-slib2
(equal? (format "~a ~a" 10 20) "10 20")
(equal? (format "~a abc ~a def" 10 20) "10 abc 20 def")
)
(mat format-slib3
(equal? (format "~d" 100) "100")
(equal? (format "~x" 100) "64")
(equal? (format "~o" 100) "144")
(equal? (format "~b" 100) "1100100")
(equal? (format "~@d" 100) "+100")
(equal? (format "~@d" -100) "-100")
(equal? (format "~@x" 100) "+64")
(equal? (format "~@o" 100) "+144")
(equal? (format "~@b" 100) "+1100100")
(equal? (format "~10d" 100) " 100")
(equal? (format "~:d" 123) "123")
(equal? (format "~:d" 1234) "1,234")
(equal? (format "~:d" 12345) "12,345")
(equal? (format "~:d" 123456) "123,456")
(equal? (format "~:d" 12345678) "12,345,678")
(equal? (format "~:d" -123) "-123")
(equal? (format "~:d" -1234) "-1,234")
(equal? (format "~:d" -12345) "-12,345")
(equal? (format "~:d" -123456) "-123,456")
(equal? (format "~:d" -12345678) "-12,345,678")
(equal? (format "~10:d" 1234) " 1,234")
(equal? (format "~10:d" -1234) " -1,234")
(equal? (format "~10,'*d" 100) "*******100")
(equal? (format "~10,,'|:d" 12345678) "12|345|678")
(equal? (format "~10,,,2:d" 12345678) "12,34,56,78")
(equal? (format "~14,'*,'|,4:@d" 12345678) "****+1234|5678")
)
(mat format-slib4 ; ~r tests
(equal? (format "~10r" 100) "100")
(equal? (format "~2r" 100) "1100100")
(equal? (format "~8r" 100) "144")
(equal? (format "~16r" 100) "64")
(equal? (format "~16,10,'*r" 100) "********64")
(equal? (format "~@r" 4) "IV")
(equal? (format "~@r" 19) "XIX")
(equal? (format "~@r" 50) "L")
(equal? (format "~@r" 100) "C")
(equal? (format "~@r" 1000) "M")
(equal? (format "~@r" 99) "XCIX")
(equal? (format "~@r" 1994) "MCMXCIV")
; old roman numeral test
(equal? (format "~:@r" 4) "IIII")
(equal? (format "~:@r" 5) "V")
(equal? (format "~:@r" 10) "X")
(equal? (format "~:@r" 9) "VIIII")
; cardinal/ordinal English number test
(equal? (format "~r" 4) "four")
(equal? (format "~r" 10) "ten")
(equal? (format "~r" 19) "nineteen")
(equal? (format "~r" 1984) "nineteen hundred eighty-four") ; ans was "one thousand, nine hundred eighty-four")
(equal? (format "~:r" -1984) "minus nineteen hundred eighty-fourth") ; ans was "minus one thousand, nine hundred eighty-fourth")
)
(mat format-slib5 ; character tests
(equal? (format "~c" #\a) "a")
(equal? (format "~@c" #\a) "#\\a")
(equal? (format "~@c" (integer->char 32)) "#\\space")
(equal? (format "~@c" (integer->char 0)) "#\\nul")
; (equal? (format "~@c" (integer->char 27)) "#\\esc")
; (equal? (format "~@c" (integer->char 127)) "#\\del")
; (equal? (format "~@c" (integer->char 128)) "#\\200")
; (equal? (format "~@c" (integer->char 255)) "#\\377")
; (equal? (format "~65c") "A")
; (equal? (format "~7@c") "#\\bel")
(equal? (format "~:c" #\a) "a")
(equal? (format "~:c" (integer->char 1)) "^A")
(equal? (format "~:c" (integer->char 27)) "<esc>")
; (equal? (format "~7:c") "^G")
; (equal? (format "~:c" (integer->char 128)) "#\\200")
; (equal? (format "~:c" (integer->char 127)) "#\\177")
; (equal? (format "~:c" (integer->char 255)) "#\\377")
)
(mat format-slib6 ; plural test
(equal? (format "test~p" 1) "test")
(equal? (format "test~p" 2) "tests")
(equal? (format "test~p" 0) "tests")
(equal? (format "tr~@p" 1) "try")
(equal? (format "tr~@p" 2) "tries")
(equal? (format "tr~@p" 0) "tries")
(equal? (format "~a test~:p" 10) "10 tests")
(equal? (format "~a test~:p" 1) "1 test")
)
(mat format-slib-slib7 ; tilde tests
(equal? (format "~~~~") "~~")
(equal? (format "~3~") "~~~")
)
(mat format-slib8 ; whitespace character test
(equal? (format "~%") "\n")
(equal? (format "~3%") "\n\n\n")
(equal? (format "~&") "")
(equal? (format "abc~&") "abc\n")
(equal? (format "abc~&def") "abc\ndef")
(equal? (format "~3&") "\n\n")
(equal? (format "abc~3&") "abc\n\n\n") ; ans was "abc\n\n\n"
; not yet (equal? (format "~_~_~_") " ")
; not yet (equal? (format "~3_") " ")
)
(mat format-slib9 ; tabulate test
; removed leading ~0& from control strings in following
(equal? (format "~3t") " ")
(equal? (format "~10t") " ") ; ans was ""
(equal? (format "1234567890~,8tABC") "1234567890 ABC")
(equal? (format "1234567890~0,8tABC") "1234567890 ABC")
(equal? (format "1234567890~1,8tABC") "1234567890 ABC")
(equal? (format "1234567890~2,8tABC") "1234567890 ABC") ; ans was "1234567890ABC"
(equal? (format "1234567890~3,8tABC") "1234567890 ABC")
(equal? (format "1234567890~4,8tABC") "1234567890 ABC")
(equal? (format "1234567890~5,8tABC") "1234567890 ABC")
(equal? (format "1234567890~6,8tABC") "1234567890 ABC")
(equal? (format "1234567890~7,8tABC") "1234567890 ABC")
(equal? (format "1234567890~8,8tABC") "1234567890 ABC")
(equal? (format "1234567890~9,8tABC") "1234567890 ABC")
(equal? (format "1234567890~10,8tABC") "1234567890 ABC") ; ans was "1234567890ABC"
(equal? (format "1234567890~11,8tABC") "1234567890 ABC")
(equal? (format "12345~,8tABCDE~,8tXYZ") "12345 ABCDE XYZ")
(equal? (format "~,8t+++~,8t===") " +++ ===") ; ans was " +++ ==="
; (equal? (format "ABC~,8,'.tDEF") "ABC......DEF")
(equal? (format "~3,8@tABC") " ABC")
(equal? (format "1234~3,8@tABC") "1234 ABC")
(equal? (format "12~3,8@tABC~3,8@tDEF") "12 ABC DEF")
)
(mat format-slib10 ; indirection test
(equal? (format "~a ~? ~a" 10 "~a ~a" '(20 30) 40) "10 20 30 40")
(equal? (format "~a ~@? ~a" 10 "~a ~a" 20 30 40) "10 20 30 40")
)
(mat format-slib11
(equal? (format "~10a" "abc") "abc ")
(equal? (format "~10@a" "abc") " abc")
(equal? (format "~10a" "0123456789abc") "0123456789abc")
(equal? (format "~10@a" "0123456789abc") "0123456789abc")
)
(mat format-slib12 ; pad character test
(equal? (format "~10,,,'*a" "abc") "abc*******")
(equal? (format "~10,,,'Xa" "abc") "abcXXXXXXX")
; bad test (equal? (format "~10,,,42a" "abc") "abc*******")
(equal? (format "~10,,,'*@a" "abc") "*******abc")
(equal? (format "~10,,3,'*a" "abc") "abc*******")
(equal? (format "~10,,3,'*a" "0123456789abc") "0123456789abc***") ; min. padchar length
(equal? (format "~10,,3,'*@a" "0123456789abc") "***0123456789abc")
)
(mat format-slib13 ; colinc, minpad padding test
(equal? (format "~10,8,0,'*a" 123) "123********")
(equal? (format "~10,9,0,'*a" 123) "123*********")
(equal? (format "~10,10,0,'*a" 123) "123**********")
(equal? (format "~10,11,0,'*a" 123) "123***********")
(equal? (format "~8,1,0,'*a" 123) "123*****")
(equal? (format "~8,2,0,'*a" 123) "123******")
(equal? (format "~8,3,0,'*a" 123) "123******")
(equal? (format "~8,4,0,'*a" 123) "123********")
(equal? (format "~8,5,0,'*a" 123) "123*****")
(equal? (format "~8,1,3,'*a" 123) "123*****")
(equal? (format "~8,1,5,'*a" 123) "123*****")
(equal? (format "~8,1,6,'*a" 123) "123******")
(equal? (format "~8,1,9,'*a" 123) "123*********")
)
(mat format-slib14 ; slashify test
(equal? (format "~s" "abc") "\"abc\"")
(equal? (format "~s" "abc \\ abc") "\"abc \\\\ abc\"")
(equal? (format "~a" "abc \\ abc") "abc \\ abc")
(equal? (format "~s" "abc \" abc") "\"abc \\\" abc\"")
(equal? (format "~a" "abc \" abc") "abc \" abc")
(equal? (format "~s" #\space) "#\\space")
(equal? (format "~s" #\newline) "#\\newline")
(equal? (format "~s" #\tab) "#\\tab") ; ans was "#\\ht"
(equal? (format "~s" #\a) "#\\a")
(equal? (format "~a" '(a "b" c)) "(a b c)") ; ans was "(a \"b\" c)"
)
(mat format-slib15 ; continuation line test
(equal? (format "abc~\n 123") "abc123")
(equal? (format "abc~\n ") "abc")
(equal? (format "abc~:\n def") "abc def")
(equal? (format "abc~@\n def") "abc\ndef")
)
(mat format-slib16 ; string case conversion
(equal? (format "~a ~(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc hello world xyz")
(equal? (format "~a ~:(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello World xyz")
(equal? (format "~a ~@(~a~) ~a" "abc" "HELLO WORLD" "xyz") "abc Hello world xyz")
(equal? (format "~a ~:@(~a~) ~a" "abc" "hello world" "xyz") "abc HELLO WORLD xyz")
(equal? (format "~:@(~a~)" '(a b c)) "(A B C)")
(equal? (format "~:@(~x~)" 255) "FF")
(equal? (format "~:@(~p~)" 2) "S")
; (test `("~:@(~a~)" ,display) (string-upcase (format:iobj->str display)))
(equal? (format "~:(~a ~a ~a~) ~a" "abc" "xyz" "123" "world") "Abc Xyz 123 world")
)
(mat format-slib17 ; variable parameter
(equal? (format "~va" 10 "abc") "abc ")
; changed 42 to #\* below
(equal? (format "~v,,,va" 10 #\* "abc") "abc*******")
)
(mat format-slib18 ; number of remaining arguments as parameter
(equal? (format "~#,,,'*@a ~a ~a ~a" 1 1 1 1) "***1 1 1 1")
)
(mat format-slib19 ; argument jumping
(equal? (format "~a ~* ~a" 10 20 30) "10 30")
(equal? (format "~a ~2* ~a" 10 20 30 40) "10 40")
(equal? (format "~a ~:* ~a" 10) "10 10")
(equal? (format "~a ~a ~2:* ~a ~a" 10 20) "10 20 10 20")
(equal? (format "~a ~a ~@* ~a ~a" 10 20) "10 20 10 20")
(equal? (format "~a ~a ~4@* ~a ~a" 10 20 30 40 50 60) "10 20 50 60")
)
(mat format-slib20 ; conditionals
(equal? (format "~[abc~;xyz~]" 0) "abc")
(equal? (format "~[abc~;xyz~]" 1) "xyz")
(equal? (format "~[abc~;xyz~:;456~]" 99) "456")
(equal? (format "~0[abc~;xyz~:;456~]") "abc")
(equal? (format "~1[abc~;xyz~:;456~] ~a" 100) "xyz 100")
(equal? (format "~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]") "no arg")
(equal? (format "~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10) "10")
(equal? (format "~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20)
"10 and 20")
(equal? (format "~#[no arg~;~a~;~a and ~a~;~a, ~a and ~a~]" 10 20 30)
"10, 20 and 30")
(equal? (format "~:[hello~;world~] ~a" #t 10) "world 10")
(equal? (format "~:[hello~;world~] ~a" #f 10) "hello 10")
(equal? (format "~@[~a tests~]" #f) "")
(equal? (format "~@[~a tests~]" 10) "10 tests")
(equal? (format "~@[~a test~:p~] ~a" 10 'done) "10 tests done")
(equal? (format "~@[~a test~:p~] ~a" 1 'done) "1 test done")
(equal? (format "~@[~a test~:p~] ~a" 0 'done) "0 tests done")
(equal? (format "~@[~a test~:p~] ~a" #f 'done) " done")
(equal? (format "~@[ level = ~d~]~@[ length = ~d~]" #f 5) " length = 5")
(equal? (format "~[abc~;~[4~;5~;6~]~;xyz~]" 0) "abc") ; nested conditionals (irrghh)
(equal? (format "~[abc~;~[4~;5~;6~]~;xyz~]" 2) "xyz")
(equal? (format "~[abc~;~[4~;5~;6~]~;xyz~]" 1 2) "6")
; cltl2 tests
(begin
(define foo "Items:~#[ none~; ~S~; ~S and ~S~
~:;~@{~#[~; and~] ~S~^,~}~].")
(string? foo))
(equal? (format foo) "Items: none.")
(equal? (format foo 'foo) "Items: foo.")
(equal? (format foo 'foo 'bar) "Items: foo and bar.")
(equal? (format foo 'foo 'bar 'baz) "Items: foo, bar, and baz.")
(equal? (format foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")
)
(mat format-slib21 ; iteration
(equal? (format "~{ ~a ~}" '(a b c)) " a b c ")
(equal? (format "~{ ~a ~}" '()) "")
(equal? (format "~{ ~a ~5,,,'*a~}" '(a b c d)) " a b**** c d****")
(equal? (format "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 c,3 ")
(equal? (format "~2{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 ")
(equal? (format "~3{~a ~} ~a" '(a b c d e) 100) "a b c 100")
(equal? (format "~0{~a ~} ~a" '(a b c d e) 100) " 100")
; replaced (c d e f) with (c d) below
(equal? (format "~:{ ~a,~a ~}" '((a b) (c d) (g h))) " a,b c,d g,h ")
; replaced (c d e f) with (c d) below
(equal? (format "~2:{ ~a,~a ~}" '((a b) (c d) (g h))) " a,b c,d ")
(equal? (format "~@{ ~a,~a ~}" 'a 1 'b 2 'c 3) " a,1 b,2 c,3 ")
(equal? (format "~2@{ ~a,~a ~} <~a|~a>" 'a 1 'b 2 'c 3) " a,1 b,2 <c|3>")
(equal? (format "~:@{ ~a,~a ~}" '(a 1) '(b 2) '(c 3)) " a,1 b,2 c,3 ")
(equal? (format "~2:@{ ~a,~a ~} ~a" '(a 1) '(b 2) '(c 3)) " a,1 b,2 (c 3)")
(equal? (format "~{~}" "<~a,~a>" '(a 1 b 2 c 3)) "<a,1><b,2><c,3>")
(equal? (format "~{ ~a ~{<~a>~}~} ~a" '(a (1 2) b (3 4)) 10)
" a <1><2> b <3><4> 10")
)
(mat format-slib22 ; up and out
(equal? (format "abc ~^ xyz") "abc ")
(equal? (format "~@(abc ~^ xyz~) ~a" 10) "Abc xyz 10") ; ans was "ABC xyz 10"
(equal? (format "done. ~^ ~d warning~:p. ~^ ~d error~:p.") "done. ")
(equal? (format "done. ~^ ~d warning~:p. ~^ ~d error~:p." 10)
"done. 10 warnings. ")
(equal? (format "done. ~^ ~d warning~:p. ~^ ~d error~:p." 10 1)
"done. 10 warnings. 1 error.")
(equal? (format "~{ ~a ~^<~a>~} ~a" '(a b c d e f) 10)
" a <b> c <d> e <f> 10")
(equal? (format "~{ ~a ~^<~a>~} ~a" '(a b c d e) 10)
" a <b> c <d> e 10")
(equal? (format "abc~0^ xyz") "abc")
(equal? (format "abc~9^ xyz") "abc xyz")
(equal? (format "abc~7,4^ xyz") "abc xyz")
(equal? (format "abc~7,7^ xyz") "abc")
; (equal? (format "abc~3,7,9^ xyz") "abc")
; (equal? (format "abc~8,7,9^ xyz") "abc xyz")
; (equal? (format "abc~3,7,5^ xyz") "abc xyz")
)
(mat format-slib23 ; complexity tests
(begin
(define fmt "Items:~#[ none~; ~a~; ~a and ~a~:;~@{~#[~; and~] ~a~^,~}~].")
(string? fmt))
(equal? (format fmt) "Items: none.")
(equal? (format fmt 'foo) "Items: foo.")
(equal? (format fmt 'foo 'bar) "Items: foo and bar.")
(equal? (format fmt 'foo 'bar 'baz) "Items: foo, bar, and baz.")
(equal? (format fmt 'foo 'bar 'baz 'zok) "Items: foo, bar, baz, and zok.")
)
(mat format-slib24 ; fixed floating points
(equal? (format "~6,2f" 3.14159) " 3.14")
(equal? (format "~6,1f" 3.14159) " 3.1")
(equal? (format "~6,0f" 3.14159) " 3.")
(equal? (format "~5,1f" 0) " 0.0")
(equal? (format "~10,7f" 3.14159) " 3.1415900")
(equal? (format "~10,7f" -3.14159) "-3.1415900")
(equal? (format "~10,7@f" 3.14159) "+3.1415900")
(equal? (format "~6,3f" 0.0) " 0.000")
(equal? (format "~6,4f" 0.007) "0.0070")
(equal? (format "~6,3f" 0.007) " 0.007")
(equal? (format "~6,2f" 0.007) " 0.01")
(equal? (format "~3,2f" 0.007) ".01")
(equal? (format "~3,2f" -0.007) "-.01")
(equal? (format "~6,2,,,'*f" 3.14159) "**3.14")
(equal? (format "~6,3,,'?f" 12345.56789) "??????")
(equal? (format "~6,3f" 12345.6789) "12345.679")
(equal? (format "~,3f" 12345.6789) "12345.679")
(equal? (format "~,3f" 9.9999) "10.000")
(equal? (format "~6f" 23.4) " 23.4")
(equal? (format "~6f" 1234.5) "1234.5")
(equal? (format "~6f" 12345678) "12345678.") ; ans was "12345678.0"
(equal? (format "~6,,,'?f" 12345678) "??????")
(equal? (format "~6f" 123.56789) "123.57")
(equal? (format "~6f" 123.0) " 123.0")
(equal? (format "~6f" -123.0) "-123.0")
(equal? (format "~6f" 0.0) " 0.0")
(equal? (format "~3f" 3.141) "3.1")
(equal? (format "~2f" 3.141) "3.")
(equal? (format "~1f" 3.141) "3.") ; ans was "3.141"
(equal? (format "~f" 123.56789) "123.56789")
(equal? (format "~f" -314.0) "-314.0")
(equal? (format "~f" 1e4) "10000.0")
(equal? (format "~f" -1.23e10) "-12300000000.0")
(equal? (format "~f" 1e-4) "0.0001")
(equal? (format "~f" -1.23e-10) "-0.000000000123")
(equal? (format "~@f" 314.0) "+314.0")
(equal? (format "~,,3f" 0.123456) "123.456")
(equal? (format "~,,-3f" -123.456) "-0.123456")
(equal? (format "~5,,3f" 0.123456) "123.5")
)
(mat format-slib25 ; exponent floating points
(equal? (format "~e" 3.14159) "3.14159e+0")
(equal? (format "~e" 0.00001234) "1.234e-5")
(equal? (format "~,,,0e" 0.00001234) "0.1234e-4")
(equal? (format "~,3e" 3.14159) "3.142e+0")
(equal? (format "~,3@e" 3.14159) "+3.142e+0")
(equal? (format "~,3@e" 0.0) "+0.000e+0")
(equal? (format "~,0e" 3.141) "3.e+0")
(equal? (format "~,3,,0e" 3.14159) "0.314e+1")
(equal? (format "~,5,3,-2e" 3.14159) "0.00314e+003")
(equal? (format "~,5,3,-5e" -3.14159) "-0.000003e+006") ; ans was "-0.00000e+006"; this is a case where we have to grow d to accommodate given k
(equal? (format "~,5,2,2e" 3.14159) "31.4159e-01")
(equal? (format "~,5,2,,,,'ee" 0.0) "0.00000e+00")
(equal? (format "~12,3e" -3.141) " -3.141e+0")
(equal? (format "~12,3,,,,'#e" -3.141) "###-3.141e+0")
(equal? (format "~10,2e" -1.236e-4) " -1.24e-4")
(equal? (format "~5,3e" -3.141) "-3.141e+0")
(equal? (format "~5,3,,,'*e" -3.141) "*****")
(equal? (format "~3e" 3.14159) "3.e+0") ; ans was "3.14159e+0"
(equal? (format "~4e" 3.14159) "3.e+0") ; ans was "3.14159e+0"
(equal? (format "~5e" 3.14159) "3.e+0")
(equal? (format "~5,,,,'*e" 3.14159) "3.e+0")
(equal? (format "~6e" 3.14159) "3.1e+0")
(equal? (format "~7e" 3.14159) "3.14e+0")
(equal? (format "~7e" -3.14159) "-3.1e+0")
(equal? (format "~8e" 3.14159) "3.142e+0")
(equal? (format "~9e" 3.14159) "3.1416e+0")
(equal? (format "~9,,,,,,'ee" 3.14159) "3.1416e+0")
(equal? (format "~10e" 3.14159) "3.14159e+0")
(equal? (format "~11e" 3.14159) " 3.14159e+0")
(equal? (format "~12e" 3.14159) " 3.14159e+0")
(equal? (format "~13,6,2,-5e" 3.14159) " 0.000003e+06")
(equal? (format "~13,6,2,-4e" 3.14159) " 0.000031e+05")
(equal? (format "~13,6,2,-3e" 3.14159) " 0.000314e+04")
(equal? (format "~13,6,2,-2e" 3.14159) " 0.003142e+03")
(equal? (format "~13,6,2,-1e" 3.14159) " 0.031416e+02")
(equal? (format "~13,6,2,0e" 3.14159) " 0.314159e+01")
(equal? (format "~13,6,2,1e" 3.14159) " 3.141590e+00")
(equal? (format "~13,6,2,2e" 3.14159) " 31.41590e-01")
(equal? (format "~13,6,2,3e" 3.14159) " 314.1590e-02")
(equal? (format "~13,6,2,4e" 3.14159) " 3141.590e-03")
(equal? (format "~13,6,2,5e" 3.14159) " 31415.90e-04")
(equal? (format "~13,6,2,6e" 3.14159) " 314159.0e-05")
(equal? (format "~13,6,2,7e" 3.14159) " 3141590.e-06")
(equal? (format "~13,6,2,8e" 3.14159) "31415900.e-07")
(equal? (format "~7,3,,-2e" 0.001) ".001e+0")
(equal? (format "~8,3,,-2@e" 0.001) "+.001e+0")
(equal? (format "~8,3,,-2@e" -0.001) "-.001e+0")
(equal? (format "~8,3,,-2e" 0.001) "0.001e+0")
(equal? (format "~7,,,-2e" 0.001) ".001e+0") ; ans was "0.00e+0"
(equal? (format "~12,3,1e" 3.14159e12) " 3.142e+12")
(equal? (format "~12,3,1,,'*e" 3.14159e12) "************")
(equal? (format "~5,3,1e" 3.14159e12) "3.142e+12")
)
(mat format-slib26 ; general floating point (this test is from Steele's CL book)
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
0.0314159 0.0314159 0.0314159 0.0314159)
" 3.14e-2|314.2$-04|0.314e-01| 3.14e-2")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
0.314159 0.314159 0.314159 0.314159)
" 0.31 |0.314 |0.314 | 0.31 ")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
3.14159 3.14159 3.14159 3.14159)
" 3.1 | 3.14 | 3.14 | 3.1 ")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
31.4159 31.4159 31.4159 31.4159)
" 31. | 31.4 | 31.4 | 31. ")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
314.159 314.159 314.159 314.159)
" 3.14e+2| 314. | 314. | 3.14e+2")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
3141.59 3141.59 3141.59 3141.59)
" 3.14e+3|314.2$+01|0.314e+04| 3.14e+3")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
3.14e12 3.14e12 3.14e12 3.14e12)
"*********|314.0$+10|0.314e+13| 3.14e+12")
(equal? (format "~9,2,1,,'*g|~9,3,2,3,'?,,'$g|~9,3,2,0,'%g|~9,2g"
3.14e120 3.14e120 3.14e120 3.14e120)
"*********|?????????|%%%%%%%%%|3.14e+120")
; the fixed-format in the following were followed by the apparently
; required backpadding that we omit when w is not supplied
(equal? (format "~g" 0.0) "0.")
(equal? (format "~g" 0.1) "0.1")
(equal? (format "~g" 0.01) "1.0e-2")
(equal? (format "~g" 123.456) "123.456")
(equal? (format "~g" 123456.7) "123456.7")
(equal? (format "~g" 123456.78) "123456.78")
(equal? (format "~g" 0.9282) "0.9282")
(equal? (format "~g" 0.09282) "9.282e-2")
(equal? (format "~g" 1) "1.")
(equal? (format "~g" 12) "12.")
)
(mat format-slib27 ; dollar floating point
(equal? (format "~$" 1.23) "1.23")
(equal? (format "~$" 1.2) "1.20")
(equal? (format "~$" 0.0) "0.00")
(equal? (format "~$" 9.999) "10.00")
(equal? (format "~3$" 9.9999) "10.000")
(equal? (format "~,4$" 3.2) "0003.20")
(equal? (format "~,4$" 10000.2) "10000.20")
(equal? (format "~,4,10$" 3.2) " 0003.20")
(equal? (format "~,4,10@$" 3.2) " +0003.20")
(equal? (format "~,4,10:@$" 3.2) "+ 0003.20")
(equal? (format "~,4,10:$" -3.2) "- 0003.20")
(equal? (format "~,4,10$" -3.2) " -0003.20")
(equal? (format "~,,10@$" 3.2) " +3.20")
(equal? (format "~,,10:@$" 3.2) "+ 3.20")
(equal? (format "~,,10:@$" -3.2) "- 3.20")
(equal? (format "~,,10,'_@$" 3.2) "_____+3.20")
(equal? (format "~,,4$" 1234.4) "1234.40")
)