Yes, the interaction between fractions and strings is not good.  For instance:
    Fraction readFromString: ((1/2) printString)
raises an error, because printing fractions puts parenthesis around
the fraction, and that just isn't a valid number.
-Chris
On Fri, Oct 14, 2011 at 8:30 AM, Norberto Manzanos <nmanza...@gmail.com> wrote:
> I'm afraid the fix cause more problems than solutions. I don't know what is
> happening, and I couldn't go deep, but many things are working bad.
> So I have to implement temporarily String #asFraction to fullfill my
> requirements.
>
> On Thu, Oct 13, 2011 at 10:43 AM, Stéphane Ducasse
> <stephane.duca...@inria.fr> wrote:
>>
>> thanks you
>>
>> http://code.google.com/p/pharo/issues/detail?id=4909
>>
>> Stef
>>
>> On Oct 13, 2011, at 2:39 PM, Norberto Manzanos wrote:
>>
>> > On both Squeak 3.9 (I supose others too) and Pharo:
>> > Fraction readFromString: '1/2'  ---> 1
>> > '1/2' asNumber ---> 1
>> >
>> > fix
>> >
>> > Number #readFrom: stringOrStream
>> >     "Answer a number as described on aStream.  The number may
>> >     include a leading radix specification, as in 16rFADE"
>> >     | value base aStream sign |
>> >     aStream _ (stringOrStream isString)
>> >         ifTrue: [ReadStream on: stringOrStream]
>> >         ifFalse: [stringOrStream].
>> >     (aStream nextMatchAll: 'NaN') ifTrue: [^ Float nan].
>> >     sign _ (aStream peekFor: $-) ifTrue: [-1] ifFalse: [1].
>> >     (aStream nextMatchAll: 'Infinity') ifTrue: [^ Float infinity *
>> > sign].
>> >     base _ 10.
>> >     value _ Integer readFrom: aStream base: base.
>> > "this line "
>> >     (aStream peekFor: $/) ifTrue:[^Fraction    numerator: value
>> > denominator: (aStream upTo: $\) asInteger].
>> > "  added "
>> >     (aStream peekFor: $r)
>> >
>> >         ifTrue:
>> >             ["<base>r<integer>"
>> >             (base _ value) < 2 ifTrue: [^self error: 'Invalid radix'].
>> >             (aStream peekFor: $-) ifTrue: [sign _ sign negated].
>> >             value _ Integer readFrom: aStream base: base].
>> >     ^ self readRemainderOf: value from: aStream base: base withSign:
>> > sign.
>> >
>> > --
>> > Norberto Manzanos
>> > Instituto de Investigaciones en Humanidades y Ciencias Sociales (IdIHCS)
>> > FaHCE/UNLP - CONICET
>> > Calle 48 e/ 6 y 7 s/Nº - 8º piso - oficina 803
>> > Tel: +54-221-4230125 interno 262
>>
>>
>
>
>
> --
> Norberto Manzanos
> Instituto de Investigaciones en Humanidades y Ciencias Sociales (IdIHCS)
> FaHCE/UNLP - CONICET
> Calle 48 e/ 6 y 7 s/Nº - 8º piso - oficina 803
> Tel: +54-221-4230125 interno 262
>

Reply via email to