Fixes to conversions between Float and String. Includes tests. Thanks…

… Andrés for the suggestion.
Cuis-Smalltalk · Sep 24, 2018 · 113917a · 113917a
1 parent 1e4a3f6
commit 113917a
Show file tree

Hide file tree

Showing 2 changed files with 217 additions and 5 deletions.
diff --git a/CoreUpdates/3452-FloatStringConversionFixes-JuanVuletich-2018Sep24-09h04m-jmv.2.cs.st b/CoreUpdates/3452-FloatStringConversionFixes-JuanVuletich-2018Sep24-09h04m-jmv.2.cs.st
@@ -0,0 +1,141 @@
+'From Cuis 5.0 of 7 November 2016 [latest update: #3451] on 24 September 2018 at 11:00:42 am'!
+
+!Number class methodsFor: 'instance creation' stamp: 'jmv 9/24/2018 11:00:21'!
+readRemainderOf: integerPart from: aStream base: base withSign: sign
+	"Read optional fractional part and exponent, and return the final result"
+	| value fraction fracpos peekChar exp scale |
+
+	value := integerPart.
+	(aStream peekFor: $.)
+		ifTrue: [		 "<integer>.<fraction>"
+			(aStream atEnd not and: [ aStream peek digitValue between: 0 and: base - 1 ])
+				ifTrue:  [
+					fracpos := aStream position.
+					fraction := Integer readFrom: aStream base: base.
+					fraction := fraction / (base raisedToInteger: aStream position - fracpos).
+					value := value asFloat + fraction]
+				ifFalse: [
+					"oops - just <integer>."
+					aStream skip: -1.
+					"un-gobble the period"
+					^ value * sign"Number readFrom: '3r-22.2'"]].
+	peekChar := aStream peek.
+	peekChar = $e | (peekChar = $d) | (peekChar = $q)
+		ifTrue: [			"<number>(e|d|q)<exponent>>"
+			aStream next.
+			(aStream atEnd not and: [ (aStream peek digitValue between: 0 and: 9) or: [ aStream peek = $- ]])
+				ifTrue:  [
+					exp := Integer readFrom: aStream.
+					scale := base raisedToInteger: exp.
+					value := (value isFloat and: [ scale asFloat < Float fminNormalized ])
+						ifTrue: [
+							"Avoid Float arithmetic to allow stuff like
+								12345678901234567890.0e-330
+								(Float fminNormalized / 10) storeString asNumber = ((Float fminNormalized / 10))
+								"
+							(value asTrueFraction * scale) asFloat ]
+						ifFalse: [ value * scale ] ]
+				ifFalse: [
+					"oops - just <number>."
+					aStream skip: -1.]].
+	^(value isFloat
+		and: [ value = 0.0 and: [ sign = -1 ]])
+			ifTrue: [ Float negativeZero ]
+			ifFalse: [ value * sign ]! !
+
+
+!Float methodsFor: 'printing' stamp: 'jmv 9/24/2018 10:31:30'!
+absPrintExactlyOn: aStream base: base
+	"Print my value on a stream in the given base.  Assumes that my value is strictly
+	positive; negative numbers, zero, and NaNs have already been handled elsewhere.
+	Based upon the algorithm outlined in:
+	Robert G. Burger and R. Kent Dybvig
+	Printing Floating Point Numbers Quickly and Accurately
+	ACM SIGPLAN 1996 Conference on Programming Language Design and Implementation
+	June 1996.
+	This version guarantees that the printed representation exactly represents my value
+	by using exact integer arithmetic."
+
+	| significand exp baseExpEstimate r s mPlus mMinus scale roundingIncludesLimits d tc1 tc2 fixedFormat decPointCount slowbit shead |
+	self isInfinite ifTrue: [aStream nextPutAll: 'Infinity'. ^ self].
+	significand := self significandAsInteger.
+	roundingIncludesLimits := significand even.
+	exp := (self exponent - 52) max: MinValLogBase2.
+	baseExpEstimate := (self exponent * base asFloat reciprocalLogBase2 - 1.0e-10) ceiling.
+	exp >= 0
+		ifTrue:
+			[significand ~= 16r10000000000000
+				ifTrue:
+					[r := significand bitShift: 1 + exp.
+					s := 2.
+					mPlus := mMinus := 1 bitShift: exp]
+				ifFalse:
+					[r := significand bitShift: 2 + exp.
+					s := 4.
+					mPlus := 2 * (mMinus := 1 bitShift: exp)]]
+		ifFalse:
+			[(exp = MinValLogBase2 or: [significand ~= 16r10000000000000]) & false
+				ifTrue:
+					"jmv 2018-9-24. Deactivated. Makes the following false (See Tests package):"
+					"
+					| float |
+					float _ (Float fminNormalized / 2) successor.
+					float storeString asNumber = float
+					"
+					[r := significand bitShift: 1.
+					s := 1 bitShift: 1 - exp.
+					mPlus := mMinus := 1]
+				ifFalse:
+					[r := significand bitShift: 2.
+					s := 1 bitShift: 2 - exp.
+					mPlus := 2.
+					mMinus := 1]].
+	baseExpEstimate >= 0
+		ifTrue: [s := s * (base raisedToInteger: baseExpEstimate)]
+		ifFalse:
+			[scale := base raisedToInteger: baseExpEstimate negated.
+			r := r * scale.
+			mPlus := mPlus * scale.
+			mMinus := mMinus * scale].
+	((r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])
+		ifTrue: [baseExpEstimate := baseExpEstimate + 1]
+		ifFalse:
+			[r := r * base.
+			mPlus := mPlus * base.
+			mMinus := mMinus * base].
+	(fixedFormat := baseExpEstimate between: -3 and: 6)
+		ifTrue:
+			[decPointCount := baseExpEstimate.
+			baseExpEstimate <= 0
+				ifTrue: [aStream nextPutAll: ('0.000000' truncateTo: 2 - baseExpEstimate)]]
+		ifFalse:
+			[decPointCount := 1].
+	slowbit := 1 - s lowBit .
+	shead := s bitShift: slowbit.
+	[d := (r bitShift: slowbit) // shead.
+	r := r - (d * s).
+	(tc1 := (r > mMinus) not and: [roundingIncludesLimits or: [r < mMinus]]) |
+	(tc2 := (r + mPlus < s) not and: [roundingIncludesLimits or: [r + mPlus > s]])] whileFalse:
+		[aStream nextPut: (Character digitValue: d).
+		r := r * base.
+		mPlus := mPlus * base.
+		mMinus := mMinus * base.
+		decPointCount := decPointCount - 1.
+		decPointCount = 0 ifTrue: [aStream nextPut: $.]].
+	tc2 ifTrue:
+		[(tc1 not or: [r * 2 >= s]) ifTrue: [d := d + 1]].
+	aStream nextPut: (Character digitValue: d).
+	decPointCount > 0
+		ifTrue:
+		[decPointCount - 1 to: 1 by: -1 do: [:i | aStream nextPut: $0].
+		aStream nextPutAll: '.0'].
+	fixedFormat ifFalse:
+		[aStream nextPut: $e.
+		aStream nextPutAll: (baseExpEstimate - 1) printString]! !
+
+!Float methodsFor: 'printing' stamp: 'jmv 9/24/2018 10:56:53'!
+absPrintOn: aStream base: base
+	"In Cuis, print Floats with enough digits to be able to recover later exactly the same Float."
+
+	self absPrintExactlyOn: aStream base: base! !
+
diff --git a/Packages/Tests/Tests.pck.st b/Packages/Tests/Tests.pck.st
@@ -1,13 +1,13 @@
-'From Cuis 5.0 of 7 November 2016 [latest update: #3442] on 10 September 2018 at 12:04:18 pm'!
+'From Cuis 5.0 of 7 November 2016 [latest update: #3452] on 24 September 2018 at 11:03:56 am'!
 'Description test that verifies that #should:raise: can expect Exception'!
-!provides: 'Tests' 1 88!
-!requires: 'Compression' 1 nil nil!
+!provides: 'Tests' 1 89!
 !requires: 'Collections-CompactArrays' 1 nil nil!
+!requires: 'Graphics-Files-Additional' 1 nil nil!
 !requires: 'ImageProcessing' 1 nil nil!
 !requires: 'YAXO' 1 nil nil!
-!requires: 'Graphics-Files-Additional' 1 nil nil!
-!requires: 'Math 3D' 1 nil nil!
 !requires: 'Morphic-Widgets-Extras' 1 nil nil!
+!requires: 'Math 3D' 1 nil nil!
+!requires: 'Compression' 1 nil nil!
 SystemOrganization addCategory: #'Tests-Exceptions'!
 SystemOrganization addCategory: #'Tests-Kernel-Numbers'!
 SystemOrganization addCategory: #'Tests-Morphic-Kernel'!
@@ -2153,6 +2153,72 @@ testAsTrueFraction
 	x _ 1.0234e308.
 	self assert: x asTrueFraction asFloat = x.! !
 
+!FloatTest methodsFor: 'testing - conversion' stamp: 'jmv 9/24/2018 10:52:30'!
+testExactAsString
+	"Tests that conversion to / from Strings is exact (same Float is re-created) when using #asString
+	(whose output is meant to be a readable String).
+	Use some relevant examples."
+
+	| examples |
+	examples _ {
+		1.0. 
+		Float fminNormalized / 2. 
+		Float fminNormalized / 10. 
+		Float fminNormalized / 13. 
+		2.0. 
+		2 sqrt. 
+		Float pi. 
+		Float fminDenormalized. 
+		Float fminDenormalized * 2. 
+		Float fminDenormalized * 3. 
+		Float fminDenormalized * 13 },
+	{
+		Float zero.
+		Float negativeZero.
+		Float negativeInfinity.
+		Float infinity }.
+
+	examples do: [ :float |
+		self assert: float predecessor asString asNumber = float predecessor.
+		self assert: float asString asNumber = float.
+		self assert: float successor asString asNumber = float successor ].
+
+	"NaN are special, in that they are not even equal to themselves"
+	self assert: Float nan asString asNumber isNaN! !
+
+!FloatTest methodsFor: 'testing - conversion' stamp: 'jmv 9/24/2018 10:51:07'!
+testExactStoreString
+	"Tests that conversion to / from Strings is exact (same Float is re-created) when using #storeString
+	(whose output is meant to be compilable smalltalk code).
+	Use some relevant examples."
+
+	| examples |
+	examples _ {
+		1.0. 
+		Float fminNormalized / 2. 
+		Float fminNormalized / 10. 
+		Float fminNormalized / 13. 
+		2.0. 
+		2 sqrt. 
+		Float pi. 
+		Float fminDenormalized. 
+		Float fminDenormalized * 2. 
+		Float fminDenormalized * 3. 
+		Float fminDenormalized * 13 },
+	{
+		Float zero.
+		Float negativeZero.
+		Float negativeInfinity.
+		Float infinity }.
+
+	examples do: [ :float |
+		self assert: (Compiler evaluate: float predecessor storeString) = float predecessor.
+		self assert: (Compiler evaluate: float storeString) = float.
+		self assert: (Compiler evaluate: float successor storeString) = float successor ].
+
+	"NaN are special, in that they are not even equal to themselves"
+	self assert: (Compiler evaluate: Float nan storeString) isNaN! !
+
 !FloatTest methodsFor: 'testing - conversion' stamp: 'nice 7/24/2008 02:04'!
 testFloatRounded
 	"5000000000000001 asFloat has an exact representation (no round off error).
@@ -2234,6 +2300,11 @@ testFractionAsFloat2
 	self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2).
 	self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).! !
 
+!FloatTest methodsFor: 'testing - conversion' stamp: 'jmv 9/24/2018 10:54:15'!
+testFromStringDoesntUnderflow
+	self assert: '12345678901234567890.0e-330' asNumber isZero not.
+	self assert: (Compiler evaluate: '12345678901234567890.0e-330')isZero not.! !
+
 !FloatTest methodsFor: 'testing - conversion' stamp: 'nice 5/6/2006 22:13'!
 testIntegerAsFloat
 	"assert IEEE 754 round to nearest even mode is honoured"