Squeak-dev April 2021

squeak-dev@lists.squeakfoundation.org

33 participants
393 discussions

The Trunk: ST80-ct.255.mcz
by commits＠source.squeak.org 13 Apr '21

13 Apr '21

Nicolas Cellier uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-ct.255.mcz ==================== Summary ==================== Name: ST80-ct.255 Author: ct Time: 6 June 2020, 3:48:16.215278 pm UUID: 5469be3e-28ef-c54e-952c-674500374c05 Ancestors: ST80-nice.254 Fix Transcript in MVC projects if preference 'Force transcript updates to screen' is disabled. Thanks to Marcel (mt) for the hint! =============== Diff against ST80-nice.254 =============== Item was changed: ----- Method: PluggableTextView>>update: (in category 'updating') ----- update: aSymbol "Refer to the comment in View|update:. Do nothing if the given symbol does not match any action. " aSymbol == #wantToChange ifTrue: [self canDiscardEdits ifFalse: [self promptForCancel]. ^ self]. aSymbol == #flash ifTrue: [^ controller flash]. aSymbol == getTextSelector ifTrue: [^ self updateDisplayContents]. aSymbol == getSelectionSelector ifTrue: [^ self setSelection: self getSelection]. aSymbol == #clearUserEdits ifTrue: [^ self hasUnacceptedEdits: false]. (aSymbol == #autoSelect and: [getSelectionSelector ~~ nil]) ifTrue: [ParagraphEditor abandonChangeText. "no replacement!!" ^ controller setSearch: model autoSelectString; againOrSame: true]. + (#(#appendEntry appendEntryLater) includes: aSymbol) ifTrue: - aSymbol == #appendEntry ifTrue: [^ controller doOccluded: [controller appendEntry]]. aSymbol == #clearText ifTrue: [^ controller doOccluded: [controller changeText: Text new]]. aSymbol == #bs ifTrue: [^ controller doOccluded: [controller bsText]]. aSymbol == #codeChangedElsewhere ifTrue: [^ self hasEditingConflicts: true]. aSymbol == #saveContents ifTrue: [^self controller saveContentsInFile]. aSymbol == #close ifTrue: [^self topView controller closeAndUnscheduleNoTerminate]. aSymbol == #acceptChanges ifTrue: [^ self controller accept]. aSymbol == #revertChanges ifTrue: [^ self controller cancel].!

1 0

The Trunk: Monticello-jr.726.mcz
by commits＠source.squeak.org 13 Apr '21

13 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-jr.726.mcz ==================== Summary ==================== Name: Monticello-jr.726 Author: jr Time: 28 June 2020, 10:07:19.980052 pm UUID: e8c6b590-8826-0144-a535-13cfa140b5dd Ancestors: Monticello-mt.725 Fix wrong traitCompositions in packages loaded from source.st As of Collections-ul.900, ReadStream>>match: does not alter the Stream position if the search sequence was not found. Failure to find the search sequence is indicated via the return value, but it was not checked in classDefinitionFrom:. The error could trigger load failures after loading Monticello-jr.720, in which the trait composition became relevant beyond just creating the class. The error did not surface for .mcz version files that contain a correct snapshot.bin file, which allows to forego the reading of the source.st file. There are versions out there without the snapshot.bin file. INIFile-jf.3.mcz as served by Squeaksource is such a version at the moment. =============== Diff against Monticello-mt.725 =============== Item was changed: ----- Method: MCStReader>>classDefinitionFrom: (in category 'converting') ----- classDefinitionFrom: aPseudoClass + | tokens definitionStream hasTraitComposition traitCompositionString lastIndex hasClassTraitComposition classTraitCompositionString typeOfSubclass className | - | tokens traitCompositionString lastIndex classTraitCompositionString typeOfSubclass className | tokens := Scanner new scanTokens: aPseudoClass definition. + definitionStream := ReadStream on: aPseudoClass definition. + hasTraitComposition := definitionStream match: 'uses:'. + traitCompositionString := hasTraitComposition ifTrue: [(definitionStream upToAll: 'instanceVariableNames:') withBlanksTrimmed] ifFalse: ['{}']. + definitionStream := ReadStream on: aPseudoClass metaClass definition asString. + hasClassTraitComposition := definitionStream match: 'uses:'. + classTraitCompositionString := hasClassTraitComposition ifTrue: [(definitionStream upToAll: 'instanceVariableNames:') withBlanksTrimmed] ifFalse: ['{}']. - traitCompositionString := ((ReadStream on: aPseudoClass definition) - match: 'uses:'; - upToAll: 'instanceVariableNames:') withBlanksTrimmed. - classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString) - match: 'uses:'; - upToAll: 'instanceVariableNames:') withBlanksTrimmed. - traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}']. - classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}']. lastIndex := tokens size. className := tokens at: 3. typeOfSubclass := self typeOfSubclass: (tokens at: 2). "Compiled code classes are special cases of the #bytes class type" (#bytes == typeOfSubclass and: [self compiledCodeClassNames includes: className]) ifTrue: [typeOfSubclass := #compiledMethod]. ^ MCClassDefinition name: className superclassName: (tokens at: 1) traitComposition: traitCompositionString classTraitComposition: classTraitCompositionString category: (tokens at: lastIndex) instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ') classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ') poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ') classInstVarNames: (self classInstVarNamesFor: aPseudoClass) type: typeOfSubclass comment: (self commentFor: aPseudoClass) commentStamp: (self commentStampFor: aPseudoClass)!

3 2

The Inbox: Tests-ct.448.mcz
by commits＠source.squeak.org 13 Apr '21

13 Apr '21

A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-ct.448.mcz ==================== Summary ==================== Name: Tests-ct.448 Author: ct Time: 12 April 2021, 9:19:02.66824 pm UUID: 65aa0e1a-250a-724a-9f04-505db0722916 Ancestors: Tests-nice.447 Revises ExceptionTests >> #testCatchingDefaultAction to work when being debugged/simulated as well. This also decouples the test from the implementation details of UnhandledWarnings. For further reference, see also: https://github.com/LinqLover/SimulationStudio/runs/2319502648?check_suite_f… =============== Diff against Tests-nice.447 =============== Item was changed: ----- Method: ExceptionTests>>testCatchingDefaultAction (in category 'tests - outer') ----- testCatchingDefaultAction + "The #defaultAction method is executed in the context of the signaling environment." + - "The #defaultAction method is executed in the context of the signaling environment. - The defaultAction will raise an UnhandledWarning that should be caught by this handler." | result | + result := [MyTestNotification signalForAction: [MyTestNotification signal: '2nd exception']] + on: MyTestNotification + do: [:ex | '2nd exception caught']. + self assert: '2nd exception caught' equals: result.! - result := [ Warning signal: 'Warning signalled' ] on: UnhandledWarning do: [ :ex | 'UnhandledWarning caught' ]. - self assert: 'UnhandledWarning caught' equals: result! Item was changed: Notification subclass: #MyTestNotification + instanceVariableNames: 'action' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-Exceptions'! Item was added: + ----- Method: MyTestNotification class>>signalForAction: (in category 'signaling') ----- + signalForAction: aBlock + + ^ self new + action: aBlock; + signal! Item was added: + ----- Method: MyTestNotification>>action (in category 'accessing') ----- + action + + ^ action! Item was added: + ----- Method: MyTestNotification>>action: (in category 'accessing') ----- + action: aBlock + + action := aBlock! Item was added: + ----- Method: MyTestNotification>>defaultAction (in category 'priv handling') ----- + defaultAction + + self action ifNotNil: [^ self action cull: self]. + + ^ super defaultAction!

2 1

The Trunk: Monticello-nice.741.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-nice.741.mcz ==================== Summary ==================== Name: Monticello-nice.741 Author: nice Time: 12 April 2021, 11:55:44.241641 pm UUID: ed3f3912-0b93-4673-acfe-b79c9e69886a Ancestors: Monticello-eem.737, Monticello-ct.740, Monticello-jr.726, Monticello-ct.731, Monticello-ct.709 Merge commit: Monticello-eem.737: Eliminate shadowed variable warning(s). Monticello-ct.740: Introduces MCPackageNotFound exception and usees it in MCRepository versions lookup. I would like to catch this error in [1, 2, 3]. Monticello-jr.726: Fix wrong traitCompositions in packages loaded from source.st Monticello-ct.731: Make sure to reset the modified flag for working copies that have become empty after merging a version. Monticello-ct.709: Implement #doItReceiver and #doItContext on MCCodeTool. Allows, for example, for inspecting a class variable from a save version dialog. - and its ancestor: - Monticello-ct.708: Fix MCSaveVersionDialog refreshing: Update text if the currently selected item changed =============== Diff against Monticello-eem.737 =============== Item was added: + ----- Method: MCCodeTool>>doItContext (in category 'accessing') ----- + doItContext + ^ nil! Item was added: + ----- Method: MCCodeTool>>doItReceiver (in category 'accessing') ----- + doItReceiver + ^ self selectedClass! Item was added: + Error subclass: #MCPackageNotFound + instanceVariableNames: 'repository packageName' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Repositories'! Item was added: + ----- Method: MCPackageNotFound class>>signalForRepository:packageName: (in category 'signaling') ----- + signalForRepository: aRepository packageName: aString + + ^ self new + repository: aRepository packageName: aString; + signal! Item was added: + ----- Method: MCPackageNotFound>>messageText (in category 'printing') ----- + messageText + + ^ messageText ifNil: ['{1} not found in {2}' translated format: {self packageName. self repository}]! Item was added: + ----- Method: MCPackageNotFound>>packageName (in category 'accessing') ----- + packageName + + ^ packageName! Item was added: + ----- Method: MCPackageNotFound>>repository (in category 'accessing') ----- + repository + + ^ repository! Item was added: + ----- Method: MCPackageNotFound>>repository:packageName: (in category 'accessing') ----- + repository: aRepository packageName: aString + + repository := aRepository. + packageName := aString.! Item was changed: ----- Method: MCRepository>>highestNumberedVersionNameForPackageNamed: (in category 'versions') ----- highestNumberedVersionNameForPackageNamed: aString ^ (self versionNamesForPackageNamed: aString) + ifEmpty: [MCPackageNotFound signalForRepository: self packageName: aString] - ifEmpty: [ self error: aString , ' not found in ' , self asString ] ifNotEmptyDo: [ : versionNames | versionNames detectMax: [ : each | each versionNumber ] ]! Item was changed: ----- Method: MCSaveVersionDialog>>refresh (in category 'actions') ----- refresh + | latestSelection | + latestSelection := self selection. + self updateItems. self + selection: latestSelection; + changed: #list; + changed: #text.! - updateItems ; - changed: #list! Item was changed: ----- Method: MCStReader>>classDefinitionFrom: (in category 'converting') ----- classDefinitionFrom: aPseudoClass + | tokens definitionStream hasTraitComposition traitCompositionString lastIndex hasClassTraitComposition classTraitCompositionString typeOfSubclass className | - | tokens traitCompositionString lastIndex classTraitCompositionString typeOfSubclass className | tokens := Scanner new scanTokens: aPseudoClass definition. + definitionStream := ReadStream on: aPseudoClass definition. + hasTraitComposition := definitionStream match: 'uses:'. + traitCompositionString := hasTraitComposition ifTrue: [(definitionStream upToAll: 'instanceVariableNames:') withBlanksTrimmed] ifFalse: ['{}']. + definitionStream := ReadStream on: aPseudoClass metaClass definition asString. + hasClassTraitComposition := definitionStream match: 'uses:'. + classTraitCompositionString := hasClassTraitComposition ifTrue: [(definitionStream upToAll: 'instanceVariableNames:') withBlanksTrimmed] ifFalse: ['{}']. - traitCompositionString := ((ReadStream on: aPseudoClass definition) - match: 'uses:'; - upToAll: 'instanceVariableNames:') withBlanksTrimmed. - classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString) - match: 'uses:'; - upToAll: 'instanceVariableNames:') withBlanksTrimmed. - traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}']. - classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}']. lastIndex := tokens size. className := tokens at: 3. typeOfSubclass := self typeOfSubclass: (tokens at: 2). "Compiled code classes are special cases of the #bytes class type" (#bytes == typeOfSubclass and: [self compiledCodeClassNames includes: className]) ifTrue: [typeOfSubclass := #compiledMethod]. ^ MCClassDefinition name: className superclassName: (tokens at: 1) traitComposition: traitCompositionString classTraitComposition: classTraitCompositionString category: (tokens at: lastIndex) instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ') classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ') poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ') classInstVarNames: (self classInstVarNamesFor: aPseudoClass) type: typeOfSubclass comment: (self commentFor: aPseudoClass) commentStamp: (self commentStampFor: aPseudoClass)! Item was changed: ----- Method: MCWorkingCopy>>merged: (in category 'operations') ----- merged: aVersion ancestry addAncestor: aVersion info. + self changed. + self checkModified.! - self changed!

1 0

The Trunk: Monticello-ct.709.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.709.mcz ==================== Summary ==================== Name: Monticello-ct.709 Author: ct Time: 21 December 2019, 12:56:07.492795 pm UUID: 70b14709-5b5a-bd45-a337-d354c56d8161 Ancestors: Monticello-ct.708 Implement #doItReceiver and #doItContext on MCCodeTool. Allows, for example, for inspecting a class variable from a save version dialog. =============== Diff against Monticello-ct.708 =============== Item was added: + ----- Method: MCCodeTool>>doItContext (in category 'accessing') ----- + doItContext + ^ nil! Item was added: + ----- Method: MCCodeTool>>doItReceiver (in category 'accessing') ----- + doItReceiver + ^ self selectedClass!

1 0

The Trunk: Monticello-ct.708.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.708.mcz ==================== Summary ==================== Name: Monticello-ct.708 Author: ct Time: 14 December 2019, 5:34:25.115612 pm UUID: 4f24d611-8fbb-bd41-be15-3ca4c07aaa54 Ancestors: Monticello-ct.706 Fix MCSaveVersionDialog refreshing: Update text if the currently selected item changed =============== Diff against Monticello-ct.706 =============== Item was changed: ----- Method: MCSaveVersionDialog>>refresh (in category 'actions') ----- refresh + | latestSelection | + latestSelection := self selection. + self updateItems. self + selection: latestSelection; + changed: #list; + changed: #text.! - updateItems ; - changed: #list!

1 0

The Trunk: Monticello-ct.731.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.731.mcz ==================== Summary ==================== Name: Monticello-ct.731 Author: ct Time: 12 October 2020, 1:22:55.228864 pm UUID: 29858029-e65e-ef4a-897b-3c420786d60e Ancestors: Monticello-mt.730 Make sure to reset the modified flag for working copies that have become empty after merging a version. =============== Diff against Monticello-mt.730 =============== Item was changed: ----- Method: MCWorkingCopy>>merged: (in category 'operations') ----- merged: aVersion ancestry addAncestor: aVersion info. + self changed. + self checkModified.! - self changed!

1 0

The Trunk: Monticello-ct.740.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.740.mcz ==================== Summary ==================== Name: Monticello-ct.740 Author: ct Time: 12 April 2021, 10:18:26.02269 pm UUID: c0c2562b-e801-ef4c-8628-3d352c513e0a Ancestors: Monticello-mt.736 Introduces MCPackageNotFound exception and usees it in MCRepository versions lookup. I would like to catch this error in [1, 2, 3]. [1] https://github.com/LinqLover/TelegramSmalltalkBot/blob/03be8437dfd9b9e98715… [2] https://github.com/LinqLover/TelegramBot/blob/e2d248eff9e24ca9a0423585b18d0… [3] https://github.com/LinqLover/SimulationStudio/blob/743d48fdc10a70d572b1070b… =============== Diff against Monticello-mt.736 =============== Item was added: + Error subclass: #MCPackageNotFound + instanceVariableNames: 'repository packageName' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Repositories'! Item was added: + ----- Method: MCPackageNotFound class>>signalForRepository:packageName: (in category 'signaling') ----- + signalForRepository: aRepository packageName: aString + + ^ self new + repository: aRepository packageName: aString; + signal! Item was added: + ----- Method: MCPackageNotFound>>messageText (in category 'printing') ----- + messageText + + ^ messageText ifNil: ['{1} not found in {2}' translated format: {self packageName. self repository}]! Item was added: + ----- Method: MCPackageNotFound>>packageName (in category 'accessing') ----- + packageName + + ^ packageName! Item was added: + ----- Method: MCPackageNotFound>>repository (in category 'accessing') ----- + repository + + ^ repository! Item was added: + ----- Method: MCPackageNotFound>>repository:packageName: (in category 'accessing') ----- + repository: aRepository packageName: aString + + repository := aRepository. + packageName := aString.! Item was changed: ----- Method: MCRepository>>highestNumberedVersionNameForPackageNamed: (in category 'versions') ----- highestNumberedVersionNameForPackageNamed: aString ^ (self versionNamesForPackageNamed: aString) + ifEmpty: [MCPackageNotFound signalForRepository: self packageName: aString] - ifEmpty: [ self error: aString , ' not found in ' , self asString ] ifNotEmptyDo: [ : versionNames | versionNames detectMax: [ : each | each versionNumber ] ]!

1 0

The Inbox: Tests-jar.448.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.448.mcz ==================== Summary ==================== Name: Tests-jar.448 Author: jar Time: 12 April 2021, 11:13:13.58946 pm UUID: 99c6f69a-288c-0648-80af-3b7aa014e9ba Ancestors: Tests-nice.447 Complement Kernel-jar.1386 (Fix a list of termination bugs described in http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposa…) These basic tests illustrate the unwind semantics during termination implemented by the new #teminate.. Current implementation of #teminate will fail with these tests - they should accompany Kernel-jar.1386 (if accepted). Thanks =============== Diff against Tests-nice.447 =============== Item was changed: SystemOrganization addCategory: #'Tests-Bugs'! SystemOrganization addCategory: #'Tests-Compiler'! SystemOrganization addCategory: #'Tests-Dependencies'! SystemOrganization addCategory: #'Tests-Digital Signatures'! SystemOrganization addCategory: #'Tests-Environments'! SystemOrganization addCategory: #'Tests-Exceptions'! SystemOrganization addCategory: #'Tests-FilePackage'! SystemOrganization addCategory: #'Tests-Files'! SystemOrganization addCategory: #'Tests-Finalization'! SystemOrganization addCategory: #'Tests-Hex'! SystemOrganization addCategory: #'Tests-Installer-Core'! SystemOrganization addCategory: #'Tests-Localization'! SystemOrganization addCategory: #'Tests-Monticello'! SystemOrganization addCategory: #'Tests-Monticello-Mocks'! SystemOrganization addCategory: #'Tests-Monticello-Utils'! SystemOrganization addCategory: #'Tests-Object Events'! SystemOrganization addCategory: #'Tests-ObjectsAsMethods'! SystemOrganization addCategory: #'Tests-PrimCallController'! SystemOrganization addCategory: #'Tests-Release'! SystemOrganization addCategory: #'Tests-System-Applications'! SystemOrganization addCategory: #'Tests-System-Digital Signatures'! SystemOrganization addCategory: #'Tests-System-Object Storage'! SystemOrganization addCategory: #'Tests-System-Preferences'! SystemOrganization addCategory: #'Tests-System-Support'! SystemOrganization addCategory: #'Tests-Utilities'! SystemOrganization addCategory: #'Tests-VM'! - SystemOrganization addCategory: #'Tests-MonticelloMocks'! SystemOrganization addCategory: #'Tests-Sound'! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind1 (in category 'tests') ----- + testTerminationDuringNestedUnwind1 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind2 (in category 'tests') ----- + testTerminationDuringNestedUnwind2 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind3 (in category 'tests') ----- + testTerminationDuringNestedUnwind3 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [Processor yield] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind4 (in category 'tests') ----- + testTerminationDuringNestedUnwind4 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor yield. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind5 (in category 'tests') ----- + testTerminationDuringNestedUnwind5 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess terminate] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3. + "now let the termination continue and make sure all unwind blocks have finished" + Processor yield. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind6 (in category 'tests') ----- + testTerminationDuringNestedUnwind6 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 | + x1 := x2 := x3 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess terminate. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3. + "now let the termination continue and make sure all unwind blocks have finished" + Processor yield. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind7 (in category 'tests') ----- + testTerminationDuringNestedUnwind7 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 semaphore | + x1 := x2 := x3 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [semaphore wait] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + ! Item was added: + ----- Method: ProcessTerminateBug>>testTerminationDuringNestedUnwind8 (in category 'tests') ----- + testTerminationDuringNestedUnwind8 + "Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 semaphore | + x1 := x2 := x3 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + semaphore wait. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true] + ] newProcess resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3 + !

1 0

The Inbox: Kernel-jar.1386.mcz
by commits＠source.squeak.org 12 Apr '21

12 Apr '21

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1386.mcz ==================== Summary ==================== Name: Kernel-jar.1386 Author: jar Time: 12 April 2021, 10:53:49.66946 pm UUID: 26cd98dc-59f6-0043-aa73-732e8144cf25 Ancestors: Kernel-nice.1384 Superseds Kernel-jar.1385 adding a little tweak and a comment; otherwise identical (Fix a list of termination bugs described in http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposa…) =============== Diff against Kernel-nice.1384 =============== Item was changed: ----- Method: Process>>isSuspended (in category 'testing') ----- isSuspended + "A process is suspended if it is not active, not terminated and + not waiting in a scheduler or a semaphore queue." + + self isActiveProcess ifTrue: [^ false]. + ^myList isNil and: [self isTerminated not]! - "A process is suspended if it has been suspended with the suspend primitive. - It is distinguishable from the active process and a terminated process by - having a non-nil suspendedContext that is either not the bottom context - or has not reached its endPC." - ^nil == myList - and: [nil ~~ suspendedContext - and: [suspendedContext isBottomContext - ifTrue: [suspendedContext closure - ifNil: [suspendedContext methodClass ~~ Process - or: [suspendedContext selector ~~ #terminate]] - ifNotNil: [suspendedContext pc < suspendedContext closure endPC]] - ifFalse: [true]]]! Item was changed: ----- Method: Process>>isTerminated (in category 'testing') ----- isTerminated + "Answer if the receiver is terminated. A process is considered terminated + if the suspendedContext is the bottomContext and the pc is at the endPC" + - "Answer if the receiver is terminated, or at least terminating." self isActiveProcess ifTrue: [^ false]. + ^suspendedContext isNil or: [ + suspendedContext isBottomContext and: [ + suspendedContext isDead or: [suspendedContext atEnd]]]! - ^suspendedContext isNil - or: ["If the suspendedContext is the bottomContext it is the block in Process>>newProcess. - If so, and the pc is at the endPC, the block has already sent and returned - from value and there is nothing more to do." - suspendedContext isBottomContext - and: [suspendedContext closure - ifNil: [suspendedContext methodClass == Process - and: [suspendedContext selector == #terminate]] - ifNotNil: [suspendedContext pc >= suspendedContext closure endPC]]]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | ctxt unwindBlock oldList outerMost | + self isActiveProcess ifTrue: [ + "If terminating the active process, suspend it first and terminate it as a suspended process." + [self terminate] fork. + ^self suspend]. - | ctxt unwindBlock oldList | - self isActiveProcess ifTrue: - [ctxt := thisContext. - [ctxt := ctxt findNextUnwindContextUpTo: nil. - ctxt ~~ nil] whileTrue: - [(ctxt tempAt: 2) ifNil: - ["N.B. Unlike Context>>unwindTo: we do not set complete (tempAt: 2) to true." - unwindBlock := ctxt tempAt: 1. - thisContext terminateTo: ctxt. - unwindBlock value]]. - thisContext terminateTo: nil. - self suspend. - "If the process is resumed this will provoke a cannotReturn: error. - Would self debug: thisContext title: 'Resuming a terminated process' be better?" - ^self]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. suspendedContext ifNotNil: ["Release any method marked with the <criticalSection> pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + "If terminating a process halfways through an unwind, try to complete that unwind block first; + if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner + blocks will be completed in the process." + ctxt := suspendedContext. + [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: + "Contexts under evaluation have already set their complete (tempAt: 2) to true." + [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + outerMost ifNotNil: [ + "This is the outer-most unwind context currently under evaluation; + let's find an inner context executing outerMost's argument block (tempAt: 1)" + (suspendedContext findContextSuchThat: [:ctx | + ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | + "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" + suspendedContext runUntilErrorOrReturnFrom: inner. + "Update the receiver's suspendedContext (the previous step reset its sender to nil); + return, if the execution stack reached its bottom (e.g. in case of non-local returns)." + (suspendedContext := outerMost sender) ifNil: [^self]]]. - "If terminating a process halfways through an unwind, try to complete that unwind block first." - (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil: - [:outer| - (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil: - [:inner| "This is an unwind block currently under evaluation" - suspendedContext runUntilErrorOrReturnFrom: inner]]. + "Now all unwind blocks caught halfway through have been completed; + let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts + searching from the receiver's sender but the receiver itself may be an unwind context." + ctxt := suspendedContext. + ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. + [ctxt isNil] whileFalse: [ + (ctxt tempAt: 2) ifNil: [ + ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + "Create a context for the unwind block and execute it on the unwind block's stack. + Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing + the unwind on the wrong stack preventing the correct execution of non-local returns." + suspendedContext := unwindBlock asContextWithSender: ctxt. + suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. + ctxt := ctxt findNextUnwindContextUpTo: nil]. + + "Reset the context's pc and sender to nil for the benefit of isTerminated." + suspendedContext terminate]! - ctxt := self popTo: suspendedContext bottomContext. - ctxt == suspendedContext bottomContext ifFalse: - [self debugWithTitle: 'Unwind error during termination' translated full: false]. - "Set the context to its endPC for the benefit of isTerminated." - ctxt pc: ctxt endPC]!

1 0

← Newer
1
...
32
33
34
35
36
37
38
39
40
Older →

Jump to page: