diff --git a/CodeImportCommandLineHandlers.package/STCommandLineHandler.class/class/printing/printCompilerWarning_.st b/CodeImportCommandLineHandlers.package/STCommandLineHandler.class/class/printing/printCompilerWarning_.st index b9965803dc..f7ed877bca 100644 --- a/CodeImportCommandLineHandlers.package/STCommandLineHandler.class/class/printing/printCompilerWarning_.st +++ b/CodeImportCommandLineHandlers.package/STCommandLineHandler.class/class/printing/printCompilerWarning_.st @@ -15,26 +15,25 @@ printCompilerWarning: aSyntaxErrorNotification stderr red; nextPutAll: errorMessage; lf; - nextPutAll: ('' padLeftTo: errorMessage size with: $=); lf. + nextPutAll: ('' padLeftTo: errorMessage size with: $=); lf; + clear. "print each source line and mark the found syntax error" maxLineNumberSize := contents lines size asString size. lineNumber := 0. contents lineIndicesDo: [:start :endWithoutDelimiters :end | lineNumber := lineNumber + 1. - lineNumber == errorLine - ifTrue: [ stderr red ] - ifFalse:[ stderr white ]. + lineNumber == errorLine ifTrue: [ stderr errorColor ]. "0 pad the line numbers to the same size" stderr nextPutAll: (lineNumber asString padLeftTo: maxLineNumberSize with: $0); - nextPutAll: ': '. - - stderr white; + nextPutAll: ': '; nextPutAll: (contents copyFrom: start to: endWithoutDelimiters); lf. - "print the marker under the error line" - (lineNumber == errorLine) ifTrue: [ - stderr red - nextPutAll:( '_^_' padLeftTo: position - start + maxLineNumberSize + 4); - lf ]] \ No newline at end of file + "print the marker under the error line" + (lineNumber == errorLine) + ifTrue: [ + stderr nextPutAll:( '_^_' padLeftTo: position - start + maxLineNumberSize + 4); + lf; + clear] + ] \ No newline at end of file diff --git a/Collections-Streams.package/WriteStream.class/instance/accessing/ensureEndsWith_.st b/Collections-Streams.package/WriteStream.class/instance/accessing/ensureEndsWith_.st index dc8574cb81..d871c41f16 100644 --- a/Collections-Streams.package/WriteStream.class/instance/accessing/ensureEndsWith_.st +++ b/Collections-Streams.package/WriteStream.class/instance/accessing/ensureEndsWith_.st @@ -1,5 +1,5 @@ ensureEndsWith: anObject - "Append anObject to the receiver IFF there is not one on the end." + "Append anObject to the receiver IFF it is non-empty and there is not one on the end." - (position > 0 and: [(collection at: position) = anObject]) ifTrue: [^self]. + (position == 0 or: [(collection at: position) = anObject]) ifTrue: [^self]. self nextPut: anObject \ No newline at end of file diff --git a/Collections-Tests.package/WriteStreamTest.class/instance/tests/testEnsureEndsWith.st b/Collections-Tests.package/WriteStreamTest.class/instance/tests/testEnsureEndsWith.st index 3fb188d376..b1a19fbc0b 100644 --- a/Collections-Tests.package/WriteStreamTest.class/instance/tests/testEnsureEndsWith.st +++ b/Collections-Tests.package/WriteStreamTest.class/instance/tests/testEnsureEndsWith.st @@ -5,11 +5,16 @@ testEnsureEndsWith stream nextPutAll: 'this is a test'. stream ensureEndsWith: Character cr. stream nextPutAll: 'for WriteStreamTest'. - self assert: stream contents = (('this is a test' copyWith: Character cr), 'for WriteStreamTest'). + self assert: stream contents equals: (('this is a test' copyWith: Character cr), 'for WriteStreamTest'). "Manually put a new line and verify there are no 2 new lines" stream := self newStream. stream nextPutAll: ('this is a test' copyWith: Character cr). stream ensureEndsWith: Character cr. stream nextPutAll: 'for WriteStreamTest'. - self assert: stream contents = (('this is a test' copyWith: Character cr), 'for WriteStreamTest'). \ No newline at end of file + self assert: stream contents equals: (('this is a test' copyWith: Character cr), 'for WriteStreamTest'). + + "Test with a empty stream" + stream := self newStream. + stream ensureEndsWith: Character cr. + self assert: stream contents equals: ''. \ No newline at end of file diff --git a/Kernel-Tests.package/IntegerTest.class/instance/tests - bitLogic/testBitString.st b/Kernel-Tests.package/IntegerTest.class/instance/tests - bitLogic/testBitString.st index cb55191883..074fb65028 100644 --- a/Kernel-Tests.package/IntegerTest.class/instance/tests - bitLogic/testBitString.st +++ b/Kernel-Tests.package/IntegerTest.class/instance/tests - bitLogic/testBitString.st @@ -1,9 +1,18 @@ testBitString "self debug: #testBitString" - self assert: 2 bitString = '0000000000000000000000000000010'. - self assert: -1 bitString = '1111111111111111111111111111111'. - self assert: -2 bitString = '1111111111111111111111111111110'. - self assert: 2 bitStringLength = 31. - "32 minus 1 for immediate encoding = 31 = 30 for number + 1 for sign" - self assert: 2 bitStringLength = (SmallInteger maxVal highBit + 1). \ No newline at end of file + Smalltalk vm wordSize = 4 + ifTrue: [ + self assert: 2 bitString equals: '0000000000000000000000000000010'. + self assert: -1 bitString equals: '1111111111111111111111111111111'. + self assert: -2 bitString equals: '1111111111111111111111111111110'. + self assert: 2 bitStringLength equals: 31 ]. + Smalltalk vm wordSize = 8 + ifTrue: [ + self assert: 2 bitString equals: '0000000000000000000000000000000000000000000000000000000000010'. + self assert: -1 bitString equals: '1111111111111111111111111111111111111111111111111111111111111'. + self assert: -2 bitString equals: '1111111111111111111111111111111111111111111111111111111111110'. + self assert: 2 bitStringLength equals: 61 ]. + "32 minus 1 for immediate encoding = 31 = 30 for number + 1 for sign" + "64 minus 3 for immediate encoding = 61 = 60 for number + 1 for sign" + self assert: 2 bitStringLength equals: (SmallInteger maxVal highBit + 1). \ No newline at end of file diff --git a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes1.st b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes1.st index f5621f501b..fa12e84968 100644 --- a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes1.st +++ b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes1.st @@ -3,8 +3,8 @@ testCreationFromBytes1 "it is illegal for a LargeInteger to be less than SmallInteger maxVal." "here we test that Integer>>byte!byte2:byte3:byte4: resconstructs SmallInteger maxVal as an instance of SmallInteger. " - | maxSmallInt hexString byte1 byte2 byte3 byte4 - builtInteger | + | maxSmallInt hexString byte1 byte2 byte3 byte4 builtInteger | + Smalltalk vm wordSize = 4 ifFalse: [ ^ self skip ]. maxSmallInt := SmallInteger maxVal. hexString := maxSmallInt printStringHex. self assert: hexString size = 8. diff --git a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes2.st b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes2.st index 25c5feef21..72fe215244 100644 --- a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes2.st +++ b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes2.st @@ -4,6 +4,7 @@ testCreationFromBytes2 "it is illegal for a LargeInteger to be less than SmallInteger maxVal." "here we test that Integer>>byte!byte2:byte3:byte4: resconstructs (SmallInteger maxVal + 1) as an instance of LargePositiveInteger. " | maxSmallInt hexString byte1 byte2 byte3 byte4 builtInteger | + Smalltalk vm wordSize = 4 ifFalse: [ ^ self skip ]. maxSmallInt := SmallInteger maxVal. hexString := (maxSmallInt + 1) printStringHex. self assert: hexString size = 8. diff --git a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes3.st b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes3.st index 1bc750028e..93b9ca29cb 100644 --- a/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes3.st +++ b/Kernel-Tests.package/IntegerTest.class/instance/tests - instance creation/testCreationFromBytes3.st @@ -3,8 +3,8 @@ testCreationFromBytes3 "it is illegal for a LargeInteger to be less than SmallInteger maxVal." "here we test that Integer>>byte!byte2:byte3:byte4: resconstructs (SmallInteger maxVal - 1) as an instance of SmallInteger. " - | maxSmallInt hexString byte1 byte2 byte3 byte4 - builtInteger | + | maxSmallInt hexString byte1 byte2 byte3 byte4 builtInteger | + Smalltalk vm wordSize = 4 ifFalse: [ ^ self skip ]. maxSmallInt := SmallInteger maxVal. hexString := (maxSmallInt - 1) printStringHex. self assert: hexString size = 8. diff --git a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMaxVal.st b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMaxVal.st index bb21231020..13d59ebb48 100644 --- a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMaxVal.st +++ b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMaxVal.st @@ -1,3 +1,5 @@ testMaxVal - - self assert: (SmallInteger maxVal = 16r3FFFFFFF). \ No newline at end of file + Smalltalk vm wordSize = 4 + ifTrue: [ self assert: SmallInteger maxVal = 16r3FFFFFFF ]. + Smalltalk vm wordSize = 8 + ifTrue: [ self assert: SmallInteger maxVal = 16rFFFFFFFFFFFFFFF ] \ No newline at end of file diff --git a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMinVal.st b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMinVal.st index 0f01b00616..883022d56b 100644 --- a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMinVal.st +++ b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - Class Methods/testMinVal.st @@ -1,3 +1,5 @@ testMinVal - - self assert: (SmallInteger minVal = -16r40000000). \ No newline at end of file + Smalltalk vm wordSize = 4 + ifTrue: [ self assert: SmallInteger minVal = -16r40000000 ]. + Smalltalk vm wordSize = 8 + ifTrue: [ self assert: SmallInteger minVal = -16r1000000000000000 ] \ No newline at end of file diff --git a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - printing/testPrintString.st b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - printing/testPrintString.st index 21396e4d46..c5220c93de 100644 --- a/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - printing/testPrintString.st +++ b/Kernel-Tests.package/SmallIntegerTest.class/instance/tests - printing/testPrintString.st @@ -1,20 +1,29 @@ testPrintString - self assert: 1 printString = '1'. - self assert: -1 printString = '-1'. - self assert: SmallInteger minVal printString = '-1073741824'. - self assert: SmallInteger maxVal printString = '1073741823'. - self assert: 12345 printString = '12345'. - self assert: -54321 printString = '-54321'. - - self assert: 0 decimalDigitLength = 1. - self assert: 4 decimalDigitLength = 1. - self assert: 12 decimalDigitLength = 2. - self assert: 123 decimalDigitLength = 3. - self assert: 1234 decimalDigitLength = 4. - self assert: 56789 decimalDigitLength = 5. - self assert: 657483 decimalDigitLength = 6. - self assert: 6571483 decimalDigitLength = 7. - self assert: 65174383 decimalDigitLength = 8. - self assert: 625744831 decimalDigitLength = 9. - self assert: 1000001111 decimalDigitLength = 10. - self assert: SmallInteger maxVal decimalDigitLength = 10. \ No newline at end of file + self assert: 1 printString equals: '1'. + self assert: -1 printString equals: '-1'. + Smalltalk vm wordSize = 4 + ifTrue: [ + self assert: SmallInteger minVal printString equals: '-1073741824'. + self assert: SmallInteger maxVal printString equals: '1073741823' ]. + Smalltalk vm wordSize = 8 + ifTrue: [ + self assert: SmallInteger minVal printString equals: '-1152921504606846976'. + self assert: SmallInteger maxVal printString equals: '1152921504606846975' ]. + self assert: 12345 printString equals: '12345'. + self assert: -54321 printString equals: '-54321'. + + self assert: 0 decimalDigitLength equals: 1. + self assert: 4 decimalDigitLength equals: 1. + self assert: 12 decimalDigitLength equals: 2. + self assert: 123 decimalDigitLength equals: 3. + self assert: 1234 decimalDigitLength equals: 4. + self assert: 56789 decimalDigitLength equals: 5. + self assert: 657483 decimalDigitLength equals: 6. + self assert: 6571483 decimalDigitLength equals: 7. + self assert: 65174383 decimalDigitLength equals: 8. + self assert: 625744831 decimalDigitLength equals: 9. + self assert: 1000001111 decimalDigitLength equals: 10. + Smalltalk vm wordSize = 4 + ifTrue: [ self assert: SmallInteger maxVal decimalDigitLength equals: 10 ]. + Smalltalk vm wordSize = 8 + ifTrue: [ self assert: SmallInteger maxVal decimalDigitLength equals: 19 ]. \ No newline at end of file diff --git a/Kernel.package/SmallInteger.class/instance/system primitives/digitAt_.st b/Kernel.package/SmallInteger.class/instance/system primitives/digitAt_.st index 6a17e34c8c..ffa4f29955 100644 --- a/Kernel.package/SmallInteger.class/instance/system primitives/digitAt_.st +++ b/Kernel.package/SmallInteger.class/instance/system primitives/digitAt_.st @@ -1,10 +1,13 @@ -digitAt: n - "Answer the value of an indexable field in the receiver. LargePositiveInteger uses bytes of base two number, and each is a 'digit' base 256. Fail if the argument (the index) is not an Integer or is out of bounds." - n>4 ifTrue: [^ 0]. - self < 0 - ifTrue: - [self = SmallInteger minVal ifTrue: - ["Can't negate minVal -- treat specially" - ^ #(0 0 0 64) at: n]. - ^ ((0-self) bitShift: (1-n)*8) bitAnd: 16rFF] - ifFalse: [^ (self bitShift: (1-n)*8) bitAnd: 16rFF] \ No newline at end of file +digitAt: n + "Answer the value of an apparent byte-indexable field in the receiver, + analogous to the large integers, which are organized as bytes." + + n = 1 + ifTrue: [ + "Negate carefully in case the receiver is SmallInteger minVal" + ^ self < 0 + ifTrue: [ -256 - self bitAnd: 255 ] + ifFalse: [ self bitAnd: 255 ] ]. + ^ self < 0 + ifTrue: [ (-256 - self bitShift: -8) + 1 digitAt: n - 1 ] + ifFalse: [ (self bitShift: 8 - (n bitShift: 3)) bitAnd: 255 ] \ No newline at end of file diff --git a/Pharo-Help.package/PharoWelcomePage.class/class/opening/open.st b/Pharo-Help.package/PharoWelcomePage.class/class/opening/open.st index 433cce7b8f..c865722777 100644 --- a/Pharo-Help.package/PharoWelcomePage.class/class/opening/open.st +++ b/Pharo-Help.package/PharoWelcomePage.class/class/opening/open.st @@ -1,4 +1,5 @@ open +