Merge pull request #8901 from gcorriga/2586-Deleting-a-class-with-ref…

…erences-gives-extra-Do-you-want-to-delete-anyway-msg

2586 deleting a class with references gives extra do you want to delete anyway msg

src/BaselineOfSystemCommands/BaselineOfSystemCommands.class.st

@@ -18,6 +18,9 @@ BaselineOfSystemCommands >> baseline: spec [
 				package: #'SystemCommands-ClassCommands'
 					with:
 						[ spec requires: #('Commander' #'SystemCommands-RefactoringSupport') ];
+				package: #'SystemCommands-ClassCommands-Tests'
+					with:
+						[ spec requires: #(#'SystemCommands-ClassCommands') ];
 				package: #'SystemCommands-MessageCommands'
 					with:
 						[ spec requires: #('Commander' #'SystemCommands-RefactoringSupport') ];

src/Calypso-NavigationModel-Tests/ClyConstantQueryTest.class.st

@@ -6,9 +6,26 @@ Class {
 
 { #category : #running }
 ClyConstantQueryTest >> createQuery [
+
+	^ self createQuery: #( #item1 #item2 )
+]
+
+{ #category : #running }
+ClyConstantQueryTest >> createQuery: aCollection [
+
 	^ ClyConstantQuery
-		returning: #(item1 item2)
-		from: (ClyScopeExample emptyIn: environment)
+		  returning: aCollection
+		  from: (ClyScopeExample emptyIn: environment)
+]
+
+{ #category : #tests }
+ClyConstantQueryTest >> testCheckingForEmptyResult [
+
+	| empty notEmpty |
+	empty := self createQuery: #().
+	notEmpty := self createQuery.
+	self assert: empty checkEmptyResult;
+		deny: notEmpty checkEmptyResult.
 ]
 
 { #category : #tests }

src/Calypso-NavigationModel-Tests/ClyQueryResultTest.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #ClyQueryResultTest,
+	#superclass : #TestCase,
+	#category : #'Calypso-NavigationModel-Tests-Result'
+}

src/Calypso-NavigationModel-Tests/ClyQueryResultTestCase.class.st

@@ -38,6 +38,13 @@ ClyQueryResultTestCase >> setUp [
 
 ]
 
+{ #category : #tests }
+ClyQueryResultTestCase >> testCheckingForEmpty [
+	self
+		assert: queryResult isEmpty;
+		deny: queryResult notEmpty
+]
+
 { #category : #tests }
 ClyQueryResultTestCase >> testComparisonWithAnotherKindOfResult [
 	self deny: queryResult equals: ClyQueryResult new
@@ -99,14 +106,6 @@ ClyQueryResultTestCase >> testItemsChangedNotificationShouldResetItems [
 	self assert: queryResult items isNil
 ]
 
-{ #category : #tests }
-ClyQueryResultTestCase >> testItemsInitialization [
-
-	queryResult initializeItems.
-
-	self assert: queryResult items notNil
-]
-
 { #category : #tests }
 ClyQueryResultTestCase >> testNeedsRebuildByDefault [
 

src/Calypso-NavigationModel/ClyConstantQuery.class.st

@@ -70,7 +70,7 @@ ClyConstantQuery >> buildResult: aQueryResult [
 
 { #category : #execution }
 ClyConstantQuery >> checkEmptyResult [
-	^resultItems notEmpty
+	^resultItems isEmpty
 ]
 
 { #category : #execution }

src/Calypso-NavigationModel/ClyQueryResult.class.st

@@ -416,6 +416,11 @@ ClyQueryResult >> needsRebuild [
 	^needsRebuild 
 ]
 
+{ #category : #testing }
+ClyQueryResult >> notEmpty [
+	^self isEmpty not
+]
+
 { #category : #'system changes' }
 ClyQueryResult >> notifyChanges [
 

src/Calypso-SystemQueries-Tests/ClyClassExternalReferencesQueryTest.class.st

@@ -0,0 +1,26 @@
+Class {
+	#name : #ClyClassExternalReferencesQueryTest,
+	#superclass : #ClyMethodQueryTestCase,
+	#category : #'Calypso-SystemQueries-Tests-Queries'
+}
+
+{ #category : #running }
+ClyClassExternalReferencesQueryTest >> createQuery [
+	^ ClyClassExternalReferencesQuery
+		to: self referencedClass
+		from: (ClyClassScope of: Object in: environment)
+]
+
+{ #category : #running }
+ClyClassExternalReferencesQueryTest >> referencedClass [
+	"Use an explicit reference instead of 'self class'"
+	^ClyClassExternalReferencesQueryTest
+]
+
+{ #category : #tests }
+ClyClassExternalReferencesQueryTest >> testFromSystemScope [
+
+	self queryFromScope: ClySystemEnvironmentScope of: ClySystemEnvironment currentImage.
+	"Expect the query to be empty even though the class references itself in #referencedClass"
+	self assert: resultItems isEmpty
+]

src/Calypso-SystemQueries/ClyClassExternalReferencesQuery.class.st

@@ -0,0 +1,14 @@
+Class {
+	#name : #ClyClassExternalReferencesQuery,
+	#superclass : #ClyClassReferencesQuery,
+	#category : #'Calypso-SystemQueries-Queries'
+}
+
+{ #category : #execution }
+ClyClassExternalReferencesQuery >> buildResult: aQueryResult [
+	| toExclude |
+
+	super buildResult: aQueryResult.
+	toExclude := self variableQuery resultItems flatCollect: [ :each | { each . each classSide } ].
+	aQueryResult items removeAllSuchThat: [ :each | toExclude includes: each origin ]
+]

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

@@ -66,24 +66,6 @@ ClyBrowserMorph >> confirmUnusedClasses: classes [
 	^noUsers
 ]
 
-{ #category : #'*Calypso-SystemTools-Core' }
-ClyBrowserMorph >> confirmUnusedClassesExceptInheritance: classes [
-
-	| refQuery noUsers answer 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 } ]).
-
-	users := (classes flatCollect: [:each | each users]) copyWithoutAll: classes.
-	users ifNotEmpty: [ 
-		noUsers := false.
-		answer := UIManager default confirm: 'There are users of trait. Show them?'. 
-		answer ifTrue: [ self spawnQueryBrowserOn: (ClyConstantQuery returning: users) ]].
-
-	^noUsers
-]
-
 { #category : #'*Calypso-SystemTools-Core' }
 ClyBrowserMorph >> confirmUnusedVariables: variables [
 
@@ -113,6 +95,29 @@ ClyBrowserMorph >> isMethodSelected: aMethod [
 	^self methodSelection includesActualObject: aMethod
 ]
 
+{ #category : #'*Calypso-SystemTools-Core' }
+ClyBrowserMorph >> requestRemoveClassStrategyFor: classes [
+
+	| result strategies title |
+	strategies := SycRemoveClassStrategy
+		              createForBrowser: self
+		              classes: classes.
+
+	strategies size = 1 ifTrue: [ ^ strategies first ].
+
+	title := classes size = 1
+		ifTrue: [ 'Class has references, subclasses, or users' ]
+		ifFalse: [ 'Classes have references, subclasses, or users' ].
+
+	result := UIManager default
+		          chooseFrom:
+		          (strategies collect: [ :each | each userRequestString ])
+		          values: strategies
+		          title: title.
+
+	^ result ifNil: [ SycNotRemoveClassStrategy new ]
+]
+
 { #category : #'*Calypso-SystemTools-Core' }
 ClyBrowserMorph >> requestRemoveMethodStrategyFor: methods [
 	| selectors result strategies caption  senders senderCount plural |

src/Calypso-SystemTools-Core/ClySystemBrowserContext.class.st

@@ -53,11 +53,6 @@ ClySystemBrowserContext >> confirmUnusedClasses: variables [
 	^tool confirmUnusedClasses: variables
 ]
 
-{ #category : #'user requests' }
-ClySystemBrowserContext >> confirmUnusedClassesExceptInheritance: variables [
-	^tool confirmUnusedClassesExceptInheritance: variables
-]
-
 { #category : #'user requests' }
 ClySystemBrowserContext >> confirmUnusedVariables: variables [
 	^tool confirmUnusedVariables: variables
@@ -188,6 +183,11 @@ ClySystemBrowserContext >> requestMultipleVariables: queryTitle from: classes [
 		inScope: (ClyClassScope ofAll: classes) withInheritedScope
 ]
 
+{ #category : #'user requests' }
+ClySystemBrowserContext >> requestRemoveClassStrategyFor: classes [
+	^tool requestRemoveClassStrategyFor: classes
+]
+
 { #category : #'user requests' }
 ClySystemBrowserContext >> requestRemoveMethodStrategyFor: methods [
 	^tool requestRemoveMethodStrategyFor: methods

src/Calypso-SystemTools-QueryBrowser-Tests/ClyNotRemoveAndShowReferencesClassStrategyTest.class.st

@@ -0,0 +1,18 @@
+"
+A ClyNotRemoveAndShowReferencesClassStrategyTest is a test class for testing the behavior of ClyNotRemoveAndShowReferencesClassStrategy
+"
+Class {
+	#name : #ClyNotRemoveAndShowReferencesClassStrategyTest,
+	#superclass : #TestCase,
+	#category : #'Calypso-SystemTools-QueryBrowser-Tests-Commands-Classes'
+}
+
+{ #category : #tests }
+ClyNotRemoveAndShowReferencesClassStrategyTest >> testExecutingCommand [
+	| browser command strategy |
+	browser := MockClyBrowser new.
+	strategy := ClyNotRemoveAndShowReferencesClassStrategy newForBrowser: browser.
+	command := SycRemoveClassCommand for: { SycRemoveClassCommand }.
+	strategy execute: command.
+	self assert: browser hasSpawnedQueryBrowser
+]

src/Calypso-SystemTools-QueryBrowser-Tests/ClyNotRemoveAndShowSubclassesClassStrategyTest.class.st

@@ -0,0 +1,18 @@
+"
+A ClyNotRemoveAndShowSubclassesClassStrategyTest is a test class for testing the behavior of ClyNotRemoveAndShowSubclassesClassStrategy
+"
+Class {
+	#name : #ClyNotRemoveAndShowSubclassesClassStrategyTest,
+	#superclass : #TestCase,
+	#category : #'Calypso-SystemTools-QueryBrowser-Tests-Commands-Classes'
+}
+
+{ #category : #tests }
+ClyNotRemoveAndShowSubclassesClassStrategyTest >> testExecutingCommand [
+	| browser command strategy |
+	browser := MockClyBrowser new.
+	strategy := ClyNotRemoveAndShowSubclassesClassStrategy newForBrowser: browser.
+	command := SycRemoveClassCommand for: { ClyInteractiveRemoveClassStrategy }.
+	strategy execute: command.
+	self assert: (browser hasSpawnedQueryBrowserOn: ClyInteractiveRemoveClassStrategy allSubclasses)
+]

src/Calypso-SystemTools-QueryBrowser-Tests/ClyNotRemoveAndShowUsersClassStrategyTest.class.st

@@ -0,0 +1,18 @@
+"
+A ClyNotRemoveAndShowUsersClassStrategyTest is a test class for testing the behavior of ClyNotRemoveAndShowUsersClassStrategy
+"
+Class {
+	#name : #ClyNotRemoveAndShowUsersClassStrategyTest,
+	#superclass : #TestCase,
+	#category : #'Calypso-SystemTools-QueryBrowser-Tests-Commands-Classes'
+}
+
+{ #category : #tests }
+ClyNotRemoveAndShowUsersClassStrategyTest >> testExecutingCommand [
+	| browser command strategy |
+	browser := MockClyBrowser new.
+	strategy := ClyNotRemoveAndShowUsersClassStrategy newForBrowser: browser.
+	command := SycRemoveClassCommand for: { TRBProgramNodeVisitor }.
+	strategy execute: command.
+	self assert: (browser hasSpawnedQueryBrowserOn: TRBProgramNodeVisitor users)
+]

src/Calypso-SystemTools-QueryBrowser-Tests/MockClyBrowser.class.st

@@ -0,0 +1,34 @@
+Class {
+	#name : #MockClyBrowser,
+	#superclass : #Object,
+	#instVars : [
+		'hasSpawned',
+		'elements'
+	],
+	#category : #'Calypso-SystemTools-QueryBrowser-Tests-Commands-Classes'
+}
+
+{ #category : #testing }
+MockClyBrowser >> hasSpawnedQueryBrowser [
+
+	^hasSpawned 
+]
+
+{ #category : #testing }
+MockClyBrowser >> hasSpawnedQueryBrowserOn: aCollection [
+
+	^hasSpawned and: [ elements resultItems asArray = aCollection asArray ]
+]
+
+{ #category : #initialization }
+MockClyBrowser >> initialize [
+
+	hasSpawned := false
+]
+
+{ #category : #mocking }
+MockClyBrowser >> spawnQueryBrowserOn: aCollection [
+
+	hasSpawned := true.
+	elements := aCollection
+]

src/Calypso-SystemTools-QueryBrowser/ClyInteractiveRemoveClassStrategy.class.st

@@ -0,0 +1,37 @@
+"
+I am the abstract strategy to be used in those cases where a class can't be removed.
+
+My concrete subclasses allow the users to browse the references, subclasses, or users preventing the removal of the class.
+"
+Class {
+	#name : #ClyInteractiveRemoveClassStrategy,
+	#superclass : #SycRemoveClassStrategy,
+	#instVars : [
+		'browser'
+	],
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyInteractiveRemoveClassStrategy class >> isAbstract [
+	^self == ClyInteractiveRemoveClassStrategy 
+]
+
+{ #category : #'instance creation' }
+ClyInteractiveRemoveClassStrategy class >> newForBrowser: aBrowser [
+
+	^self new 
+		browser: aBrowser
+]
+
+{ #category : #accessing }
+ClyInteractiveRemoveClassStrategy >> browser [
+
+	^ browser
+]
+
+{ #category : #accessing }
+ClyInteractiveRemoveClassStrategy >> browser: anObject [
+
+	browser := anObject
+]

src/Calypso-SystemTools-QueryBrowser/ClyNotRemoveAndShowReferencesClassStrategy.class.st

@@ -0,0 +1,31 @@
+"
+I am the strategy to be used when a class can't be removed due to the presence of references.
+
+I allow the user to browse those references.
+"
+Class {
+	#name : #ClyNotRemoveAndShowReferencesClassStrategy,
+	#superclass : #ClyInteractiveRemoveClassStrategy,
+	#category : #'Calypso-SystemTools-QueryBrowser-Commands-Classes'
+}
+
+{ #category : #testing }
+ClyNotRemoveAndShowReferencesClassStrategy class >> canExecuteWithReferences: hasReferences subclasses: hasSubclasses users: hasUsers [
+	^hasReferences 
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> execute: aSycRemoveClassCommand [
+
+	(ClyShowClassRefCommand forClasses: (aSycRemoveClassCommand classes flatCollect: [ :each | { each. each class } ]) by: browser) execute
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> orderForBrowser [
+	^5
+]
+
+{ #category : #execution }
+ClyNotRemoveAndShowReferencesClassStrategy >> userRequestString [
+	^'Don''t remove, but show me those references'
+]