giles
fa600442d6
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
123 lines
3.1 KiB
Plaintext
123 lines
3.1 KiB
Plaintext
;; String>>format: and printOn: tests.
|
|
|
|
(set! st-test-pass 0)
|
|
(set! st-test-fail 0)
|
|
(set! st-test-fails (list))
|
|
|
|
(st-bootstrap-classes!)
|
|
(define ev (fn (src) (smalltalk-eval src)))
|
|
(define evp (fn (src) (smalltalk-eval-program src)))
|
|
|
|
;; ── 1. String>>format: ──
|
|
(st-test "format: single placeholder"
|
|
(ev "'Hello, {1}!' format: #('World')")
|
|
"Hello, World!")
|
|
|
|
(st-test "format: multiple placeholders"
|
|
(ev "'{1} + {2} = {3}' format: #(1 2 3)")
|
|
"1 + 2 = 3")
|
|
|
|
(st-test "format: out-of-order"
|
|
(ev "'{2} {1}' format: #('first' 'second')")
|
|
"second first")
|
|
|
|
(st-test "format: repeated index"
|
|
(ev "'{1}-{1}-{1}' format: #(#a)")
|
|
"a-a-a")
|
|
|
|
(st-test "format: empty source"
|
|
(ev "'' format: #()") "")
|
|
|
|
(st-test "format: no placeholders"
|
|
(ev "'plain text' format: #()") "plain text")
|
|
|
|
(st-test "format: unmatched {"
|
|
(ev "'open { brace' format: #('x')")
|
|
"open { brace")
|
|
|
|
(st-test "format: out-of-range index keeps literal"
|
|
(ev "'{99}' format: #('hi')")
|
|
"{99}")
|
|
|
|
(st-test "format: numeric arg"
|
|
(ev "'value: {1}' format: #(42)")
|
|
"value: 42")
|
|
|
|
(st-test "format: float arg"
|
|
(ev "'pi ~ {1}' format: #(3.14)")
|
|
"pi ~ 3.14")
|
|
|
|
;; ── 2. printOn: writes printString to stream ──
|
|
(st-test "printOn: writes int via stream"
|
|
(evp
|
|
"| s |
|
|
s := WriteStream on: (Array new: 0).
|
|
42 printOn: s.
|
|
^ s contents")
|
|
(list "4" "2"))
|
|
|
|
(st-test "printOn: writes string"
|
|
(evp
|
|
"| s |
|
|
s := WriteStream on: (Array new: 0).
|
|
'hi' printOn: s.
|
|
^ s contents")
|
|
(list "'" "h" "i" "'"))
|
|
|
|
(st-test "printOn: returns receiver"
|
|
(evp
|
|
"| s |
|
|
s := WriteStream on: (Array new: 0).
|
|
^ 99 printOn: s")
|
|
99)
|
|
|
|
;; ── 3. Universal printString fallback for user instances ──
|
|
(st-class-define! "Cat" "Object" (list))
|
|
(st-class-define! "Animal" "Object" (list))
|
|
|
|
(st-test "printString of vowel-initial class"
|
|
(evp "^ Animal new printString")
|
|
"an Animal")
|
|
|
|
(st-test "printString of consonant-initial class"
|
|
(evp "^ Cat new printString")
|
|
"a Cat")
|
|
|
|
(st-test "user override of printString wins"
|
|
(begin
|
|
(st-class-add-method! "Cat" "printString"
|
|
(st-parse-method "printString ^ #miaow asString"))
|
|
(str (evp "^ Cat new printString")))
|
|
"miaow")
|
|
|
|
;; ── 4. printOn: on user instance with overridden printString ──
|
|
(st-test "printOn: respects user-overridden printString"
|
|
(evp
|
|
"| s |
|
|
s := WriteStream on: (Array new: 0).
|
|
Cat new printOn: s.
|
|
^ s contents")
|
|
(list "m" "i" "a" "o" "w"))
|
|
|
|
;; ── 5. printString for class-refs ──
|
|
(st-test "Class printString is its name"
|
|
(ev "Animal printString") "Animal")
|
|
|
|
;; ── 6. format: combined with printString ──
|
|
(st-class-define! "Box" "Object" (list "n"))
|
|
(st-class-add-method! "Box" "n:"
|
|
(st-parse-method "n: v n := v. ^ self"))
|
|
(st-class-add-method! "Box" "printString"
|
|
(st-parse-method "printString ^ '<' , n printString , '>'"))
|
|
|
|
(st-test "format: with custom printString in arg"
|
|
(str (evp
|
|
"| b | b := Box new n: 7.
|
|
^ '({1})' format: (Array with: b printString)"))
|
|
"(<7>)")
|
|
|
|
(st-class-add-class-method! "Array" "with:"
|
|
(st-parse-method "with: x | a | a := Array new: 1. a at: 1 put: x. ^ a"))
|
|
|
|
(list st-test-pass st-test-fail)
|