From 47249900f2bd3652265584a165d2215b54dc97a6 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 12:02:37 +0000 Subject: [PATCH] smalltalk: Stream hierarchy + 21 tests; test.sh timeout 60s -> 180s --- lib/smalltalk/runtime.sx | 92 +++++++++++++++++++ lib/smalltalk/test.sh | 4 +- lib/smalltalk/tests/streams.sx | 159 +++++++++++++++++++++++++++++++++ plans/smalltalk-on-sx.md | 3 +- 4 files changed, 255 insertions(+), 3 deletions(-) create mode 100644 lib/smalltalk/tests/streams.sx diff --git a/lib/smalltalk/runtime.sx b/lib/smalltalk/runtime.sx index 61433fd6..381ec3ad 100644 --- a/lib/smalltalk/runtime.sx +++ b/lib/smalltalk/runtime.sx @@ -587,6 +587,98 @@ i := i + 1]. ^ self")) (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"))) ;; Initialise on load. Tests can re-bootstrap to reset state. diff --git a/lib/smalltalk/test.sh b/lib/smalltalk/test.sh index f8c06780..54c121a8 100755 --- a/lib/smalltalk/test.sh +++ b/lib/smalltalk/test.sh @@ -71,7 +71,7 @@ EPOCHS EPOCHS fi - OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true) + OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1 || true) rm -f "$TMPFILE" # 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)") EPOCHS 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" echo " $FAILS" elif [ "$VERBOSE" = "1" ]; then diff --git a/lib/smalltalk/tests/streams.sx b/lib/smalltalk/tests/streams.sx new file mode 100644 index 00000000..f124fb75 --- /dev/null +++ b/lib/smalltalk/tests/streams.sx @@ -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) diff --git a/plans/smalltalk-on-sx.md b/plans/smalltalk-on-sx.md index d85a71c3..637f1be6 100644 --- a/plans/smalltalk-on-sx.md +++ b/plans/smalltalk-on-sx.md @@ -89,7 +89,7 @@ Core mapping: ### 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] `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` - [ ] `String>>format:`, `printOn:` for everything @@ -108,6 +108,7 @@ Core mapping: _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: 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.