GS64: Add Collections packages

rowan/components/Deployment.ston

@@ -1,10 +1,12 @@
 RwSimpleProjectLoadComponentV2 {
   #name : 'Deployment',
+  #preloadDoitName : 'scripts/defineExceptionAliases',
   #projectNames : [ ],
   #componentNames : [ ],
   #packageNames : [
     'Buoy-Assertions',
     'Buoy-Assertions-Extensions',
+    'Buoy-Collections',
     'Buoy-Collections-Extensions',
     'Buoy-Collections-GS64-Extensions',
     'Buoy-Comparison',

rowan/components/Tests.ston

@@ -8,6 +8,7 @@ RwSimpleProjectLoadComponentV2 {
   ],
   #packageNames : [
     'Buoy-Assertions-Tests',
+    'Buoy-Collections-Tests',
     'Buoy-Comparison-Tests',
     'Buoy-Conditions-Tests',
     'Buoy-Dynamic-Binding-Tests',

rowan/components/scripts/defineExceptionAliases.st

@@ -0,0 +1,10 @@
+| symbolDictionary |
+symbolDictionary := Rowan image 
+	symbolDictNamed:'Buoy'
+	ifAbsent: [
+			Rowan image symbolList createDictionaryNamed: 'Buoy' at: 1.
+			Rowan image symbolDictNamed:'Buoy'
+	].
+symbolDictionary at: #SubscriptOutOfBounds put: OffsetError.
+symbolDictionary at: #NotFound put: LookupError.
+

source/BaselineOfBuoy/BaselineOfBuoy.class.st

@@ -58,8 +58,12 @@ BaselineOfBuoy >> baselineCollections: spec [
 		package: 'Buoy-Collections-Extensions'
 		with: [ spec requires: 'Buoy-Collections' ];
 		group: 'Deployment' with: 'Buoy-Collections-Extensions';
+		package: 'Buoy-Collections-Pharo-Extensions'
+		with: [ spec requires: 'Buoy-Collections' ];
+		group: 'Deployment' with: 'Buoy-Collections-Pharo-Extensions';
 		package: 'Buoy-Collections-Tests' with: [
 			spec requires: #( 'Buoy-Collections' 'Buoy-Collections-Extensions'
+					   'Buoy-Collections-Pharo-Extensions'
 					   'Dependent-SUnit-Extensions' ) ];
 		group: 'Tests' with: 'Buoy-Collections-Tests'
 ]

source/Buoy-Collections/Collection.extension.st → source/Buoy-Collections-Extensions/Collection.extension.st

@@ -1,30 +1,30 @@
 Extension { #name : #Collection }
 
-{ #category : #'*Buoy-Collections' }
+{ #category : #'*Buoy-Collections-Extensions' }
 Collection >> asOrderedSet [
 
 	^ self as: OrderedSet
 ]
 
-{ #category : #'*Buoy-Collections' }
+{ #category : #'*Buoy-Collections-Extensions' }
 Collection >> maxUsing: aBlock [
 
 	^ self maxUsing: aBlock ifEmpty: [ self errorEmptyCollection ]
 ]
 
-{ #category : #'*Buoy-Collections' }
+{ #category : #'*Buoy-Collections-Extensions' }
 Collection >> maxUsing: aBlock ifEmpty: ifEmptyBlock [
 
 	^ self ifEmpty: ifEmptyBlock ifNotEmpty: [ self inject: ( aBlock value: self anyOne ) into: [ :max :each | max max: ( aBlock value: each ) ] ]
 ]
 
-{ #category : #'*Buoy-Collections' }
+{ #category : #'*Buoy-Collections-Extensions' }
 Collection >> minUsing: aBlock [
 
 	^ self minUsing: aBlock ifEmpty: [ self errorEmptyCollection ]
 ]
 
-{ #category : #'*Buoy-Collections' }
+{ #category : #'*Buoy-Collections-Extensions' }
 Collection >> minUsing: aBlock ifEmpty: ifEmptyBlock [
 
 	^ self ifEmpty: ifEmptyBlock ifNotEmpty: [ self inject: ( aBlock value: self anyOne ) into: [ :max :each | max min: ( aBlock value: each ) ] ]

source/Buoy-Collections-Extensions/SequenceableCollection.extension.st

@@ -1,5 +1,23 @@
 Extension { #name : #SequenceableCollection }
 
+{ #category : #'*Buoy-Collections-Extensions' }
+SequenceableCollection >> copyFirst: n [
+
+	^ [ self copyFrom: 1 to: n ] unless: n = 0 inWhichCase: [ self species new ]
+]
+
+{ #category : #'*Buoy-Collections-Extensions' }
+SequenceableCollection >> copyNoMoreThanFirst: n [
+
+	^ self copyFirst: ( self size min: n )
+]
+
+{ #category : #'*Buoy-Collections-Extensions' }
+SequenceableCollection >> copyNoMoreThanLast: n [
+
+	^ self copyLast: ( n min: self size )
+]
+
 { #category : #'*Buoy-Collections-Extensions' }
 SequenceableCollection >> equalityChecker [
 

source/Buoy-Collections-GS64-Extensions/Array.extension.st

@@ -0,0 +1,21 @@
+Extension { #name : #Array }
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Array >> fillFrom: aCollection with: aBlock [
+
+	| index |
+	index := 0.
+	aCollection do: [ :each |
+		self at: (index := index + 1) put: (aBlock value: each) ]
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Array class >> newFrom: aCollection [
+	"Answer an instance of me containing the same elements as aCollection."
+
+	| newArray |
+	newArray := self new: aCollection size.
+	1 to: aCollection size do: [ :i |
+	newArray at: i put: (aCollection at: i) ].
+	^ newArray
+]

source/Buoy-Collections-GS64-Extensions/Collection.extension.st

@@ -6,6 +6,70 @@ Collection >> anyOne [
 	^ self any
 ]
 
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> as: aSimilarClass [
+	"Create an object of class aSimilarClass that has similar contents to the receiver if the object is not already an instance of this class."
+
+	aSimilarClass == self class ifTrue: [ ^ self ].
+
+	^ aSimilarClass newFrom: self
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> collect: aBlock as: aClass [
+	"Evaluate aBlock with each of the receiver's elements as the argument.
+	Collect the resulting values into an instance of aClass. Answer the resulting collection."
+
+	^(aClass new: self size) fillFrom: self with: aBlock
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> count: aBlock [
+	"Evaluate aBlock with each of the receiver's elements as the argument.
+	Answer the number of elements that answered true."
+
+	| sum |
+	sum := 0.
+	self do: [ :each | (aBlock value: each) ifTrue: [ sum := sum + 1 ] ].
+	^ sum
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> detect: aBlock ifFound: foundBlock [
+	"Evaluate aBlock with each of the receiver's elements as the argument.
+	If some element evaluates aBlock to true, then cull this element into
+	foundBlock.
+	If no element matches the criteria then do nothing.
+	Always returns self to avoid misuse and a potential isNil check on the sender."
+
+	self
+		detect: aBlock
+		ifFound: foundBlock
+		ifNone: [ "Do nothing on purpose" ]
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> detect: aBlock ifFound: foundBlock ifNone: exceptionBlock [
+	"Evaluate aBlock with each of the receiver's elements as the argument.
+	If some element evaluates aBlock to true, then cull this element into
+	foundBlock and answer the result of this evaluation.
+	If none evaluate to true, then evaluate exceptionBlock."
+
+	self do: [ :each |
+		(aBlock value: each) ifTrue: [ ^ foundBlock cull: each ] ].
+	^ exceptionBlock value
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> fillFrom: aCollection with: aBlock [
+	"Private.
+	Evaluate aBlock with each of aCollections's elements as the argument.
+	Collect the resulting values into self. Answer self."
+
+	aCollection do: [ :each |
+		self add: (aBlock value: each) ]
+]
+
 { #category : #'*Buoy-Collections-GS64-Extensions' }
 Collection >> ifEmpty: emptyBlock ifNotEmpty: notEmptyBlock [
 
@@ -20,6 +84,26 @@ Collection >> isSequenceable [
 	^ false
 ]
 
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection class >> newFrom: aCollection [
+	"Answer an instance of me containing the same elements as aCollection."
+
+	| newCollection |
+	newCollection := self new: aCollection size.
+	newCollection addAll: aCollection.
+	^ newCollection
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+Collection >> removeAll [
+	"Remove each element from the receiver and leave it empty.
+	There are two good reasons why a subclass should override this message:
+	1) the subclass does not support being modified while being iterated
+	2) the subclass provides a much faster way than iterating through each element"
+
+	self do: [ :each | self remove: each ]
+]
+
 { #category : #'*Buoy-Collections-GS64-Extensions' }
 Collection >> select: selectBlock thenCollect: collectBlock [
 

source/Buoy-Collections-GS64-Extensions/SequenceableCollection.extension.st

@@ -1,7 +1,45 @@
 Extension { #name : #SequenceableCollection }
 
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+SequenceableCollection >> anyOne [
+
+	^ self first
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+SequenceableCollection >> copyAfter: anElement [
+	"Answer a copy of the receiver from after the first occurrence
+	of anElement up to the end. If no such element exists, answer
+	an empty copy."
+
+	^ self allButFirst: (self indexOf: anElement ifAbsent: [^ self copyEmpty])
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+SequenceableCollection >> endsWith: aSequenceableCollection [
+	"Answer true if the receiver ends with the argument collection"
+
+	| start |
+	aSequenceableCollection ifEmpty: [ ^true ].
+	(self size < aSequenceableCollection size) ifTrue: [^false].
+	start := self size - aSequenceableCollection size.
+	aSequenceableCollection withIndexDo: [:each :index | (self at: start + index) ~= each ifTrue: [^false]].
+	^true
+]
+
 { #category : #'*Buoy-Collections-GS64-Extensions' }
 SequenceableCollection >> isSequenceable [
 
 	^ true
 ]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+SequenceableCollection >> removeAll [
+
+	self ifNotEmpty: [ self removeFrom: 1 to: self size ]
+]
+
+{ #category : #'*Buoy-Collections-GS64-Extensions' }
+SequenceableCollection >> writeStream [
+	^ WriteStream on: self
+]

source/Buoy-Collections-Pharo-Extensions/SequenceableCollection.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #SequenceableCollection }
+
+{ #category : #'*Buoy-Collections-Pharo-Extensions' }
+SequenceableCollection >> copyLast: n [
+
+	^ [ self copyFrom: self size - n + 1 to: self size ] unless: n = 0 inWhichCase: [ self species new ]
+]

source/Buoy-Collections-Pharo-Extensions/package.st

@@ -0,0 +1 @@
+Package { #name : #'Buoy-Collections-Pharo-Extensions' }

source/Buoy-Collections-Tests/OrderedSetTest.class.st

@@ -466,7 +466,7 @@ OrderedSetTest >> testCopyReplaceFromToWithInsertingAtEnd [
 
 	original := self abcSet.
 
-	copy := original copyReplaceFrom: 4 to: 4 with: 'f'.
+	copy := original copyReplaceFrom: 4 to: 3 with: 'f'.
 
 	self
 		assert: copy size equals: 4;
@@ -1073,6 +1073,17 @@ OrderedSetTest >> testWithDo [
 	self assert: count equals: 3
 ]
 
+{ #category : #'tests - instance creation' }
+OrderedSetTest >> testWithWithWithWith [
+
+	| set |
+
+	set := OrderedSet with: #a with: #c with: #b with: #a .
+	self assert: set hasTheSameElementsInTheSameOrderThat: #( a c b ).
+
+
+]
+
 { #category : #'tests - copying' }
 OrderedSetTest >> testWithoutFirst [
 
@@ -1106,20 +1117,20 @@ OrderedSetTest >> testWriteStream [
 		nextPut: $d;
 		nextPut: $e;
 		nextPut: $f.
+
+	"According to ANSI standard it is unspecified whether or not the
+	returned collection is the same object as the backing store collection.
+
+	Se we just test over the stream contents"
+
 	self
-		assert: set size equals: 3;
-		assert: set first equals: $d;
-		assert: set second equals: $e;
-		assert: set last equals: $f.
+		assert: stream contents size equals: 3;
+		assert: stream contents first equals: $d;
+		assert: stream contents second equals: $e;
+		assert: stream contents last equals: $f.
 
 	stream nextPut: $g.
 
-	self
-		assert: set size equals: 3;
-		assert: set first equals: $d;
-		assert: set second equals: $e;
-		assert: set last equals: $f.
-
 	self
 		assert: stream contents size equals: 4;
 		assert: stream contents first equals: $d;