Implementation and tests for add and remove classes from orEnvironments

src/NewTools-Scopes-Editor/ScopeNodesPresenter.class.st

@@ -1,5 +1,5 @@
 "
-I display a tree with all the available packages and classes to create a scope
+I display a tree with all the available packages and classes to create or edit a scope
 "
 Class {
 	#name : 'ScopeNodesPresenter',

src/NewTools-Scopes-Editor/ScopeRequestLabel.class.st

@@ -1,3 +1,6 @@
+"
+I am a presenter where users enter the name of a new scope
+"
 Class {
 	#name : 'ScopeRequestLabel',
 	#superclass : 'SpRequestTextDialog',

src/NewTools-Scopes-Editor/ScopesPresenter.class.st

@@ -1,6 +1,6 @@
 "
-I am the main Scope Browser presenter. 
-I show the list of existing scopes in the system and allow to create, edit and delete scopes.
+I am the main Scopes Editor presenter. 
+I show the list of existing scopes in the system and allow users to create, edit and delete scopes.
 "
 Class {
 	#name : 'ScopesPresenter',

src/NewTools-Scopes-Resources-A-Tests/ScClassA1.class.st

@@ -0,0 +1,6 @@
+Class {
+	#name : 'ScClassA1',
+	#superclass : 'Object',
+	#category : 'NewTools-Scopes-Resources-A-Tests',
+	#package : 'NewTools-Scopes-Resources-A-Tests'
+}

src/NewTools-Scopes-Resources-A-Tests/ScClassA2.class.st

@@ -0,0 +1,6 @@
+Class {
+	#name : 'ScClassA2',
+	#superclass : 'Object',
+	#category : 'NewTools-Scopes-Resources-A-Tests',
+	#package : 'NewTools-Scopes-Resources-A-Tests'
+}

src/NewTools-Scopes-Resources-A-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'NewTools-Scopes-Resources-A-Tests' }

src/NewTools-Scopes-Resources-B-Tests/ScClassB1.class.st

@@ -0,0 +1,6 @@
+Class {
+	#name : 'ScClassB1',
+	#superclass : 'Object',
+	#category : 'NewTools-Scopes-Resources-B-Tests',
+	#package : 'NewTools-Scopes-Resources-B-Tests'
+}

src/NewTools-Scopes-Resources-B-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'NewTools-Scopes-Resources-B-Tests' }

src/NewTools-Scopes-Tests/ScopesManagesOperationsTest.class.st

@@ -0,0 +1,59 @@
+Class {
+	#name : 'ScopesManagesOperationsTest',
+	#superclass : 'TestCase',
+	#category : 'NewTools-Scopes-Tests',
+	#package : 'NewTools-Scopes-Tests'
+}
+
+{ #category : 'tests' }
+ScopesManagesOperationsTest >> testAddClassAndFillPackageInOrEnvironment [
+
+	| packageEnv classEnvA1 orEnv |
+
+	"class environment missing one class to complete the full package"
+	classEnvA1 := RBBrowserEnvironment new forClasses: { ScClassA1 }.
+
+	"empty package environment"
+	packageEnv := RBBrowserEnvironment new forPackages: { }.
+
+	orEnv := RBOrEnvironment onEnvironment: classEnvA1 or: packageEnv.
+
+	orEnv addClass: ScClassA2.
+	orEnv addClass: ScClassA2 class.
+
+	self assert: orEnv allClasses equals: { ScClassA1 . ScClassA2 }.
+	self assert: orEnv packages equals: { ScClassA1 package }
+]
+
+{ #category : 'tests' }
+ScopesManagesOperationsTest >> testRemoveClassInClassEnvironmentFromOrEnvironment [
+
+	| classEnvA1 packageEnvB orEnv |
+
+	classEnvA1 := RBBrowserEnvironment new forClasses: { ScClassA1 }.
+	packageEnvB := RBBrowserEnvironment new forPackages: { ScClassB1 package }.
+
+	orEnv := RBOrEnvironment onEnvironment: classEnvA1 or: packageEnvB.
+	orEnv removeClass: ScClassA1.
+	orEnv removeClass: ScClassA1 class.
+
+	self assert: orEnv allClasses asSet equals: ScClassB1 package definedClasses 
+]
+
+{ #category : 'tests' }
+ScopesManagesOperationsTest >> testRemoveClassInPackageEnvironmentFromOrEnvironment [
+
+	| packageEnvA classEnv orEnv |
+
+	"empty class environment"
+	classEnv := RBBrowserEnvironment new forClasses: { }.
+
+	"environment packageEnvA has two classes: ScClassA1 and ScClassA2"
+	packageEnvA := RBBrowserEnvironment new forPackages: { ScClassA1 package }.
+
+	orEnv := RBOrEnvironment onEnvironment: classEnv or: packageEnvA.
+	orEnv removeClass: ScClassA1.
+	orEnv removeClass: ScClassA1 class.
+
+	self assert: orEnv allClasses equals: { ScClassA2 } 
+]

src/NewTools-Scopes-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'NewTools-Scopes-Tests' }

src/NewTools-Scopes/RBCompositeEnvironment.extension.st

@@ -2,8 +2,31 @@ Extension { #name : 'RBCompositeEnvironment' }
 
 { #category : '*NewTools-Scopes' }
 RBCompositeEnvironment >> addClass: aClass [
-	self environment addClass: aClass.
-	self otherEnvironment addClass: aClass
+
+	| envs classEnv packaEnv siblings |
+	self isTerminal ifFalse: [
+		self environment addClass: aClass.
+		self otherEnvironment addClass: aClass.
+		^ self ].
+
+	"I am terminal. This method assumes that I have one classEnv and one packageEnv"
+	envs := {
+		        self environment.
+		        self otherEnvironment }.
+
+	classEnv := (envs select: [ :env | env isClassEnvironment ]) anyOne.
+	packaEnv := (envs select: [ :env | env isPackageEnvironment ]) anyOne.
+
+	"Get the classes in the same package as aClass (siblings)"
+	siblings := classEnv allClasses select: [ :class |
+		            class package = aClass package ].
+	"If the package is now full, then add the package and remove the siblings"
+	(siblings asSet add: aClass; yourself) size = aClass package definedClasses size ifTrue: [
+		siblings do: [ :each | classEnv removeClass: each ].
+		packaEnv addPackage: aClass package.
+		^ self ].
+
+	classEnv addClass: aClass
 ]
 
 { #category : '*NewTools-Scopes' }
@@ -14,8 +37,29 @@ RBCompositeEnvironment >> addPackage: aPackageName [
 
 { #category : '*NewTools-Scopes' }
 RBCompositeEnvironment >> removeClass: aClass [
-	self environment removeClass: aClass.
-	self otherEnvironment removeClass: aClass
+
+	| envs  classEnv packaEnv packagesToRemove classesToAdd |
+	self isTerminal ifFalse: [
+		self environment removeClass: aClass.
+		self otherEnvironment removeClass: aClass.
+		^ self ].
+
+	"I am terminal. This method assumes that I have one classEnv and one packageEnv"
+	envs := { self environment . self otherEnvironment }.
+
+	"Remove aClass from my classEnvironment"
+	classEnv := (envs select: [ :env | env isClassEnvironment ]) anyOne.
+	classEnv removeClass: aClass.
+
+	packaEnv := (envs select: [ :env | env isPackageEnvironment ]) anyOne.
+
+	"Packages containing aClass must be removed from the package environment"
+	packagesToRemove := packaEnv packages select: [ :package | package definedClasses includes: aClass ].
+	packagesToRemove do: [ :p | 
+		packaEnv removePackage: p.
+		classesToAdd := p definedClasses reject: [ :class | class = aClass ].
+		classesToAdd do: [ :class | classEnv addClass: class ] ]
+
 ]
 
 { #category : '*NewTools-Scopes' }

src/NewTools-Scopes/ScopesManager.class.st

@@ -193,34 +193,36 @@ ScopesManager >> defaultScopeLabel [
 ]
 
 { #category : 'editing' }
-ScopesManager >> editScope: aScope withNodes: aCollection [ 
-	| classesInScope packagesInScope classes packages fullPackages orphanClasses addedClasses removedClasses addedPackages removedPackages |
-
-	classesInScope := aScope classes.
+ScopesManager >> editScope: aScope withNodes: aCollection [
+
+	| classesInScope packagesInScope classes packages fullPackages orphanClasses addedClasses removedClasses addedPackages removedPackages fullPackagesInScope orphanClassesInScope |
+
+	classesInScope := aScope classes reject: [ :each | each isMeta ].
 	packagesInScope := aScope packages.
 
-	classes := (aCollection select: [ :each | each isClassOrTrait ]) reject: [
-		           :each | each isMeta ].
-	classes := aScope classes asSet addAll: classes; yourself.
+	fullPackagesInScope := self fullPackagesFrom: classesInScope.
+	orphanClassesInScope := self orphanClassesIn: classesInScope havingFullPackages: fullPackagesInScope. 
 
+	classes := (aCollection select: [ :each | each isClassOrTrait ])
+		           reject: [ :each | each isMeta ].
 	packages := aCollection select: [ :each | each isKindOf: RPackage ].
-	packages := aScope packages asSet addAll: packages; yourself.
-
+
 	fullPackages := self fullPackagesFrom: classes.
 	orphanClasses := self orphanClassesIn: classes havingFullPackages: fullPackages.
-	
+
 	addedClasses := orphanClasses reject: [ :aClass | classesInScope includes: aClass ].
 	removedClasses := classesInScope reject: [ :aClass | orphanClasses includes: aClass ].
-	
-	addedPackages := fullPackages reject: [ :aPackage | packagesInScope includes: aPackage ].
-	removedPackages := packagesInScope reject: [ :aPackage | fullPackages includes: aPackage ].
-	
+
+	addedPackages := fullPackages reject: [ :aPackage | fullPackagesInScope includes: aPackage ].
+	removedPackages := fullPackagesInScope reject: [ :aPackage | fullPackages includes: aPackage ].
+
 	addedClasses do: [ :aClass | aScope addClass: aClass ].
 	removedClasses do: [ :aClass | aScope removeClass: aClass ].
-	
+
 	addedPackages do: [ :aPackage | aScope addPackage: aPackage name ].
-	removedPackages do: [ :aPackage | aScope removePackage: aPackage name ].
-
+	removedPackages do: [ :aPackage |
+		aScope removePackage: aPackage name ].
+
 	^ aScope
 ]