Merge branch 'Pharo9.0' into 2021-03-01-Bottom

bootstrap/scripts/4-build.sh

@@ -222,6 +222,11 @@ ${VM} "${PHARO_IMAGE_NAME}.image" "${IMAGE_FLAGS}" eval --save "Metacello new ba
 
 ${VM} "${PHARO_IMAGE_NAME}.image" "${IMAGE_FLAGS}" eval --save "CompilationContext bytecodeBackend: EncoderForSistaV1. CompilationContext optionFullBlockClosure: true. OpalCompiler recompileAll."
 
+#Extending the default number of stack pages.
+#The VM is divorcing all frames to free a stackPage if there is not a free one.
+#We can check the statistics of number of pages free using the "Smalltalk vm parameterAt: 61"
+${VM} "${PHARO_IMAGE_NAME}.image" "${IMAGE_FLAGS}" eval --save "Smalltalk vm parameterAt: 43 put: 32"
+
 ${VM} "${PHARO_IMAGE_NAME}.image" "${IMAGE_FLAGS}" eval --save "MCCacheRepository uniqueInstance enable. FFIMethodRegistry resetAll. PharoSourcesCondenser condenseNewSources. Smalltalk garbageCollect"
 ${VM} "${PHARO_IMAGE_NAME}.image" "${IMAGE_FLAGS}" clean --release
 

src/AST-Core/RBAbstractBlockVisitor.class.st

@@ -12,6 +12,12 @@ Class {
 	#category : #'AST-Core-Visitors'
 }
 
+{ #category : #testing }
+RBAbstractBlockVisitor class >> isAbstract [
+
+	^ self == RBAbstractBlockVisitor
+]
+
 { #category : #enumerating }
 RBAbstractBlockVisitor class >> visit: aTree anySatisfy: aBlock [
 	self

src/AST-Core/RBNode.class.st

@@ -16,6 +16,12 @@ Class {
 	#category : #'AST-Core-Nodes'
 }
 
+{ #category : #testing }
+RBNode class >> isAbstract [
+
+	^ self == RBNode
+]
+
 { #category : #visiting }
 RBNode >> acceptVisitor: aProgramNodeVisitor [
 	self subclassResponsibility

src/AST-Core/RBParseTreeRule.class.st

@@ -17,6 +17,12 @@ Class {
 	#category : #'AST-Core-Matching'
 }
 
+{ #category : #testing }
+RBParseTreeRule class >> isAbstract [
+
+	^ self == RBParseTreeRule
+]
+
 { #category : #'instance creation' }
 RBParseTreeRule class >> methodSearch: aString [ 
 	^(self new)

src/AST-Core/RBProgramNode.class.st

@@ -52,6 +52,12 @@ RBProgramNode class >> formatterClass: aClass [
 
 ]
 
+{ #category : #testing }
+RBProgramNode class >> isAbstract [
+
+	^ self == RBProgramNode
+]
+
 { #category : #accessing }
 RBProgramNode class >> optimizedSelectors [
 	^ #( and: caseOf: caseOf:otherwise: ifFalse: ifFalse:ifTrue: ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: ifTrue: ifTrue:ifFalse: or: to:by:do: to:do: whileFalse whileFalse: whileTrue whileTrue: )

src/AST-Core/RBProgramNodeVisitor.class.st

@@ -9,6 +9,12 @@ Class {
 	#category : #'AST-Core-Visitors'
 }
 
+{ #category : #testing }
+RBProgramNodeVisitor class >> isAbstract [
+
+	^ self == RBProgramNodeVisitor
+]
+
 { #category : #visiting }
 RBProgramNodeVisitor >> visitArgumentNode: anArgumentNode [
 	"Sent *each time* an argument node is found"

src/AST-Core/RBReplaceRule.class.st

@@ -19,6 +19,12 @@ Class {
 	#category : #'AST-Core-Matching'
 }
 
+{ #category : #testing }
+RBReplaceRule class >> isAbstract [
+
+	^ self == RBReplaceRule
+]
+
 { #category : #testing }
 RBReplaceRule >> canMatch: aProgramNode [ 
 	^verificationBlock value: aProgramNode

src/AST-Core/RBToken.class.st

@@ -19,6 +19,12 @@ Class {
 	#category : #'AST-Core-Tokens'
 }
 
+{ #category : #testing }
+RBToken class >> isAbstract [
+
+	^ self == RBToken
+]
+
 { #category : #'instance creation' }
 RBToken class >> start: anInterval [ 
 	^self new start: anInterval

src/AST-Core/RBValueToken.class.st

@@ -15,6 +15,12 @@ Class {
 	#category : #'AST-Core-Tokens'
 }
 
+{ #category : #testing }
+RBValueToken class >> isAbstract [
+
+	^ self == RBValueToken
+]
+
 { #category : #'instance creation' }
 RBValueToken class >> value: aString start: anInteger [ 
 	^self new value: aString start: anInteger

src/BaselineOfIDE/BaselineOfIDE.class.st

@@ -227,11 +227,15 @@ BaselineOfIDE >> baseline: spec [
 BaselineOfIDE >> loadIceberg [
 	Metacello new
 		baseline: 'Iceberg';
-		repository: 'github://pharo-vcs/iceberg:v2.0.3';
+		repository: 'github://pharo-vcs/iceberg:dev-2.0';
 		onConflictUseLoaded;
 		load.
 	(Smalltalk classNamed: #Iceberg) enableMetacelloIntegration: true.
-	(Smalltalk classNamed: #IcePharoPlugin) addPharoProjectToIceberg.
+	(Smalltalk classNamed: #IcePharoPlugin) 
+		addPharoProjectToIceberg;
+		addProjectNamed: 'pharo-spec2' commit: '15cacf316c2bf6e01eae348ac30523433476f1f8' baselines: #(BaselineOfSpec2);
+		addProjectNamed: 'pharo-newtools' commit: '94785f82ef6288de4405b929d7b86faac582be5e' baselines: #(BaselineOfNewTools);
+		addIcebergProjectToIceberg
 ]
 
 { #category : #actions }

src/Calypso-SystemQueries/ClySystemEnvironment.class.st

@@ -120,6 +120,8 @@ ClySystemEnvironment >> compileANewClassFrom: aString notifying: aController sta
 
 	| oldClass class newClassName defTokens keywdIx classCompiler |
 	"for now make it work!"
+	('*<<*' match: aString)
+		ifTrue: [ ClassDefinitionPrinter showFluidClassDefinition: true ].
 	ClassDefinitionPrinter showFluidClassDefinition
 		ifTrue: [ ^ self defineNewClassFrom: aString notifying: aController  startingFrom: aClass ].
 	self flag: #todo. "What horrible horrible logic."

src/Calypso-SystemTools-Core/ClyBrowserMorph.extension.st

@@ -32,35 +32,37 @@ ClyBrowserMorph >> confirmEmptySystemQuery: aQuery excluding: classes [
 	| showResult result |
 
 	result := aQuery execute.
-	(result isEmpty or: [ ((result items collect: [:each | each origin]) difference: classes ) isEmpty]) ifTrue: [ ^true ].
+	(result isEmpty or: [ ((result items collect: [:each | each origin]) difference: classes ) isEmpty]) ifTrue: [ ^#(true false) ].
 
 	showResult := UIManager default confirm: 'There are '
 		, result size asString, ' ', aQuery description, '. Show them?'.
 	showResult ifTrue: [self spawnQueryBrowserOn: aQuery].
-	^false
+	^Array with: false with: showResult
 ]
 
 { #category : #'*Calypso-SystemTools-Core' }
 ClyBrowserMorph >> confirmUnusedClasses: classes [
-
+	"Returns a vector of size 2
+	The first value is TRUE when it doesn't have any reference, subclass or is used (for traits), otherwise is FALSE.
+	The second value is TRUE when in case of having references, subclasses or users and the user agreed to be shown those references, otherwise is FALSE. "
 	| refQuery noUsers answer subclasses users |
 
 	refQuery := ClyClassReferencesQuery toAny: classes from: self systemScope.	
 	"we need to exclude both the class and instance side of the class"
 	noUsers := self confirmEmptySystemQuery: refQuery excluding: (classes flatCollect: [ :each | { each . each classSide } ]).
-
 	subclasses := (classes flatCollect: [:each | each subclasses]) copyWithoutAll: classes.
 	subclasses ifNotEmpty: [ 
-		noUsers := false.
+		noUsers at: 1 put: false.
 		answer := UIManager default confirm: 'There are subclasses. Show them?'.
-		answer ifTrue: [ self spawnQueryBrowserOn: (ClyConstantQuery returning: subclasses) ] ].
+		answer ifTrue: [ self spawnQueryBrowserOn: (ClyConstantQuery returning: subclasses).
+			noUsers at: 2 put: true. ] ].
 
 	users := (classes flatCollect: [:each | each users]) copyWithoutAll: classes.
 	users ifNotEmpty: [ 
-		noUsers := false.
+		noUsers at: 1 put: false.
 		answer := UIManager default confirm: 'There are users of trait. Show them?'. 
-		answer ifTrue: [ self spawnQueryBrowserOn: (ClyConstantQuery returning: users) ]].
-
+		answer ifTrue: [ self spawnQueryBrowserOn: (ClyConstantQuery returning: users).
+			noUsers at: 2 put: true. ]].
 	^noUsers
 ]
 

src/Calypso-SystemTools-Core/SycRemoveMethodCommand.extension.st

@@ -4,7 +4,7 @@ Extension { #name : #SycRemoveMethodCommand }
 SycRemoveMethodCommand class >> methodMenuActivation [
 	<classAnnotation>
 
-	^CmdContextMenuActivation byRootGroupItemOrder: 10000 for: ClyMethod asCalypsoItemContext 
+	^ CmdContextMenuActivation byRootGroupItemOrder: 10000 for: ClyMethod asCalypsoItemContext
 ]
 
 { #category : #'*Calypso-SystemTools-Core' }

src/Calypso-SystemTools-Core/SycRenameMessageInSomePackagesCommand.extension.st

@@ -0,0 +1,20 @@
+Extension { #name : #SycRenameMessageInSomePackagesCommand }
+
+{ #category : #'*Calypso-SystemTools-Core' }
+SycRenameMessageInSomePackagesCommand class >> browserMenuOrder [
+	^ 3
+]
+
+{ #category : #'*Calypso-SystemTools-Core' }
+SycRenameMessageInSomePackagesCommand class >> methodShortcutActivation [
+	<classAnnotation>
+
+	^CmdShortcutActivation by: $k meta for: ClyMethod asCalypsoItemContext
+]
+
+{ #category : #'*Calypso-SystemTools-Core' }
+SycRenameMessageInSomePackagesCommand class >> sourceCodeShortcutActivation [
+	<classAnnotation>
+
+	^CmdShortcutActivation  by: $k meta for: ClyMethodSourceCodeContext
+]

src/Calypso-SystemTools-FullBrowser/ClyMoveClassToGroupCommand.class.st

@@ -21,10 +21,7 @@ Class {
 ClyMoveClassToGroupCommand class >> browserContextMenuActivation [
 	<classAnnotation>
 
-	^ CmdContextMenuActivation  
-		byItemOf: ClyMoreRefactorsMenuGroup  
-		order: 1000
-		for: ClyClass asCalypsoItemContext 
+	^ SycClassMenuActivation byRootGroupItemOrder: 1000 for: ClyClass asCalypsoItemContext
 ]
 
 { #category : #activation }

src/Calypso-SystemTools-FullBrowser/SycRemoveClassCommand.extension.st

@@ -4,7 +4,7 @@ Extension { #name : #SycRemoveClassCommand }
 SycRemoveClassCommand class >> fullBrowserMenuActivation [
 	<classAnnotation>
 
-	^CmdContextMenuActivation byRootGroupItemOrder: 10000 for: ClyFullBrowserClassContext 
+	^CmdContextMenuActivation byRootGroupItemOrder: 10000 for: ClyFullBrowserClassContext
 ]
 
 { #category : #'*Calypso-SystemTools-FullBrowser' }

src/Calypso-SystemTools-QueryBrowser/ClyTextEditor.extension.st

@@ -32,7 +32,7 @@ ClyTextEditor >> implementorsOf: selectedSelector [
 ClyTextEditor >> implementorsOfIt [
 	| selector |
 
-	"self lineSelectAndEmptyCheck: [^ self]."
+	self lineSelectAndEmptyCheck: [^ self].
 	(selector := self selectedSelector) == nil ifTrue: [^ textArea flash].
 	selector 	isCharacter ifTrue: [ ^ textArea flash ].
 	self browser browseImplementorsOf: selector
@@ -82,7 +82,7 @@ ClyTextEditor >> sendersOf: selectedSelector [
 { #category : #'*Calypso-SystemTools-QueryBrowser' }
 ClyTextEditor >> sendersOfIt [
 	| selector |
-	"self lineSelectAndEmptyCheck: [^ self]."
+	self lineSelectAndEmptyCheck: [^ self].
 	(selector := self selectedSelector) == nil ifTrue: [^ textArea flash].
 
 	self sendersOf: selector 

src/Commander-Activators-ContextMenu/CmdCommandActivator.extension.st

@@ -18,14 +18,9 @@ CmdCommandActivator >> registerContextMenuItemsFor: aCommandItem withBuilder: aB
 
 { #category : #'*Commander-Activators-ContextMenu' }
 CmdCommandActivator >> setUpShortcutTipForMenuItem: aMenuItemMorph [
-	| keyText |
 
 	CmdShortcutActivation 
 		activeInstancesFor: command class inContext: context
 		do: [ :shortcut |  	
-			"this is trick to show shortcut on menu with existing menu support"
-			keyText := String streamContents: [:s | 
-				shortcut keyCombination prettyPrintOn: s].
-			keyText := keyText copyWithout: keyText first.
-			aMenuItemMorph keyText: keyText]
+			aMenuItemMorph keyText: (KMShortcutPrinter toString: shortcut keyCombination)]
 ]

src/Fonts-Abstract/AbstractFont.class.st

@@ -1,5 +1,5 @@
 "
-AbstractFont defines the generic interface that all fonts need to implement.
+The abstract class AbstractFont defines the generic interface that all fonts need to implement.
 "
 Class {
 	#name : #AbstractFont,
@@ -37,6 +37,12 @@ AbstractFont class >> initialize [
 	TextStyle addDependent: self
 ]
 
+{ #category : #testing }
+AbstractFont class >> isAbstract [ 
+
+	^self == AbstractFont
+]
+
 { #category : #updating }
 AbstractFont class >> update: anAspect [
 

src/Fonts-Chooser/AbstractFontSelectorDialogWindow.class.st

@@ -19,6 +19,12 @@ Class {
 	#category : #'Fonts-Chooser'
 }
 
+{ #category : #testing }
+AbstractFontSelectorDialogWindow class >> isAbstract [
+
+	^self == AbstractFontSelectorDialogWindow
+]
+
 { #category : #icons }
 AbstractFontSelectorDialogWindow class >> taskbarIconName [
 	"Answer the icon for the receiver in a task bar."

src/Fonts-Chooser/FontChooser.class.st

@@ -23,9 +23,14 @@ Class {
 	#category : #'Fonts-Chooser'
 }
 
+{ #category : #examples }
+FontChooser class >> example [
+	self openWithWindowTitle: 'Choose the Menu Font' for: StandardFonts setSelector: #menuFont: getSelector: #menuFont
+]
+
 { #category : #open }
 FontChooser class >> openWithWindowTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector [
-	"FontChooser openWithWindowTitle: 'Choose the Menu Font' for: StandardFonts setSelector: #menuFont: getSelector: #menuFont"
+	<script: 'self example'>
 
 	| instance windowMorph |
 	instance := self new.

src/GT-Spotter-Processors/SptSpotterProcessor.class.st

@@ -15,7 +15,6 @@ Class {
 	#name : #SptSpotterProcessor,
 	#superclass : #AbstractSpotterProcessor,
 	#instVars : [
-		'order',
 		'filter',
 		'results',
 		'query',

src/GeneralRules-Tests/ReAbstractRuleTestCase.class.st

@@ -4,6 +4,12 @@ Class {
 	#category : #'GeneralRules-Tests-Migrated'
 }
 
+{ #category : #testing }
+ReAbstractRuleTestCase class >> isAbstract [ 
+
+	^self == ReAbstractRuleTestCase 
+]
+
 { #category : #'test-support' }
 ReAbstractRuleTestCase >> critiguesFor: ruleClass onMethod: method [
 	| critiques |

src/Kernel-Tests/BlockClosureTest.class.st

@@ -473,6 +473,11 @@ BlockClosureTest >> testValueWithArgumentsWithOrderedCollection [
 
 ]
 
+{ #category : #'tests - evaluating' }
+BlockClosureTest >> testValueWithExit [
+	self assert: [:exit | 1 ] valueWithExit equals: 1
+]
+
 { #category : #'tests - evaluating' }
 BlockClosureTest >> testValueWithExitBreak [
 	| val |

src/Kernel/BlockClosure.class.st

@@ -875,8 +875,9 @@ BlockClosure >> valueWithEnoughArguments: anArray [
 ]
 
 { #category : #evaluating }
-BlockClosure >> valueWithExit [ 
-	  self value: [ ^nil ]
+BlockClosure >> valueWithExit [
+
+	^ self value: [ ^ nil ]
 ]
 
 { #category : #evaluating }

src/Kernel/CompiledCode.class.st

@@ -185,8 +185,22 @@ CompiledCode >> comment [
 
 { #category : #'source code management' }
 CompiledCode >> definition [
+
 	"Polymorphic to class definition"
-
+
+	self
+		deprecated: #definition
+		transformWith:
+		'`@receiver definition' -> '`@receiver definitionString'.
+
+	^ self definitionString
+]
+
+{ #category : #'source code management' }
+CompiledCode >> definitionString [
+
+	"Polymorphic to class definitionString"
+
 	^ self sourceCode
 ]