smalltalk: Stream hierarchy + 21 tests; test.sh timeout 60s -> 180s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -587,6 +587,98 @@
|
|||||||
i := i + 1].
|
i := i + 1].
|
||||||
^ self"))
|
^ self"))
|
||||||
(st-class-define! "IdentityDictionary" "Dictionary" (list))
|
(st-class-define! "IdentityDictionary" "Dictionary" (list))
|
||||||
|
;; ── Stream hierarchy ──
|
||||||
|
;; Streams wrap a collection with a 0-based `position`. Read/peek
|
||||||
|
;; advance via `at:` (1-indexed Smalltalk-style) on the collection.
|
||||||
|
;; Write streams require a mutable collection (Array works; String
|
||||||
|
;; doesn't, see Phase 5 follow-up).
|
||||||
|
(st-class-define! "Stream" "Object" (list))
|
||||||
|
(st-class-define! "PositionableStream" "Stream" (list "collection" "position"))
|
||||||
|
(st-class-define! "ReadStream" "PositionableStream" (list))
|
||||||
|
(st-class-define! "WriteStream" "PositionableStream" (list))
|
||||||
|
(st-class-define! "ReadWriteStream" "WriteStream" (list))
|
||||||
|
(st-class-add-class-method! "ReadStream" "on:"
|
||||||
|
(st-parse-method "on: aColl ^ super new on: aColl"))
|
||||||
|
(st-class-add-class-method! "WriteStream" "on:"
|
||||||
|
(st-parse-method "on: aColl ^ super new on: aColl"))
|
||||||
|
(st-class-add-class-method! "WriteStream" "with:"
|
||||||
|
(st-parse-method
|
||||||
|
"with: aColl
|
||||||
|
| s |
|
||||||
|
s := super new on: aColl.
|
||||||
|
s setToEnd.
|
||||||
|
^ s"))
|
||||||
|
(st-class-add-class-method! "ReadWriteStream" "on:"
|
||||||
|
(st-parse-method "on: aColl ^ super new on: aColl"))
|
||||||
|
(st-class-add-method! "PositionableStream" "on:"
|
||||||
|
(st-parse-method
|
||||||
|
"on: aColl collection := aColl. position := 0. ^ self"))
|
||||||
|
(st-class-add-method! "PositionableStream" "atEnd"
|
||||||
|
(st-parse-method "atEnd ^ position >= collection size"))
|
||||||
|
(st-class-add-method! "PositionableStream" "position"
|
||||||
|
(st-parse-method "position ^ position"))
|
||||||
|
(st-class-add-method! "PositionableStream" "position:"
|
||||||
|
(st-parse-method "position: n position := n. ^ self"))
|
||||||
|
(st-class-add-method! "PositionableStream" "reset"
|
||||||
|
(st-parse-method "reset position := 0. ^ self"))
|
||||||
|
(st-class-add-method! "PositionableStream" "setToEnd"
|
||||||
|
(st-parse-method "setToEnd position := collection size. ^ self"))
|
||||||
|
(st-class-add-method! "PositionableStream" "contents"
|
||||||
|
(st-parse-method "contents ^ collection"))
|
||||||
|
(st-class-add-method! "PositionableStream" "skip:"
|
||||||
|
(st-parse-method "skip: n position := position + n. ^ self"))
|
||||||
|
(st-class-add-method! "ReadStream" "next"
|
||||||
|
(st-parse-method
|
||||||
|
"next
|
||||||
|
self atEnd ifTrue: [^ nil].
|
||||||
|
position := position + 1.
|
||||||
|
^ collection at: position"))
|
||||||
|
(st-class-add-method! "ReadStream" "peek"
|
||||||
|
(st-parse-method
|
||||||
|
"peek
|
||||||
|
self atEnd ifTrue: [^ nil].
|
||||||
|
^ collection at: position + 1"))
|
||||||
|
(st-class-add-method! "ReadStream" "upToEnd"
|
||||||
|
(st-parse-method
|
||||||
|
"upToEnd
|
||||||
|
| result |
|
||||||
|
result := Array new: 0.
|
||||||
|
[self atEnd] whileFalse: [result add: self next].
|
||||||
|
^ result"))
|
||||||
|
(st-class-add-method! "ReadStream" "next:"
|
||||||
|
(st-parse-method
|
||||||
|
"next: n
|
||||||
|
| result i |
|
||||||
|
result := Array new: 0.
|
||||||
|
i := 0.
|
||||||
|
[(i < n) and: [self atEnd not]] whileTrue: [
|
||||||
|
result add: self next.
|
||||||
|
i := i + 1].
|
||||||
|
^ result"))
|
||||||
|
(st-class-add-method! "WriteStream" "nextPut:"
|
||||||
|
(st-parse-method
|
||||||
|
"nextPut: anObject
|
||||||
|
collection add: anObject.
|
||||||
|
position := position + 1.
|
||||||
|
^ anObject"))
|
||||||
|
(st-class-add-method! "WriteStream" "nextPutAll:"
|
||||||
|
(st-parse-method
|
||||||
|
"nextPutAll: aCollection
|
||||||
|
aCollection do: [:e | self nextPut: e].
|
||||||
|
^ aCollection"))
|
||||||
|
;; ReadWriteStream inherits from WriteStream + ReadStream behaviour;
|
||||||
|
;; for the simple linear-position model, both nextPut: and next work.
|
||||||
|
(st-class-add-method! "ReadWriteStream" "next"
|
||||||
|
(st-parse-method
|
||||||
|
"next
|
||||||
|
self atEnd ifTrue: [^ nil].
|
||||||
|
position := position + 1.
|
||||||
|
^ collection at: position"))
|
||||||
|
(st-class-add-method! "ReadWriteStream" "peek"
|
||||||
|
(st-parse-method
|
||||||
|
"peek
|
||||||
|
self atEnd ifTrue: [^ nil].
|
||||||
|
^ collection at: position + 1"))
|
||||||
"ok")))
|
"ok")))
|
||||||
|
|
||||||
;; Initialise on load. Tests can re-bootstrap to reset state.
|
;; Initialise on load. Tests can re-bootstrap to reset state.
|
||||||
|
|||||||
@@ -71,7 +71,7 @@ EPOCHS
|
|||||||
EPOCHS
|
EPOCHS
|
||||||
fi
|
fi
|
||||||
|
|
||||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
|
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
|
||||||
rm -f "$TMPFILE"
|
rm -f "$TMPFILE"
|
||||||
|
|
||||||
# Final epoch's value: either (ok N (P F)) on one line or
|
# Final epoch's value: either (ok N (P F)) on one line or
|
||||||
@@ -123,7 +123,7 @@ EPOCHS
|
|||||||
(eval "(map (fn (f) (get f :name)) st-test-fails)")
|
(eval "(map (fn (f) (get f :name)) st-test-fails)")
|
||||||
EPOCHS
|
EPOCHS
|
||||||
fi
|
fi
|
||||||
FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok [0-9]+ \(' | tail -1 || true)
|
FAILS=$(timeout 180 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok [0-9]+ \(' | tail -1 || true)
|
||||||
rm -f "$TMPFILE2"
|
rm -f "$TMPFILE2"
|
||||||
echo " $FAILS"
|
echo " $FAILS"
|
||||||
elif [ "$VERBOSE" = "1" ]; then
|
elif [ "$VERBOSE" = "1" ]; then
|
||||||
|
|||||||
159
lib/smalltalk/tests/streams.sx
Normal file
159
lib/smalltalk/tests/streams.sx
Normal file
@@ -0,0 +1,159 @@
|
|||||||
|
;; Stream hierarchy tests — ReadStream / WriteStream / ReadWriteStream
|
||||||
|
;; built on a `collection` + `position` pair. Reads use Smalltalk's
|
||||||
|
;; 1-indexed `at:`; writes use the collection's `add:`.
|
||||||
|
|
||||||
|
(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. Class hierarchy ──
|
||||||
|
(st-test "ReadStream < PositionableStream"
|
||||||
|
(st-class-inherits-from? "ReadStream" "PositionableStream") true)
|
||||||
|
(st-test "WriteStream < PositionableStream"
|
||||||
|
(st-class-inherits-from? "WriteStream" "PositionableStream") true)
|
||||||
|
(st-test "ReadWriteStream < WriteStream"
|
||||||
|
(st-class-inherits-from? "ReadWriteStream" "WriteStream") true)
|
||||||
|
|
||||||
|
;; ── 2. ReadStream basics ──
|
||||||
|
(st-test "ReadStream next" (evp "^ (ReadStream on: #(1 2 3)) next") 1)
|
||||||
|
|
||||||
|
(st-test "ReadStream sequential reads"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(10 20 30).
|
||||||
|
^ {s next. s next. s next}")
|
||||||
|
(list 10 20 30))
|
||||||
|
|
||||||
|
(st-test "ReadStream atEnd"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1 2).
|
||||||
|
s next. s next.
|
||||||
|
^ s atEnd")
|
||||||
|
true)
|
||||||
|
|
||||||
|
(st-test "ReadStream next past end returns nil"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1).
|
||||||
|
s next.
|
||||||
|
^ s next")
|
||||||
|
nil)
|
||||||
|
|
||||||
|
(st-test "ReadStream peek doesn't advance"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(7 8 9).
|
||||||
|
^ {s peek. s peek. s next}")
|
||||||
|
(list 7 7 7))
|
||||||
|
|
||||||
|
(st-test "ReadStream position"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1 2 3 4).
|
||||||
|
s next. s next.
|
||||||
|
^ s position")
|
||||||
|
2)
|
||||||
|
|
||||||
|
(st-test "ReadStream reset goes back to start"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1 2 3).
|
||||||
|
s next. s next. s next.
|
||||||
|
s reset.
|
||||||
|
^ s next")
|
||||||
|
1)
|
||||||
|
|
||||||
|
(st-test "ReadStream upToEnd"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1 2 3 4 5).
|
||||||
|
s next. s next.
|
||||||
|
^ s upToEnd")
|
||||||
|
(list 3 4 5))
|
||||||
|
|
||||||
|
(st-test "ReadStream next: takes up to n"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(10 20 30 40 50).
|
||||||
|
^ s next: 3")
|
||||||
|
(list 10 20 30))
|
||||||
|
|
||||||
|
(st-test "ReadStream skip:"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: #(1 2 3 4 5).
|
||||||
|
s skip: 2.
|
||||||
|
^ s next")
|
||||||
|
3)
|
||||||
|
|
||||||
|
;; ── 3. WriteStream basics ──
|
||||||
|
(st-test "WriteStream nextPut: + contents"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := WriteStream on: (Array new: 0).
|
||||||
|
s nextPut: 10.
|
||||||
|
s nextPut: 20.
|
||||||
|
s nextPut: 30.
|
||||||
|
^ s contents")
|
||||||
|
(list 10 20 30))
|
||||||
|
|
||||||
|
(st-test "WriteStream nextPutAll:"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := WriteStream on: (Array new: 0).
|
||||||
|
s nextPutAll: #(1 2 3).
|
||||||
|
^ s contents")
|
||||||
|
(list 1 2 3))
|
||||||
|
|
||||||
|
(st-test "WriteStream nextPut: returns the value"
|
||||||
|
(evp "^ (WriteStream on: (Array new: 0)) nextPut: 42") 42)
|
||||||
|
|
||||||
|
(st-test "WriteStream position tracks writes"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := WriteStream on: (Array new: 0).
|
||||||
|
s nextPut: #a. s nextPut: #b.
|
||||||
|
^ s position")
|
||||||
|
2)
|
||||||
|
|
||||||
|
;; ── 4. WriteStream with: pre-fills ──
|
||||||
|
(st-test "WriteStream with: starts at end"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := WriteStream with: #(1 2 3).
|
||||||
|
s nextPut: 99.
|
||||||
|
^ s contents")
|
||||||
|
(list 1 2 3 99))
|
||||||
|
|
||||||
|
;; ── 5. ReadStream on:collection works on String at: ──
|
||||||
|
(st-test "ReadStream on String reads chars"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: 'abc'.
|
||||||
|
^ {s next. s next. s next}")
|
||||||
|
(list "a" "b" "c"))
|
||||||
|
|
||||||
|
(st-test "ReadStream atEnd on String"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadStream on: 'ab'.
|
||||||
|
s next. s next.
|
||||||
|
^ s atEnd")
|
||||||
|
true)
|
||||||
|
|
||||||
|
;; ── 6. ReadWriteStream ──
|
||||||
|
(st-test "ReadWriteStream read after writes"
|
||||||
|
(evp
|
||||||
|
"| s |
|
||||||
|
s := ReadWriteStream on: (Array new: 0).
|
||||||
|
s nextPut: 1. s nextPut: 2. s nextPut: 3.
|
||||||
|
s reset.
|
||||||
|
^ {s next. s next. s next}")
|
||||||
|
(list 1 2 3))
|
||||||
|
|
||||||
|
(list st-test-pass st-test-fail)
|
||||||
@@ -89,7 +89,7 @@ Core mapping:
|
|||||||
### Phase 5 — collections + numeric tower
|
### Phase 5 — collections + numeric tower
|
||||||
- [x] `SequenceableCollection`/`OrderedCollection`/`Array`/`String`/`Symbol`. Bootstrap installs shared methods on `SequenceableCollection`: `inject:into:`, `detect:`/`detect:ifNone:`, `count:`, `allSatisfy:`/`anySatisfy:`, `includes:`, `do:separatedBy:`, `indexOf:`/`indexOf:ifAbsent:`, `reject:`, `isEmpty`/`notEmpty`, `asString`. They each call `self do:`, which dispatches to the receiver's primitive `do:` — so Array, String, and Symbol inherit them uniformly. String/Symbol primitives gained `at:` (1-indexed), `copyFrom:to:`, `first`/`last`, `do:`. OrderedCollection class is in the bootstrap hierarchy; its instance shape will fill out alongside Set/Dictionary in the next box. 28 tests in `lib/smalltalk/tests/collections.sx`.
|
- [x] `SequenceableCollection`/`OrderedCollection`/`Array`/`String`/`Symbol`. Bootstrap installs shared methods on `SequenceableCollection`: `inject:into:`, `detect:`/`detect:ifNone:`, `count:`, `allSatisfy:`/`anySatisfy:`, `includes:`, `do:separatedBy:`, `indexOf:`/`indexOf:ifAbsent:`, `reject:`, `isEmpty`/`notEmpty`, `asString`. They each call `self do:`, which dispatches to the receiver's primitive `do:` — so Array, String, and Symbol inherit them uniformly. String/Symbol primitives gained `at:` (1-indexed), `copyFrom:to:`, `first`/`last`, `do:`. OrderedCollection class is in the bootstrap hierarchy; its instance shape will fill out alongside Set/Dictionary in the next box. 28 tests in `lib/smalltalk/tests/collections.sx`.
|
||||||
- [x] `HashedCollection`/`Set`/`Dictionary`/`IdentityDictionary`. Implemented as user classes in `runtime.sx`. `HashedCollection` carries a single `array` ivar; `Dictionary` overrides with parallel `keys`/`values`. Set: `add:` (dedup), `addAll:`, `remove:`, `includes:`, `do:`, `size`, `asArray`. Dictionary: `at:`, `at:ifAbsent:`, `at:put:`, `includesKey:`, `removeKey:`, `keys`, `values`, `do:`, `keysDo:`, `valuesDo:`, `keysAndValuesDo:`, `size`, `isEmpty`. `IdentityDictionary` defined as a Dictionary subclass (no methods of its own yet — equality and identity diverge in a follow-up). Class-side `new` calls `super new init`. Added Array primitive `add:` (append). 29 tests in `lib/smalltalk/tests/hashed.sx`.
|
- [x] `HashedCollection`/`Set`/`Dictionary`/`IdentityDictionary`. Implemented as user classes in `runtime.sx`. `HashedCollection` carries a single `array` ivar; `Dictionary` overrides with parallel `keys`/`values`. Set: `add:` (dedup), `addAll:`, `remove:`, `includes:`, `do:`, `size`, `asArray`. Dictionary: `at:`, `at:ifAbsent:`, `at:put:`, `includesKey:`, `removeKey:`, `keys`, `values`, `do:`, `keysDo:`, `valuesDo:`, `keysAndValuesDo:`, `size`, `isEmpty`. `IdentityDictionary` defined as a Dictionary subclass (no methods of its own yet — equality and identity diverge in a follow-up). Class-side `new` calls `super new init`. Added Array primitive `add:` (append). 29 tests in `lib/smalltalk/tests/hashed.sx`.
|
||||||
- [ ] `Stream` hierarchy: `ReadStream`/`WriteStream`/`ReadWriteStream`
|
- [x] `Stream` hierarchy: `Stream` → `PositionableStream` → `ReadStream` / `WriteStream` → `ReadWriteStream`. User classes with `collection` + 0-based `position` ivars. ReadStream: `next`, `peek`, `atEnd`, `upToEnd`, `next:`, `skip:`, `reset`, `position`/`position:`. WriteStream: `nextPut:`, `nextPutAll:`, `contents`. Class-side `on:` constructor; `WriteStream class>>with:` pre-fills + `setToEnd`. Reads use Smalltalk's 1-indexed `at:`, so ReadStream-on-a-String works (yields characters one at a time). 21 tests in `lib/smalltalk/tests/streams.sx`. Bumped `test.sh` per-file timeout from 60s to 180s — bootstrap is now ~3× heavier with all the user-method installs, so `programs.sx` runs in ~64s.
|
||||||
- [ ] `Number` tower: `SmallInteger`/`LargePositiveInteger`/`Float`/`Fraction`
|
- [ ] `Number` tower: `SmallInteger`/`LargePositiveInteger`/`Float`/`Fraction`
|
||||||
- [ ] `String>>format:`, `printOn:` for everything
|
- [ ] `String>>format:`, `printOn:` for everything
|
||||||
|
|
||||||
@@ -108,6 +108,7 @@ Core mapping:
|
|||||||
|
|
||||||
_Newest first. Agent appends on every commit._
|
_Newest first. Agent appends on every commit._
|
||||||
|
|
||||||
|
- 2026-04-25: Stream hierarchy + 21 tests (`lib/smalltalk/tests/streams.sx`). ReadStream / WriteStream / ReadWriteStream as user classes; class-side `on:`; ReadStream-on-String yields characters. Bumped `test.sh` per-file timeout 60s → 180s — heavier bootstrap pushed `programs.sx` past 60s. 573/573 total.
|
||||||
- 2026-04-25: HashedCollection / Set / Dictionary / IdentityDictionary + 29 tests (`lib/smalltalk/tests/hashed.sx`). Set: dedup add:, remove:, includes:, do:, addAll:. Dictionary: parallel keys/values backing; at:put:, at:ifAbsent:, includesKey:, removeKey:, keysDo:, keysAndValuesDo:. Class-side `new` chains `super new init`. Array primitive `add:` added. 552/552 total.
|
- 2026-04-25: HashedCollection / Set / Dictionary / IdentityDictionary + 29 tests (`lib/smalltalk/tests/hashed.sx`). Set: dedup add:, remove:, includes:, do:, addAll:. Dictionary: parallel keys/values backing; at:put:, at:ifAbsent:, includesKey:, removeKey:, keysDo:, keysAndValuesDo:. Class-side `new` chains `super new init`. Array primitive `add:` added. 552/552 total.
|
||||||
- 2026-04-25: Phase 5 sequenceable-collection methods + 28 tests (`lib/smalltalk/tests/collections.sx`). 13 shared methods on `SequenceableCollection` (inject:into:, detect:, count:, …), inherited by Array/String/Symbol via `self do:`. String primitives at:/copyFrom:to:/first/last/do:. 523/523 total.
|
- 2026-04-25: Phase 5 sequenceable-collection methods + 28 tests (`lib/smalltalk/tests/collections.sx`). 13 shared methods on `SequenceableCollection` (inject:into:, detect:, count:, …), inherited by Array/String/Symbol via `self do:`. String primitives at:/copyFrom:to:/first/last/do:. 523/523 total.
|
||||||
- 2026-04-25: Exception system + 15 tests (`lib/smalltalk/tests/exceptions.sx`). Exception/Error/ZeroDivide/MessageNotUnderstood in bootstrap; signal/signal: raise via SX `raise`; on:do:/ensure:/ifCurtailed: on BlockClosure via SX `guard`. Phase 4 complete. 495/495 total.
|
- 2026-04-25: Exception system + 15 tests (`lib/smalltalk/tests/exceptions.sx`). Exception/Error/ZeroDivide/MessageNotUnderstood in bootstrap; signal/signal: raise via SX `raise`; on:do:/ensure:/ifCurtailed: on BlockClosure via SX `guard`. Phase 4 complete. 495/495 total.
|
||||||
|
|||||||
Reference in New Issue
Block a user