Update gtoolkit-wireencoding.gs

akgrant43 · akgrant43 · commit 2b4548118319 · 2026-06-22T17:50:11.000+02:00
diff --git a/src-gs/gtoolkit-wireencoding.gs b/src-gs/gtoolkit-wireencoding.gs
@@ -635,6 +635,24 @@ true.
 removeallmethods GtWireFloatPrintStringEncoder
 removeallclassmethods GtWireFloatPrintStringEncoder
 
+doit
+(GtWireObjectEncoder
+	subclass: 'GtWireFractionEncoder'
+	instVarNames: #()
+	classVars: #()
+	classInstVars: #()
+	poolDictionaries: #()
+	inDictionary: Globals
+	options: #( #logCreation )
+)
+		category: 'GToolkit-WireEncoding';
+		immediateInvariant.
+true.
+%
+
+removeallmethods GtWireFractionEncoder
+removeallclassmethods GtWireFractionEncoder
+
 doit
 (GtWireObjectEncoder
 	subclass: 'GtWireGemStoneOopEncoder'
@@ -2221,6 +2239,28 @@ float
 			self assert: next equals: f ]
 %
 
+category: 'examples'
+method: GtWireEncodingExamples
+floatBinary
+	"Check float encoding forcing GtWireFloatEncoder"
+	<gtExample>
+	<return: #GtWireEncodingExamples>
+	| encoder fbEncoder byteArray next |
+	
+	encoder := GtWireEncoder onByteArray.
+	fbEncoder := GtWireFloatEncoder new.
+	{Float fmin.
+		Float fmax.
+		1.25.
+		Float pi. }
+		doWithIndex: [ :f :i | 
+			encoder reset.
+			fbEncoder encode: f with: encoder.
+			byteArray := encoder contents.
+			next := (GtWireDecoder on: byteArray readStream) next.
+			self assert: next equals: f ]
+%
+
 category: 'examples'
 method: GtWireEncodingExamples
 floatString
@@ -2243,6 +2283,26 @@ floatString
 			self assert: next equals: f ]
 %
 
+category: 'examples'
+method: GtWireEncodingExamples
+fraction
+	"Check fraction encoding using the default encoder"
+	<gtExample>
+	<return: #GtWireEncodingExamples>
+	| encoder byteArray next |
+	encoder := GtWireEncoder onByteArray.
+	{ 3/5. SmallInteger maxVal * 20 / 17. }
+		doWithIndex: [ :f :i | 
+			self assert: (encoder objectEncoderFor: f) class
+				identicalTo: GtWireFractionEncoder.
+			encoder reset.
+			encoder nextPut: f.
+			byteArray := encoder contents.
+			next := (GtWireDecoder on: byteArray readStream) next.
+			self assert: next class identicalTo: Fraction.
+			self assert: next equals: f ]
+%
+
 category: 'examples'
 method: GtWireEncodingExamples
 gemStoneRemoteObjectEncoderHasInvalidConfigurationWithoutEncoder
@@ -3037,7 +3097,7 @@ defaultReverseMapIsArray
 
 	reverseMap := GtWireEncoderDecoder defaultReverseMap.
 	self assert: reverseMap isArray.
-	self assert: reverseMap size equals: 28.
+	self assert: reverseMap size equals: 29.
 	self assert: (reverseMap at: 1) class equals: GtWireNilEncoder.
 	^ reverseMap
 %
@@ -3849,6 +3909,46 @@ encode: aFloat with: aGtWireEncoderContext
 		putString: aFloat asString
 %
 
+! Class implementation for 'GtWireFractionEncoder'
+
+!		Class methods for 'GtWireFractionEncoder'
+
+category: 'accessing'
+classmethod: GtWireFractionEncoder
+typeIdentifier
+
+	^ 30
+%
+
+!		Instance methods for 'GtWireFractionEncoder'
+
+category: 'encoding - decoding'
+method: GtWireFractionEncoder
+decodeWith: aGtWireEncoderContext
+	| numerator denominator negative fraction |
+	
+	negative := aGtWireEncoderContext next.
+	numerator := aGtWireEncoderContext nextPackedInteger.
+	denominator := aGtWireEncoderContext nextPackedInteger.
+	fraction := numerator / denominator.
+	^ negative
+		ifTrue: [ fraction negated ]
+		ifFalse: [ fraction ].
+%
+
+category: 'encoding - decoding'
+method: GtWireFractionEncoder
+encode: aFraction with: aGtWireEncoderContext
+	| absFraction |
+
+	absFraction := aFraction abs.
+	aGtWireEncoderContext 
+		putPackedInteger: self typeIdentifier;
+		nextPut: aFraction negative;
+		putPackedInteger: absFraction numerator;
+		putPackedInteger: absFraction denominator.
+%
+
 ! Class implementation for 'GtWireGemStoneOopEncoder'
 
 !		Class methods for 'GtWireGemStoneOopEncoder'
@@ -4478,25 +4578,6 @@ contents
 
 category: 'encoding - decoding'
 method: GtWireStream
-float64
-	| byteArray |
-
-	byteArray := self next: 8.
-	^ byteArray doubleAt: 1.
-%
-
-category: 'encoding - decoding'
-method: GtWireStream
-float64: aFloat
-	| byteArray |
-
-	byteArray := ByteArray new: 8.
-	byteArray doubleAt: 1 put: aFloat.
-	self nextPutAll: byteArray.
-%
-
-category: 'as yet unclassified'
-method: GtWireStream
 int64
 	"Answer the next signed, 32-bit integer from this (binary) stream."
 	"Details: As a fast check for negative number, check the high bit of the first digit"
@@ -4513,7 +4594,7 @@ int64
 	^ n
 %
 
-category: 'as yet unclassified'
+category: 'encoding - decoding'
 method: GtWireStream
 int64: anInteger
 	| n |
@@ -4715,12 +4796,14 @@ defaultMapping
 		at: Set put: GtWireSetEncoder new;
 		at: SmallInteger put: GtWireIntegerEncoder new;
 		at: LargeInteger put: GtWireIntegerEncoder new;
-		at: Float put: GtWireFloatPrintStringEncoder new;
-		at: SmallDouble put: GtWireFloatPrintStringEncoder new;
-		at: SmallFloat put: GtWireFloatPrintStringEncoder new;
+		at: Float put: GtWireFloatEncoder new;
+		at: SmallDouble put: GtWireFloatEncoder new;
+		at: SmallFloat put: GtWireFloatEncoder new;
 		at: UndefinedObject put: GtWireNilEncoder new;
 		at: DateAndTime put: GtWireDateAndTimeEncoder new;
-		at: SmallDateAndTime put: GtWireDateAndTimeEncoder new.
+		at: SmallDateAndTime put: GtWireDateAndTimeEncoder new;
+		at: Fraction put: GtWireFractionEncoder new;
+		at: SmallFraction put: GtWireFractionEncoder new.
 	^ mapping
 %
 
@@ -4757,7 +4840,8 @@ getDefaultMap
 		at: ((self lookupClass: #ExecBlock4) ifNil: [ self error: 'Unable to find: ExecBlock4' ]) put: GtWireBlockClosureEncoder new;
 		at: ((self lookupClass: #ExecBlock5) ifNil: [ self error: 'Unable to find: ExecBlock5' ]) put: GtWireBlockClosureEncoder new;
 		at: ((self lookupClass: #ExecBlockN) ifNil: [ self error: 'Unable to find: ExecBlockN' ]) put: GtWireBlockClosureEncoder new;
-		at: ((self lookupClass: #Float) ifNil: [ self error: 'Unable to find: Float' ]) put: GtWireFloatPrintStringEncoder new;
+		at: ((self lookupClass: #Float) ifNil: [ self error: 'Unable to find: Float' ]) put: GtWireFloatEncoder new;
+		at: ((self lookupClass: #Fraction) ifNil: [ self error: 'Unable to find: Fraction' ]) put: GtWireFractionEncoder new;
 		at: ((self lookupClass: #GtRsrEvaluatorFeaturesService) ifNil: [ self error: 'Unable to find: GtRsrEvaluatorFeaturesService' ]) put: GtWireGemStoneRsrEncoder new;
 		at: ((self lookupClass: #GtRsrEvaluatorFeaturesServiceServer) ifNil: [ self error: 'Unable to find: GtRsrEvaluatorFeaturesServiceServer' ]) put: GtWireGemStoneRsrEncoder new;
 		at: ((self lookupClass: #GtRsrEvaluatorService) ifNil: [ self error: 'Unable to find: GtRsrEvaluatorService' ]) put: GtWireGemStoneRsrEncoder new;
@@ -4781,8 +4865,9 @@ getDefaultMap
 		at: ((self lookupClass: #RsrService) ifNil: [ self error: 'Unable to find: RsrService' ]) put: GtWireGemStoneRsrEncoder new;
 		at: ((self lookupClass: #Set) ifNil: [ self error: 'Unable to find: Set' ]) put: GtWireSetEncoder new;
 		at: ((self lookupClass: #SmallDateAndTime) ifNil: [ self error: 'Unable to find: SmallDateAndTime' ]) put: GtWireDateAndTimeEncoder new;
-		at: ((self lookupClass: #SmallDouble) ifNil: [ self error: 'Unable to find: SmallDouble' ]) put: GtWireFloatPrintStringEncoder new;
-		at: ((self lookupClass: #SmallFloat) ifNil: [ self error: 'Unable to find: SmallFloat' ]) put: GtWireFloatPrintStringEncoder new;
+		at: ((self lookupClass: #SmallDouble) ifNil: [ self error: 'Unable to find: SmallDouble' ]) put: GtWireFloatEncoder new;
+		at: ((self lookupClass: #SmallFloat) ifNil: [ self error: 'Unable to find: SmallFloat' ]) put: GtWireFloatEncoder new;
+		at: ((self lookupClass: #SmallFraction) ifNil: [ self error: 'Unable to find: SmallFraction' ]) put: GtWireFractionEncoder new;
 		at: ((self lookupClass: #SmallInteger) ifNil: [ self error: 'Unable to find: SmallInteger' ]) put: GtWireIntegerEncoder new;
 		at: ((self lookupClass: #String) ifNil: [ self error: 'Unable to find: String' ]) put: GtWireStringEncoder new;
 		at: ((self lookupClass: #Symbol) ifNil: [ self error: 'Unable to find: Symbol' ]) put: GtWireSymbolEncoder new;
@@ -4827,6 +4912,7 @@ getDefaultReverseMap
 		at: 27 put: GtWireGemStoneWithRsrEncoder new;
 		at: 28 put: GtWireClassEncoder new;
 		at: 29 put: GtWireFloatPrintStringEncoder new;
+		at: 30 put: GtWireFractionEncoder new;
 		yourself.
 %
 
@@ -4943,6 +5029,29 @@ assert: actual equals: expected
 		description: actual printString, ' is not equal to ', expected printString.
 %
 
+! Class extensions for 'GtWireStream'
+
+!		Instance methods for 'GtWireStream'
+
+category: '*GToolkit-WireEncoding-GemStone'
+method: GtWireStream
+float64
+	| byteArray |
+
+	byteArray := self next: 8.
+	^ byteArray doubleAt: 1.
+%
+
+category: '*GToolkit-WireEncoding-GemStone'
+method: GtWireStream
+float64: aFloat
+	| byteArray |
+
+	byteArray := ByteArray new: 8.
+	byteArray doubleAt: 1 put: aFloat.
+	self nextPutAll: byteArray.
+%
+
 ! Class Initialization
 
 run
