Review Request: SqueakReleaseNotesTest.1.cs

Christoph Thiede via Squeak-dev <[email protected]> Sun, 12 Jul 2026 05:27:01 +0200
Newsgroups gmane.comp.lang.smalltalk.squeak.general
Message-ID <6d972ba6-ec56-42e6-9e28-8e3e314baca6@MX2025-DAG1.hpi.uni-potsdam.de>
=============== Summary ===============

Change Set:        SqueakReleaseNotesTest
Date:            12 July 2026
Author:            Christoph Thiede

Proposal: Adds smoke tests for release notes. The tests automatically render every release note, search for todo comments, and run every interactive examples in text links.
In practice, while authoring the release notes for 6.1, these tests already helped me spot more slips in the examples than I ever expected. Furthermore, they can help us spot breaking changes in APIs that we documented in earlier releases.

Patches MessageSet initialization to raise an remark notification (that otherwise goes to the transcript) before silently ignoring invalid method references. Fixes MethodReference>>isValid to respect class definitions and hierarchies analogously to comments.

Fixes slips in existing release notes:
- Removes a lonely red space from each 5.1 and 6.0 that disturbed jekyll and looked like a todo comment
- Adds a couple of #doNotTest/#doNotAssert markers to examples that would otherwise fail the tests (e.g., by triggering a user interrupt)

Merges https://github.com/squeak-smalltalk/squeak.org/commit/313e8d7967aec893a06b3a17e129274cd579842f (in 6.0, pins URL to cuneifont via web.archive.org).

=============== Diff ===============

MessageSet>>initializeMessageList: {private} · ct 7/7/2026 23:20 (changed)
initializeMessageList: anArray
    "Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses.
     Do /not/ replace the elements of anArray if they are already MethodReferences, so as to allow users to construct richer systems, such as differencers between existing and edited versions of code.
    NOTE THAT we must support anArray to already have the desired amount and order of elements such as for the 'method inheritance' view, where all elements are prefixed with spaces to indicate the inheritance tree."
    
    | isOrdered |
    isOrdered := anArray size > 1
        and: [anArray second isCodeReference]
        and: [anArray second stringVersion first = Character space].
    messageList := isOrdered
        ifTrue: [OrderedCollection new]
        ifFalse: [Set new].
    anArray do:
        [:each |
-         each isCodeReference
+         (each isCodeReference
            ifTrue: [messageList add: each]
            ifFalse:
                [ MessageSet
                    parse: each 
                    toClassAndSelector:
-                         [ : class : sel | class ifNotNil: [ messageList add: (MethodReference class: class selector: sel) ] ] ] ].
+                         [ : class : sel |
+                             class
+                                 ifNil: [ RemarkNotification signal: ('Skipping invalid message: {1}' format: {each}) ];
+                                 yourself;
+                                 ifNotNil: [
+                                     messageList add: (MethodReference class: class selector: sel) ] ] ])
+             ifNotNil: [:ref | ref isValid ifFalse: [ RemarkNotification signal: ('Missing message: {1}' format: {each} )] ] ].
    isOrdered ifFalse: [messageList := messageList asOrderedCollection sort].
    "Unify labels if wanted."
    self class useUnifiedMessageLabels ifTrue:
        [ messageList withIndexDo: 
            [ : each : index | 
            each stringVersion: (self indentionPrefixOfSize: (self indentionsIn: each stringVersion)) , (self unifiedMessageLabelFor: each) ] ].
    messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1].
    contents := String empty

MethodReference>>isValid {testing} · ct 7/7/2026 23:20 (changed)
isValid
    "Answer whether the receiver represents a current selector or Comment"

    | aClass |
    methodSymbol isDoIt ifTrue: [^ false].
    (aClass := self actualClass) ifNil: [^ false].
    ^ (aClass includesSelector: methodSymbol) or:
-         [methodSymbol == #Comment]
+         [#(Comment Definition Hierarchy) identityIncludes: methodSymbol]

SqueakReleaseNotes class>>v45 {pages} · ct 7/8/2026 00:32 (changed)
<excessive diff skipped>

SqueakReleaseNotes class>>v50 {pages} · ct 7/8/2026 00:51 (changed)
<excessive diff skipped>

SqueakReleaseNotes class>>v51 {pages} · ct 7/10/2026 01:43 (changed)
<excessive diff skipped>

SqueakReleaseNotes class>>v52 {pages} · ct 7/8/2026 01:10 (changed)
<excessive diff skipped>

SqueakReleaseNotes class>>v53 {pages} · ct 7/8/2026 01:13 (changed)
<excessive diff skipped>

SqueakReleaseNotes class>>v60 {pages} · ct 7/10/2026 01:44 (changed)
<excessive diff skipped>

SqueakReleaseNotesTest class>>allTestSelectors {accessing} · ct 7/7/2026 20:42
+ allTestSelectors
+ 
+     self ensureTestMethods.
+     ^ super allTestSelectors

SqueakReleaseNotesTest class>>classUnderTest {accessing} · ct 7/7/2026 20:48
+ classUnderTest
+ 
+     ^ SqueakReleaseNotes

SqueakReleaseNotesTest class>>ensureTestMethods {private} · ct 7/7/2026 21:29
+ ensureTestMethods
+ 
+     | keys selectors |
+     keys := self classUnderTest pages.
+     selectors := keys do: [:key |
+         | testSelector source |
+         testSelector := (#'test{1}' asString format: {key capitalized}) asSymbol.
+         source := 
+ '{1}
+     <generated>
+     ^ self testPage: {2}'
+             format: {testSelector. key storeString}.
+         (self sourceCodeAt: testSelector ifAbsent: nil) = source ifFalse:
+             [SystemChangeNotifier uniqueInstance doSilently:
+                 [self
+                     compile: source
+                     classified: '*autogenerated-tests'
+                     withStamp: nil
+                     notifying: nil
+                     logSource: false]]].
+     ((self classUnderTest selectorsInCategory: '*autogenerated-tests') copyWithoutAll: selectors)
+         do: [:selector |
+             SystemChangeNotifier uniqueInstance doSilently:
+                 [self removeSelector: selector]].

SqueakReleaseNotesTest class>>testSelectors {accessing} · ct 7/7/2026 20:42
+ testSelectors
+ 
+     self ensureTestMethods.
+     ^ super testSelectors

SqueakReleaseNotesTest>>actionsAndLabelsIn: {private} · ct 7/8/2026 20:39
+ actionsAndLabelsIn: aText
+ 
+     ^ self attributesAndLabelsIn: aText that: [:attr | attr isKindOf: TextAction]

SqueakReleaseNotesTest>>attributesAndLabelsIn:that: {private} · ct 7/8/2026 20:39
+ attributesAndLabelsIn: aText that: aBlock
+ 
+     | labels |
+     labels := OrderedDictionary new.
+     aText runs intervalsAndValuesDo: [:range :attrs |
+         attrs do: [:attr |
+             (aBlock value: attr) ifTrue:
+                 [(labels at: attr ifAbsentPut: [OrderedCollection new])
+                     addLast: range]]].
+     ^ ((labels associations
+         sorted: [:assoc | assoc value first start] ascending , [:assoc | assoc value first stop] ascending)
+             as: OrderedDictionary)
+                 collect: [:ranges | ranges collect: [:range | aText copyFrom: range start to: range stop] as: Array]

SqueakReleaseNotesTest>>check:do: {asserting} · ct 7/8/2026 01:57
+ check: aStringOrBlock do: aBlock
+ 
+     ^ self
+         assert: aBlock
+         description: aStringOrBlock value
+         resumable: true

SqueakReleaseNotesTest>>checkFailures {private} · ct 7/8/2026 02:03
+ checkFailures
+ 
+     | failurePatterns expectedFailures unexpectedFailures matchedFailurePatterns unmatchedFailurePatterns |
+     failurePatterns := self myExpectedFailurePatterns.
+     expectedFailures := OrderedCollection new.
+     unexpectedFailures := OrderedCollection new.
+     matchedFailurePatterns := Set new.
+     
+     failures do: [:ex |
+         (failurePatterns
+             detect: [:pattern | self doesFailure: ex matchPattern: pattern]
+             ifFound: [:pattern | matchedFailurePatterns add: pattern. true]
+             ifNone: [false])
+                 ifTrue: [expectedFailures addLast: ex]
+                 ifFalse: [unexpectedFailures addLast: ex]].
+     
+     self assert: unexpectedFailures isEmpty description:
+         ['{1} checks failed: {2}' translated format: {unexpectedFailures size. unexpectedFailures}].
+     expectedFailures ifNotEmpty:
+         [self logFailure: ('{1} checks failed as expected: {2}' translated format: {expectedFailures size. expectedFailures})].
+     unmatchedFailurePatterns := failurePatterns copyWithoutAll: matchedFailurePatterns.
+     self assert: unmatchedFailurePatterns isEmpty description:
+         ['{1} checks passed unexpectedly: {2}' translated format: {unmatchedFailurePatterns size. unmatchedFailurePatterns}].

SqueakReleaseNotesTest>>classUnderTest {accessing} · ct 7/7/2026 20:51
+ classUnderTest
+ 
+     ^ self class classUnderTest

SqueakReleaseNotesTest>>defaultTimeout {running - timeout} · ct 7/8/2026 00:23
+ defaultTimeout
+ 
+     ^ 90 "seconds"

SqueakReleaseNotesTest>>doesFailure:matchPattern: {private} · ct 7/8/2026 02:02
+ doesFailure: anException matchPattern: pattern
+ 
+     | matchable |
+     matchable := anException description , anException tag.
+     ^ pattern isString
+         ifTrue: ['*' , pattern , '*' match: matchable]
+         ifFalse: [(pattern matchesIn: matchable) notEmpty]

SqueakReleaseNotesTest>>dropMorphs:fromHand: {private} · ct 7/8/2026 02:30
+ dropMorphs: morphs fromHand: hand
+ 
+     morphs ifEmpty: [^ self].
+     
+     morphs reverseDo: [:m |
+         hand dropMorph: m event:
+             (MouseButtonEvent new
+                 setType: #mouseDown
+                 position: hand position
+                 which: 0
+                 buttons: 0
+                 nClicks: 1
+                 hand: hand
+                 stamp: Sensor eventTimeNow)].
+     hand world doOneCycleNow. "who knows"

SqueakReleaseNotesTest>>expectedFailurePatterns {failures} · ct 7/8/2026 01:31
+ expectedFailurePatterns
+ 
+     ^ Dictionary new
+         at: #testV45 put: #(
+             maxStackDepthForASingleDebugLogReport "ContextPart was renamed to Context"
+         );
+         at: #testV50 put: {
+             '\bLargeInteger\b' asRegex. "LargeInteger was renamed"
+             'DateAndTime>>#now'. "historical bug (should be class-side), not sure whether we should fix those"
+             'ProtoObject>>#become:'. "was moved to Object"
+         };
+         at: #testV51 put: #(
+             'MethodContext' "was renamed to Context"
+             'CompiledMethod class >> #maxNumLiterals' "was moved up to CompiledCode class"
+         );
+         at: #testV52 put: #(
+             'HTMLReadWriter' "was renamed to HtmlReadWriter"
+         );
+         at: #testV60 put: {
+             'KeyedSet add:ifPresent:'. "historical error (???), not sure whether we should fix those"
+             'Utilities setAuthorInitials' flag: #bug. "#valueSuppressingAllMessages cannot handle this"
+             'obsolete preferences'. "have been removed"
+             'chooseFileMatchingSuffixes:' flag: #bug. "#valueSuppressingAllMessages cannot handle this"
+             'Model>>#buildMenu:withBuilders:shifted:'. "was moved up to Object"
+             'UIManager methodDict as: Dictionary'. "historical bug, not sure whether we should fix those"
+         };
+         yourself

SqueakReleaseNotesTest>>expectedFailures {failures} · ct 7/8/2026 02:00
+ expectedFailures
+ 
+     ^ #(testNoExpectedFailurePatterns)

SqueakReleaseNotesTest>>isLogging {running} · ct 7/7/2026 21:00
+ isLogging
+ 
+     ^ true

SqueakReleaseNotesTest>>myExpectedFailurePatterns {accessing} · ct 7/8/2026 00:51
+ myExpectedFailurePatterns
+ 
+     ^ self expectedFailurePatterns at: self selector ifAbsent: [#()]

SqueakReleaseNotesTest>>parentTopic {accessing} · ct 7/7/2026 21:17
+ parentTopic
+ 
+     ^ parentTopic

SqueakReleaseNotesTest>>performTest {private} · ct 7/8/2026 02:03
+ performTest
+ 
+     failures := OrderedCollection new.
+     [super performTest]
+         on: TestFailure do: [:ex |
+             ex isResumable ifFalse: [ex pass].
+             failures addLast: ex.
+             ex resume].
+     self checkFailures.

SqueakReleaseNotesTest>>runAction:inWorld: {private} · ct 7/8/2026 02:28
+ runAction: aTextAttribute inWorld: world
+ 
+     | textMorph |
+     textMorph := (browser anyTextPaneWithSelector: #topicContents) textMorph.
+     aTextAttribute
+         actOnClickFor: browser
+         in: textMorph paragraph
+         at: textMorph positionInWorld
+         editor: textMorph editor.
+     world doOneCycleNow. "some text actions use addDeferredUIMessage:"

SqueakReleaseNotesTest>>setUp {running} · ct 7/7/2026 21:17
+ setUp
+ 
+     super setUp..
+     
+     parentTopic := self classUnderTest asHelpTopic.

SqueakReleaseNotesTest>>setUpBrowser {running} · ct 7/7/2026 21:18
+ setUpBrowser
+ 
+     browser := HelpBrowser on: self parentTopic.
+     browser open.

SqueakReleaseNotesTest>>tearDown {running} · ct 7/7/2026 21:18
+ tearDown
+ 
+     [browser ifNotNil: [browser changed: #close]]
+         ensure: [super tearDown].

SqueakReleaseNotesTest>>testAction: {tests} · ct 7/8/2026 02:34
+ testAction: aTextAttribute
+ 
+     | doNotTest doNotAssert world morphs hand cleanUps dockingBar grabbedMorphs dialogs success newMorphs |
+     doNotTest := ((aTextAttribute isKindOf: TextURL) and: ['*doNotTest*' match: aTextAttribute url]).
+     doNotAssert := ((aTextAttribute isKindOf: TextURL) and: ['*doNotAssert*' match: aTextAttribute url]).
+     doNotTest ifTrue:
+         [self logFailure: 'Skipping doNotTest action'.
+         ^ self].
+     
+     "Arrange..."
+     world := Project current world.
+     world == self currentWorld ifFalse: [self error: 'This test can only be run in the current world'].
+     hand := world firstHand.
+     hand == self currentHand ifFalse: [self error: 'This test can only be run with the current hand'].
+     cleanUps := OrderedCollection new.
+     world project showWorldMainDockingBar ifFalse:
+         [world project toggleShowWorldMainDockingBar.
+         cleanUps addLast: [world project toggleShowWorldMainDockingBar]].
+     dockingBar := world dockingBars first.
+     
+     "Snapshot before..."
+     morphs := world submorphs.
+     grabbedMorphs := hand submorphs.
+     dialogs := OrderedCollection new.
+     
+     "Action!"
+     [success := false.
+     [[[self runAction: aTextAttribute inWorld: world.
+     self dropMorphs: (hand submorphs copyWithoutAll: grabbedMorphs) fromHand: hand.
+     success := true]
+         "UI automation"
+         on: ProvideAnswerNotification do: [:ex |
+             dialogs addLast: ex.
+             ex pass]
+         on: RemarkNotification do: [:ex |
+             self error: ex description]
+         on: Halt, Warning do: [:ex |
+             ('*debug this*' match: ex messageText asLowercase) ifFalse: [ex pass].
+             ex return]]
+         valueSupplyingAnswers: #(('Install *?' false) ('*' true))]
+             on: Error , Warning , Halt do: [:ex |
+                 (ex isMemberOf: InvalidDirectoryError) ifTrue:
+                     [self flag: #workaround. "Error, but defaultAction does nothing. See:
+                     * https://lists.squeakfoundation.org/archives/list/[email protected]/thread/C6VHL6DUM62BY6VA266BTIYUGXA3F3CA
+                     * https://lists.squeakfoundation.org/archives/list/[email protected]/thread/FVE4D46HHMMABLBH3VXEDB2ILXYD5APD"
+                     ex resumeUnchecked: ex defaultAction].
+                 self check: ('Failed to open link: {2}' format: {aTextAttribute. ex}) do: [false].
+                 ex return]]
+         value.
+     
+     "Snapshot after..."
+     newMorphs := world submorphs copyWithoutAll: morphs.
+     
+     self flag: #forLater. "For #browseClass:category: and #browse:selector:, test whether category/selector exists. Browsers silently fail if they don't."
+     
+     [success ifTrue:
+         ["Assert!"
+         doNotAssert ifFalse:
+             [self check: 'Link apparently a no-op' do:
+                 [newMorphs notEmpty
+                     or: [dialogs notEmpty]
+                     or: [dockingBar selectedItem notNil]]]]]
+         
+         "Clean up (-:"
+         ensure:
+             [newMorphs do: [:m | [m delete] valueSuppressingAllMessages].
+             dockingBar selectItem: nil event: hand lastEvent.
+             cleanUps removeAllSuchThat: [:ea |
+                 ea value. true]].

SqueakReleaseNotesTest>>testNoExpectedFailurePatterns {tests} · ct 7/8/2026 01:59
+ testNoExpectedFailurePatterns
+     "Placeholder for expected failure patterns in test results. We do not mark entire page tests as expectedFailures but use a finer-grained mechanism for single checks. This test ensures that this suite still appears with expected failures on behalf of single checks."
+ 
+     self assert: self expectedFailurePatterns isEmpty.

SqueakReleaseNotesTest>>testPage: {tests} · ct 7/8/2026 02:19
+ testPage: key
+ 
+     | topic contents actions |
+     topic := self parentTopic subtopicAt: key.
+     contents := topic contents.
+     
+     self testTodosIn: contents.
+     
+     self setUpBrowser.
+     browser selectTopicLikePath: {topic}.
+     
+     actions := self actionsAndLabelsIn: contents.
+     actions associations
+         do: [:assoc |
+             | action labels |
+             action := assoc key.
+             labels := assoc value.
+             "self logFailure: ('At {1} testing link {2}' format: {labels collect: #asString. action})."
+             [self testAction: action]
+                 on: TestFailure do: [:ex |
+                     ex tag: {labels collect: #asString. action}; pass]]
+         "displayingProgress: ('Testing actions in page {1}' format: {key})".

SqueakReleaseNotesTest>>testTodosIn: {tests} · ct 7/10/2026 01:53
+ testTodosIn: contents
+ 
+     (contents asString allRangesOfRegexMatches: 'todo' asRegexIgnoringCase) in: [:ranges |
+         self
+             check: ['unresolved todo notes: ' , (ranges
+                 collect: [:range | (contents asString allButFirst: range start - 1) truncateWithEllipsisTo: 50]
+                 as: Array)]
+             do: [ranges isEmpty]].
+     
+     (self selector compareSafely: 'testV50') ifFalse:
+         [(self attributesAndLabelsIn: contents that: [:attr |
+             (attr isKindOf: TextColor) and: [attr color = Color red]]) in: [:attrs |
+                 self check: ['unresolved todos: ' , (attrs values concatenation
+                     collect: [:ea | ea truncateWithEllipsisTo: 50])]
+                 do: [attrs isEmpty]]].

-- 
Sent from Squeak Inbox Talk

Squeak-dev mailing list -- [email protected]
To unsubscribe send an email to [email protected]
SqueakReleaseNotesTest.1.cs (text/squeak-changes, 172.1 KB) - not displayed