Merge pull request #654 from theseion/20120-Fuel-is-not-64bits-ready

Updated Fuel to 2.2.0 with the 64 bit adaptations

src/Fuel/FLDecoder.class.st

@@ -186,6 +186,23 @@ FLDecoder >> nextEncodedUint32 [
 
 ]
 
+{ #category : #decoding }
+FLDecoder >> nextEncodedUint64 [
+	"Answer the next unsigned, 64-bit integer from this (binary) stream."
+
+	| n |
+	n := stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	n := (n bitShift: 8) + stream next.
+	^ n
+
+]
+
 { #category : #decoding }
 FLDecoder >> nextEncodedUint8 [
 	"Answer the next unsigned, 16-bit integer from this (binary) stream."

src/Fuel/FLEncoder.class.st

@@ -144,6 +144,21 @@ FLEncoder >> encodeUint32: aSmallInteger [
 
 ]
 
+{ #category : #encoding }
+FLEncoder >> encodeUint64: aSmallInteger [ 
+	"Append to the receiver an Integer as the next 8 bytes."
+	stream	
+		nextPut: (aSmallInteger bitShift: -56);
+		nextPut: ((aSmallInteger bitShift: -48) bitAnd: 255);
+		nextPut: ((aSmallInteger bitShift: -40) bitAnd: 255);
+		nextPut: ((aSmallInteger bitShift: -32) bitAnd: 255);
+		nextPut: ((aSmallInteger bitShift: -24) bitAnd: 255);
+		nextPut: ((aSmallInteger bitShift: -16) bitAnd: 255);
+		nextPut: ((aSmallInteger bitShift: -8) bitAnd: 255);
+		nextPut: (aSmallInteger bitAnd: 255)
+
+]
+
 { #category : #encoding }
 FLEncoder >> encodeUint8: aSmallInteger [ 
 	"Append to the receiver an Integer as the next two bytes."

src/Fuel/FLLightGeneralMapper.class.st

@@ -15,12 +15,15 @@ FLLightGeneralMapper >> clusterClassForSmallInteger: aSmallInteger [
 		aSmallInteger <= 65535 ifTrue: [^ FLPositive16SmallIntegerCluster].
 		aSmallInteger <= 16777215 ifTrue: [^ FLPositive24SmallIntegerCluster].
 		aSmallInteger <= 4294967295 ifTrue: [^ FLPositive32SmallIntegerCluster].
+		aSmallInteger <= 1152921504606846975 ifTrue: [^ FLPositive64SmallIntegerCluster].
 	].
 	aSmallInteger >= -128 ifTrue: [^ FLNegative8SmallIntegerCluster].
 	aSmallInteger >= -32768 ifTrue: [^ FLNegative16SmallIntegerCluster].
 	aSmallInteger >= -8388608 ifTrue: [^ FLNegative24SmallIntegerCluster].
 	aSmallInteger >= -2147483648 ifTrue: [^ FLNegative32SmallIntegerCluster].
+	aSmallInteger >= -1152921504606846976 ifTrue: [^ FLNegative64SmallIntegerCluster].
 
+	self error: 'SmallInteger is out of range'
 
 ]
 

src/Fuel/FLNegative64SmallIntegerCluster.class.st

@@ -0,0 +1,20 @@
+"
+A cluster of unsigned int 64bit
+"
+Class {
+	#name : #FLNegative64SmallIntegerCluster,
+	#superclass : #FLSmallIntegerCluster,
+	#category : #'Fuel-Clusters'
+}
+
+{ #category : #'serialize/materialize' }
+FLNegative64SmallIntegerCluster >> materializeInstanceWith: aDecoder [
+
+	^ aDecoder nextEncodedUint64 negated 
+]
+
+{ #category : #'serialize/materialize' }
+FLNegative64SmallIntegerCluster >> serializeInstance: anInteger with: anEncoder [
+
+	anEncoder encodeUint64: anInteger abs
+]

src/Fuel/FLPositive64SmallIntegerCluster.class.st

@@ -0,0 +1,20 @@
+"
+unsigned, 64-bit integer
+"
+Class {
+	#name : #FLPositive64SmallIntegerCluster,
+	#superclass : #FLSmallIntegerCluster,
+	#category : #'Fuel-Clusters'
+}
+
+{ #category : #'serialize/materialize' }
+FLPositive64SmallIntegerCluster >> materializeInstanceWith: aDecoder [
+
+	^ aDecoder nextEncodedUint64
+]
+
+{ #category : #'serialize/materialize' }
+FLPositive64SmallIntegerCluster >> serializeInstance: anInteger with: anEncoder [
+
+	anEncoder encodeUint64: anInteger
+]

src/Fuel/Float.extension.st

@@ -8,11 +8,12 @@ Float >> fuelAccept: aGeneralMapper [
 
 { #category : #'*Fuel' }
 Float class >> materializeFrom: aDecoder [
-
-	^ (self new: 2)
+	"The * 1 is here to give a chance to the VM to create a SmallFloat64 if it can (thanks Nicolas Cellier)."
+
+	^ (BoxedFloat64 new: 2)
 		at: 1 put: aDecoder nextEncodedUint32;
 		at: 2 put: aDecoder nextEncodedUint32;
-		yourself.
+		* 1.
 
 ]
 

src/FuelTests/FLBasicSerializationTest.class.st

@@ -12,7 +12,7 @@ Class {
 
 { #category : #failures }
 FLBasicSerializationTest >> expectedFailures [
-	^ #(testConsiderCustomWideSymbolGlobal testWideStringGlobal)
+	^ #(testConsiderCustomWideSymbolGlobal testWideStringGlobal testWideStringClassName)
 ]
 
 { #category : #running }
@@ -30,28 +30,9 @@ FLBasicSerializationTest >> tearDown [
 { #category : #'tests-numbers' }
 FLBasicSerializationTest >> testAllRangeOfIntegers [
 
-		self assertSerializationIdentityOf: 100.
-		self assertSerializationIdentityOf: 10000.
-		self assertSerializationIdentityOf: 100000.
-		self assertSerializationIdentityOf: 10000000.
-		self assertSerializationIdentityOf: 100000000.
-		self assertSerializationIdentityOf: 1000000000.
-		self assertSerializationEqualityOf: 3000000000.
-		self assertSerializationEqualityOf: 10000000000.
-		self assertSerializationEqualityOf: 100000000000.
-		self assertSerializationEqualityOf: 100 factorial.
-
-		self assertSerializationIdentityOf: -100.
-		self assertSerializationIdentityOf: -10000.
-		self assertSerializationIdentityOf: -100000.
-		self assertSerializationIdentityOf: -10000000.
-		self assertSerializationIdentityOf: -100000000.
-		self assertSerializationIdentityOf: -1000000000.
-		self assertSerializationEqualityOf: -3000000000.
-		self assertSerializationEqualityOf: -10000000000.
-		self assertSerializationEqualityOf: -100000000000.
-		self assertSerializationEqualityOf:  100 factorial * -1.
-
+	1 to: 100 do: [:shift |
+		self assertSerializationEqualityOrIdentityOf: 1 << shift.
+		self assertSerializationEqualityOrIdentityOf: 0 - (1 << shift) ]
 
 ]
 
@@ -191,21 +172,19 @@ FLBasicSerializationTest >> testConsiderCustomWideSymbolGlobal [
 	"The same than #testConsiderCustomGlobal but with a WideSymbol."
 
 	| aWideSymbol aPerson |
-
 	aWideSymbol := (WideString streamContents: [ :stream |
-		256 to: 260 do: [ :code | 
-			stream nextPut: code asCharacter ] ]) asSymbol.
+		256 to: 280 do: [ :code | stream nextPut: code asCharacter ] ]) asSymbol.
 
 	self analyzer considerGlobal: aWideSymbol.
 
-	aPerson := FLPerson new.
-
+	aPerson := FLPerson new.	
 	[ 
 		Smalltalk globals at: aWideSymbol put: aPerson.
 		self
-			shouldnt: [ self assertSerializationIdentityOf: aPerson ]
+			shouldnt: [ self resultOfSerializeAndMaterialize: aPerson ]
 			raise: Error
-	] ensure: [ Smalltalk globals removeKey: aWideSymbol ].
+	] ensure: [ 
+		Smalltalk globals removeKey: aWideSymbol ].
 
 ]
 
@@ -448,22 +427,21 @@ FLBasicSerializationTest >> testFalse [
 
 { #category : #'tests-numbers' }
 FLBasicSerializationTest >> testFloat [
-
-	self assertSerializationEqualityOf: 180.0.
-	self assertSerializationEqualityOf: 0.0.
-	self assertSerializationEqualityOf: -0.0.
-	self assertSerializationEqualityOf: 11.22321.
-	self assertSerializationEqualityOf: -11.22321.
-	self assertSerializationEqualityOf: -132311.22321.
-	self assertSerializationEqualityOf: 1234567890.123456789.
-	self assertSerializationEqualityOf: -1234567890.123456789.
-	self assertSerializationEqualityOf: Float e.
-	self assertSerializationEqualityOf: Float infinity.
-	self assertSerializationEqualityOf: Float halfPi.
-	self assertSerializationEqualityOf: Float negativeZero.
-	self assertSerializationEqualityOf: Float halfPi.
-	self assertSerializationEqualityOf: Float pi.
-
+	{180.0.
+	0.0.
+	-0.0.
+	11.22321.
+	-11.22321.
+	-132311.22321.
+	1234567890.123456789.
+	-1234567890.123456789.
+	Float e.
+	Float infinity.
+	Float halfPi.
+	Float negativeZero.
+	Float halfPi.
+	Float pi} 
+		do: [ :aFloat | self assertSerializationEqualityOrIdentityOf: aFloat ]
 ]
 
 { #category : #tests }
@@ -744,23 +722,20 @@ FLBasicSerializationTest >> testSetWithSetElement [
 
 { #category : #tests }
 FLBasicSerializationTest >> testSharedReferences [
-	| oneDotOne  point1 point2 materialized array |
-
-	oneDotOne := 1.1.
-
-	"I cannot directly use 4.2 because the Compiler reuses the same float instance 4.2 for the literals and hence the last assert fails. "
-	point1:= Point x: oneDotOne y: (Float readFrom: '4.2' readStream).
-	point2:= Point x: (Float readFrom: '4.2' readStream) y: oneDotOne.
-	array := (Array with: point1 with: point2).
-
+	| sharedObject point1 point2 materialized array |
+	sharedObject := SmallInteger maxVal + 1.
+	point1 := Point x: sharedObject y: SmallInteger maxVal + 2.
+	point2 := Point x: SmallInteger maxVal + 2 y: sharedObject.
+	array := Array with: point1 with: point2.
+
 	materialized := self resultOfSerializeAndMaterialize: array.
 	self assert: array = materialized.
-	self assert: materialized first x == materialized second y.
-	self deny: materialized first y == materialized second x.
-
-
-
-
+	self 
+		assert: materialized first x == materialized second y 
+		description: 'An object that is referenced twice by the graph must not be duplicated when materialized'.
+	self 
+		deny: materialized first y == materialized second x 
+		description: 'Two (non-literal) objects must maintain different identity even if they are equal'
 ]
 
 { #category : #'tests-numbers' }
@@ -889,11 +864,11 @@ FLBasicSerializationTest >> testWideStringClassName [
 		yourself.
 	class := Class new setName: className; yourself.
 	[
-		Smalltalk at: class name put: class.
+		Smalltalk globals at: class name put: class.
 		self
-			shouldnt: [ FLSerializer serializeToByteArray: (Smalltalk at: class name) ]
+			shouldnt: [ self resultOfSerializeAndMaterialize: class ]
 			raise: Error
-	] ensure:[ Smalltalk removeKey: class name ]
+	] ensure:[ Smalltalk globals removeKey: class name ]
 ]
 
 { #category : #'tests-strings' }
@@ -904,15 +879,17 @@ FLBasicSerializationTest >> testWideStringGlobal [
 		yourself.
 	globalValue := global, 'value'.
 	[
-		Smalltalk at: global put: globalValue.
+		Smalltalk globals
+			at: global
+			put: globalValue.
 		self analyzer considerGlobal: global.
 
 		self
 			shouldnt: [ self serialize: 'bar' -> globalValue ]
 			raise: Error.
 		self assert: self materialized class equals: Association.
 		self assert: self materialized value == global
-	] ensure: [ Smalltalk removeKey: global ]
+	] ensure: [ Smalltalk globals removeKey: global ]
 ]
 
 { #category : #'tests-collections' }

src/FuelTests/FLFileStreamStrategy.class.st

@@ -34,10 +34,16 @@ FLFileStreamStrategy class >> newWithBinaryFileStream [
 			ifFalse: [ self newWithStandardFileStream ]
 ]
 
+{ #category : #'instance creation' }
+FLFileStreamStrategy class >> newWithMultiByteFileStream [
+
+	^self newWith: MultiByteFileStream
+]
+
 { #category : #'instance creation' }
 FLFileStreamStrategy class >> newWithStandardFileStream [
 
-	^self newWith: (Smalltalk globals at: #StandardFileStream)
+	^self newWith: StandardFileStream
 ]
 
 { #category : #writing }

src/FuelTests/FLHeaderSerializationTest.class.st

@@ -10,6 +10,7 @@ Class {
 { #category : #tests }
 FLHeaderSerializationTest >> testAdditionalObjects [
 
+	| materialization |
 	self serializer at: #test putAdditionalObject: 'test'.
 	self serializer at: 42 putAdditionalObject: 68.