Squeak-dev May 2014

squeak-dev@lists.squeakfoundation.org

43 participants
219 discussions

Squeak 4.5: Environments-cmm.51.mcz
by commits＠source.squeak.org 06 May '14

06 May '14

Chris Muller uploaded a new version of Environments to project Squeak 4.5: http://source.squeak.org/squeak45/Environments-cmm.51.mcz ==================== Summary ==================== Name: Environments-cmm.51 Author: cmm Time: 2 May 2014, 2:56:46.177 pm UUID: d6b12525-7eb7-4978-9368-fb484f30043b Ancestors: Environments-cwp.50 - Environment preamble, repair your 'Instances' dictionary, make Environments consistently named with Symbols. - EnvironmentInfo, ensure incoming Strings for your name are coerced to Symbols. =============== Diff against Environments-ul.46 =============== Item was added: + (PackageInfo named: 'Environments') preamble: '"Fix ''Instances'' entry for Smalltalk Environment." + | dict | + dict := (Environment classPool at: ''Instances''). + dict keys + do: [ : eachName | (eachName isSymbol not ) ifTrue: [ dict at: eachName asSymbol put: (dict removeKey: eachName) ] ]. + + "Let Environment names be, consistently, Symbols." + Environment allInstances do: + [ : each | + each info + instVarNamed: ''name'' + put: (each name asSymbol) ]'! Item was changed: Object subclass: #BindingPolicy + instanceVariableNames: 'policy environment addSelector removeSelector' - instanceVariableNames: 'namespace policy next environment addSelector removeSelector' classVariableNames: '' poolDictionaries: '' category: 'Environments-Policies'! Item was added: + ----- Method: BindingPolicy>>environment (in category 'accessing') ----- + environment + ^ environment! Item was added: + ----- Method: BindingPolicy>>removeObserver: (in category 'initialize-release') ----- + removeObserver: anEnvironment + environment removeObserver: anEnvironment ! Item was added: + Notification subclass: #CurrentEnvironment + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Environments-Loading'! Item was added: + ----- Method: Environment class>>current (in category 'accessing') ----- + current + ^ CurrentEnvironment signal ifNil: [self default]! Item was changed: ----- Method: Environment class>>named: (in category 'instance creation') ----- named: aSymbol + | symbol | + symbol := aSymbol asSymbol. ^ Instances + at: symbol + ifAbsentPut: [ self withName: symbol ]! - at: aSymbol - ifAbsentPut: [self withName: aSymbol]! Item was changed: + ----- Method: Environment>>addObserver: (in category 'observing') ----- - ----- Method: Environment>>addObserver: (in category 'accessing') ----- addObserver: anObject observers add: anObject! Item was added: + ----- Method: Environment>>declarations (in category 'declaring') ----- + declarations + ^ Array streamContents: + [:out | declarations associationsDo: + [:ea | out nextPut: ea]]! Item was changed: ----- Method: Environment>>destroy (in category 'initialize-release') ----- destroy + + self allClasses do: [:ea | ea removeFromSystem]. + declarations keys do: [:ea | self unbind: ea]. + policies do: [:ea | ea removeObserver: self]. + observers do: [:ea | ea stopObserving: self].! - self allClasses do: [:ea | ea removeFromSystem]! Item was changed: ----- Method: Environment>>exportSelf (in category 'configuring') ----- exportSelf | policy | policy := BindingPolicy environment: self policy: (AllNamePolicy new) addSelector: #notifyObserversOfBindingAdded: + removeSelector: #notifyObserversOfBindingRemoved:. - removeSelector: #notifyObserversOfBindingAdded:. policies := policies copyWith: policy! Item was changed: ----- Method: Environment>>forgetClass:logged: (in category 'classes and traits') ----- forgetClass: aClass logged: aBool + (self hasBindingOf: aClass name) ifFalse: [ ^ self ]. - | binding | - self flag: #review. - "The class might not bound to its name" - aBool ifTrue: [SystemChangeNotifier uniqueInstance classRemoved: aClass fromCategory: aClass category]. + self organization removeElement: aClass name. + Smalltalk removeFromStartUpList: aClass. + Smalltalk removeFromShutDownList: aClass. + self unbind: aClass name! - - binding := declarations bindingOf: aClass name. - binding ifNotNil: - [self organization removeElement: aClass name. - Smalltalk removeFromStartUpList: aClass. - Smalltalk removeFromShutDownList: aClass. - - undeclared declare: aClass name from: declarations. - declarations removeKey: aClass name ifAbsent: []. - [undeclared at: aClass name put: nil] - on: AttemptToWriteReadOnlyGlobal - do: [:n | n resume: true]. - self binding: binding removedFrom: self] - ! Item was added: + ----- Method: Environment>>hasBindingOf: (in category 'binding') ----- + hasBindingOf: aSymbol + ^ declarations includesKey: aSymbol! Item was changed: ----- Method: Environment>>hideBinding: (in category 'binding') ----- hideBinding: aBinding + self undeclare: aBinding key from: bindings! - bindings removeKey: aBinding key! Item was changed: + ----- Method: Environment>>isUndeclared: (in category 'declaring') ----- - ----- Method: Environment>>isUndeclared: (in category 'undeclared') ----- isUndeclared: aSymbol ^ undeclared includesKey: aSymbol! Item was changed: + ----- Method: Environment>>purgeUndeclared (in category 'declaring') ----- - ----- Method: Environment>>purgeUndeclared (in category 'undeclared') ----- purgeUndeclared undeclared removeUnreferencedKeys! Item was changed: + ----- Method: Environment>>removeObserver: (in category 'observing') ----- - ----- Method: Environment>>removeObserver: (in category 'accessing') ----- removeObserver: anObject + observers remove: anObject ifAbsent: []! - observers remove: anObject! Item was changed: ----- Method: Environment>>renameClass:from:to: (in category 'classes and traits') ----- renameClass: aClass from: oldName to: newName "Rename the class, aClass, to have the title newName." | binding category | category := self organization categoryOfElement: oldName. self organization classify: newName under: category suppressIfDefault: true. self organization removeElement: oldName. + binding := self declarationOf: oldName. - binding := self associationAt: oldName. declarations removeKey: oldName. self binding: binding removedFrom: self. + binding := newName => aClass. - binding key: newName. declarations add: binding. self binding: binding addedTo: self. Smalltalk renamedClass: aClass from: oldName to: newName. SystemChangeNotifier uniqueInstance classRenamed: aClass from: oldName to: newName inCategory: category! Item was added: + ----- Method: Environment>>stopObserving: (in category 'observing') ----- + stopObserving: anEnvironment + policies := policies reject: [:ea | ea environment == anEnvironment].! Item was added: + ----- Method: Environment>>unbind: (in category 'binding') ----- + unbind: aSymbol + | binding | + binding := declarations bindingOf: aSymbol ifAbsent: [^ self]. + undeclared declare: aSymbol from: declarations. + declarations removeKey: aSymbol ifAbsent: [ ]. + [ undeclared at: aSymbol put: nil ] + on: AttemptToWriteReadOnlyGlobal + do: [ :n | n resume: true ]. + self binding: binding removedFrom: self! Item was changed: + ----- Method: Environment>>undeclare: (in category 'declaring') ----- - ----- Method: Environment>>undeclare: (in category 'undeclared') ----- undeclare: aSymbol ^ (undeclared bindingOf: aSymbol) ifNil: [undeclared add: aSymbol => nil]! Item was changed: + ----- Method: Environment>>undeclare:from: (in category 'declaring') ----- - ----- Method: Environment>>undeclare:from: (in category 'undeclared') ----- undeclare: aSymbol from: aNamespace | binding | binding := self undeclare: aSymbol. (aNamespace bindingOf: aSymbol) ifNotNil: [:old | aNamespace removeKey: aSymbol. old becomeForward: binding]. ^ binding! Item was changed: + ----- Method: EnvironmentInfo class>>name: (in category 'create') ----- - ----- Method: EnvironmentInfo class>>name: (in category 'as yet unclassified') ----- name: aString ^ self name: aString organization: (SystemOrganizer defaultList: Array new) packages: PackageOrganizer new. ! Item was changed: + ----- Method: EnvironmentInfo class>>name:organization:packages: (in category 'create') ----- - ----- Method: EnvironmentInfo class>>name:organization:packages: (in category 'as yet unclassified') ----- name: aString organization: aSystemOrganizer packages: aPackageOrganizer ^ self basicNew initializeWithName: aString organization: aSystemOrganizer packages: aPackageOrganizer! Item was changed: + ----- Method: EnvironmentInfo>>initializeWithName:organization:packages: (in category 'initializing') ----- - ----- Method: EnvironmentInfo>>initializeWithName:organization:packages: (in category 'as yet unclassified') ----- initializeWithName: aString organization: aSystemOrganizer packages: aPackageOrganizer self initialize. + name := aString asSymbol. - name := aString. organization := aSystemOrganizer. + packages := aPackageOrganizer.! - packages := aPackageOrganizer. - ! Item was changed: ----- Method: EnvironmentLoader>>evaluate: (in category 'as yet unclassified') ----- evaluate: chunk ^ [Compiler evaluate: chunk environment: environment] + on: CurrentEnvironment - on: EnvironmentRequest do: [:req | req resume: environment]! Item was changed: ----- Method: EnvironmentLoader>>evaluate:logged: (in category 'as yet unclassified') ----- evaluate: chunk logged: aBoolean ^ [Compiler evaluate: chunk environment: environment logged: aBoolean] + on: CurrentEnvironment - on: EnvironmentRequest do: [:req | req resume: environment]! Item was removed: - Notification subclass: #EnvironmentRequest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Environments-Loading'!

1 0

Re: [squeak-dev] Squeak 4.5: Installer-Core-cmm.392.mcz
by Chris Muller 06 May '14

06 May '14

No changes here, I just noticed this was yet another empty package in the squeak45 repository. On Tue, May 6, 2014 at 12:10 PM, <commits(a)source.squeak.org> wrote: > Chris Muller uploaded a new version of Installer-Core to project Squeak 4.5: > http://source.squeak.org/squeak45/Installer-Core-cmm.392.mcz > > ==================== Summary ==================== > > Name: Installer-Core-cmm.392 > Author: cmm > Time: 15 February 2014, 12:36:40.753 pm > UUID: 7cb5c040-6f68-479d-bc9e-0b264b172443 > Ancestors: Installer-Core-cmm.391 > > - WebClient moved to SS3 as of April, 2013. > > =============== Diff against Installer-Core-cmm.391 =============== > > Item was changed: > ----- Method: Installer>>webClientCore (in category 'package-definitions') ----- > webClientCore > "Simple, compact, and easy to use HTTP client implementation from Andreas Raab." > + ^ { #ss3 -> 'WebClient'. > - ^ { #ss -> 'WebClient'. > 'WebClient-Core' }! > >

1 0

Squeak 4.5: Installer-Core-cmm.392.mcz
by commits＠source.squeak.org 06 May '14

06 May '14

Chris Muller uploaded a new version of Installer-Core to project Squeak 4.5: http://source.squeak.org/squeak45/Installer-Core-cmm.392.mcz ==================== Summary ==================== Name: Installer-Core-cmm.392 Author: cmm Time: 15 February 2014, 12:36:40.753 pm UUID: 7cb5c040-6f68-479d-bc9e-0b264b172443 Ancestors: Installer-Core-cmm.391 - WebClient moved to SS3 as of April, 2013. =============== Diff against Installer-Core-cmm.391 =============== Item was changed: ----- Method: Installer>>webClientCore (in category 'package-definitions') ----- webClientCore "Simple, compact, and easy to use HTTP client implementation from Andreas Raab." + ^ { #ss3 -> 'WebClient'. - ^ { #ss -> 'WebClient'. 'WebClient-Core' }!

1 0

The Inbox: Collections-dtl.568.mcz
by commits＠source.squeak.org 05 May '14

05 May '14

David T. Lewis uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-dtl.568.mcz ==================== Summary ==================== Name: Collections-dtl.568 Author: dtl Time: 5 May 2014, 12:39:30.026 pm UUID: a7bc6178-b9ac-4b87-bf97-478cc4927158 Ancestors: Collections-eem.567 Add a flush to WriteStream>>nextChunkPut: This is a workaround for a bug in the runtime library of some versions of Ubuntu. The symptom is that creation of a class comment for a class that previously had no comment leads to a file size error in the new RemoteStream that points to the class comment. Actual file size and contents of the changes file are not affected by this bug, and the error occurs when reading contents of the changes file immediately following the initial save, Flushing the stream after writing a chunk to the changes file prevents the problem. =============== Diff against Collections-eem.567 =============== Item was changed: ----- Method: WriteStream>>nextChunkPut: (in category 'fileIn/Out') ----- nextChunkPut: aString "Append the argument, aString, to the receiver, doubling embedded terminators." | i remainder terminator | terminator := $!!. remainder := aString. [(i := remainder indexOf: terminator) = 0] whileFalse: [self nextPutAll: (remainder copyFrom: 1 to: i). self nextPut: terminator. "double imbedded terminators" remainder := remainder copyFrom: i+1 to: remainder size]. self nextPutAll: remainder. aString includesUnifiedCharacter ifTrue: [ self nextPut: terminator. self nextPutAll: ']lang['. aString writeLeadingCharRunsOn: self. ]. self nextPut: terminator. + self flush. "workaround for clib runtime bug on some platforms, affecting initial class comment creation" !

1 0

The Inbox: Compiler.quasiliteral-eem.280.mcz
by commits＠source.squeak.org 04 May '14

04 May '14

Eliot Miranda uploaded a new version of Compiler to project The Inbox: http://source.squeak.org/inbox/Compiler.quasiliteral-eem.280.mcz ==================== Summary ==================== Name: Compiler.quasiliteral-eem.280 Author: eem Time: 4 May 2014, 1:49:28.091 pm UUID: d6f78930-4e27-4378-ad72-beb74ca0d13d Ancestors: Compiler-nice.279 [Derived from Compiler-nice.279, and renamed from the bogusly named Compiler.quasiquote-eem.248] Add a quasi-literal form for "string interpolation", that allows convenient embedding of expressions within a format string, and provides a convenient way of embedding literal strings within an alternative literal string syntax whose string delimiter is different. e.g. `hello [#cruel] world!` evaluates to 'hello cruel world'. `S1[B1]...SN[BN]SN+1` is equivalent to { 'S1'. [B1] value. ... 'SN'. [BN] value. 'SN+1' } concatenateQuasiLiteral where concatenateQuasiLiteral sends asString to each element and answers the concatenation of those elements. however, single-statement blocks are inlined, so e.g. the above `hello [#cruel] world!` is compiled as { 'hello '. #cruel. ' world!' } concatenateQuasiLiteral See e.g. Tests.quasiliteral-eem.296 for tests and examples. =============== Diff against Compiler-nice.279 =============== Item was added: + ----- Method: Array>>concatenateQuasiLiteral (in category '*Compiler-support') ----- + concatenateQuasiLiteral + "This method is used in compilation of quasi-quote constructs. + It MUST NOT be deleted or altered." + + | s sz | + sz := self size. + s := WriteStream on: (String new: sz * 16). + 1 to: sz do: + [:i| s nextPutAll: (self at: i) asString]. + ^s contents! Item was added: + ----- Method: Decompiler>>checkForMacroMessage:selector:arguments: (in category 'control') ----- + checkForMacroMessage: rcvr selector: selector arguments: args + ^ (selector == #concatenateQuasiLiteral + and: [self checkForQuasiLiteral: rcvr selector: selector arguments: args]) + or: [(#closureCopy:copiedValues: == selector + and: [self checkForClosureCopy: rcvr arguments: args]) + or: [#blockCopy: == selector + and: [self checkForBlockCopy: rcvr]]]! Item was added: + ----- Method: Decompiler>>checkForQuasiLiteral:selector:arguments: (in category 'control') ----- + checkForQuasiLiteral: rcvr "<BraceNode>" selector: selector "<Symbol>" arguments: args "<Array>" + stack addLast: + ((MessageNode new + receiver: rcvr + selector: (SelectorNode new key: #concatenateQuasiLiteral code: nil) + arguments: args + precedence: 1) + notePrintingSelector: #printQuasiLiteralOn:indent:; + yourself). + ^true! Item was changed: ----- Method: Decompiler>>send:super:numArgs: (in category 'instruction decoding') ----- send: selector super: superFlag numArgs: numArgs | args rcvr selNode msgNode messages | args := Array new: numArgs. (numArgs to: 1 by: -1) do: [:i | args at: i put: stack removeLast]. rcvr := stack removeLast. superFlag ifTrue: [rcvr := constructor codeSuper]. + (self checkForMacroMessage: rcvr selector: selector arguments: args) ifFalse: - ((#(blockCopy: closureCopy:copiedValues:) includes: selector) - and: [self checkForBlock: rcvr selector: selector arguments: args]) ifFalse: [selNode := constructor codeAnySelector: selector. rcvr == CascadeFlag ifTrue: ["May actually be a cascade or an ifNil: for value." self willJumpIfFalse ifTrue: "= generated by a case macro" [selector == #= ifTrue: [" = signals a case statement..." statements addLast: args first. stack addLast: rcvr. "restore CascadeFlag" ^ self]. selector == #== ifTrue: [" == signals an ifNil: for value..." stack removeLast; removeLast. rcvr := stack removeLast. stack addLast: IfNilFlag; addLast: (constructor codeMessage: rcvr selector: selNode arguments: args). ^ self]] ifFalse: [(self willJumpIfTrue and: [selector == #==]) ifTrue: [" == signals an ifNotNil: for value..." stack removeLast; removeLast. rcvr := stack removeLast. stack addLast: IfNilFlag; addLast: (constructor codeMessage: rcvr selector: selNode arguments: args). ^ self]]. msgNode := constructor codeCascadedMessage: selNode arguments: args. stack last == CascadeFlag ifFalse: ["Last message of a cascade" statements addLast: msgNode. messages := self popTo: stack removeLast. "Depth saved by first dup" msgNode := constructor codeCascade: stack removeLast messages: messages]] ifFalse: [msgNode := constructor codeMessage: rcvr selector: selNode arguments: args]. stack addLast: msgNode]! Item was changed: ----- Method: MessageNode class>>initialize (in category 'class initialization') ----- initialize "MessageNode initialize" MacroSelectors := #( ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue: and: or: whileFalse: whileTrue: whileFalse whileTrue to:do: to:by:do: caseOf: caseOf:otherwise: ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil: + repeat + nil "space for concatenateQuasiLiteral" ). - repeat ). MacroTransformers := #( transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue: transformAnd: transformOr: transformWhile: transformWhile: transformWhile: transformWhile: transformToDo: transformToDo: transformCase: transformCase: transformIfNil: transformIfNil: transformIfNilIfNotNil: transformIfNotNilIfNil: + transformRepeat: + nil "space for concatenateQuasiLiteral" ). - transformRepeat: ). MacroEmitters := #( emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value: emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value: emitCodeForCase:encoder:value: emitCodeForCase:encoder:value: emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value: emitCodeForIf:encoder:value: emitCodeForIf:encoder:value: + emitCodeForRepeat:encoder:value: + nil "space for concatenateQuasiLiteral"). - emitCodeForRepeat:encoder:value:). MacroSizers := #( sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForToDo:value: sizeCodeForToDo:value: sizeCodeForCase:value: sizeCodeForCase:value: sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value: + sizeCodeForRepeat:value: + nil "space for concatenateQuasiLiteral"). - sizeCodeForRepeat:value:). MacroPrinters := #( printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printToDoOn:indent: printToDoOn:indent: printCaseOn:indent: printCaseOn:indent: printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent: + printRepeatOn:indent: + printQuasiLiteralOn:indent:)! - printRepeatOn:indent:)! Item was added: + ----- Method: MessageNode>>notePrintingSelector: (in category 'macro transformations') ----- + notePrintingSelector: printingSelectorSymbol + "decompile" + + special := MacroPrinters indexOf: printingSelectorSymbol! Item was added: + ----- Method: MessageNode>>printQuasiLiteralOn:indent: (in category 'printing') ----- + printQuasiLiteralOn: aStream indent: level + aStream nextPut: $`. + receiver elements do: + [:parseNode| + (parseNode isLiteralNode + and: [parseNode key class == 'literal' class]) + ifTrue: + [parseNode key do: + [:char| + ('$`[' includes: char) ifTrue: + [aStream nextPut: $$]. + aStream nextPut: char]] + ifFalse: + [(parseNode isMessageNode + and: [parseNode selector key == #value + and: [parseNode receiver isBlockNode]]) + ifTrue: + [parseNode receiver printOn: aStream indent: 0] + ifFalse: + [aStream nextPut: $[. + parseNode printOn: aStream indent: 0. + aStream nextPut: $]]]]. + aStream nextPut: $`! Item was changed: ----- Method: Parser>>advance (in category 'scanning') ----- advance | this | prevMark := hereMark. prevEnd := hereEnd. this := here. here := token. hereType := tokenType. hereMark := mark. hereEnd := source position - (aheadChar == DoItCharacter ifTrue: [hereChar == DoItCharacter ifTrue: [0] ifFalse: [1]] ifFalse: [2]). + hereType ~~ #backQuote ifTrue: + [self scanToken]. - self scanToken. "Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr." ^this! Item was added: + ----- Method: Parser>>nonQuasiLiteralExpression (in category 'expression types') ----- + nonQuasiLiteralExpression + + (hereType == #word and: [tokenType == #leftArrow]) + ifTrue: [^ self assignment: self variable]. + hereType == #leftBrace + ifTrue: [self braceExpression] + ifFalse: [self primaryExpression ifFalse: [^ false]]. + (self messagePart: 3 repeat: true) + ifTrue: [hereType == #semicolon ifTrue: [self cascade]]. + ^ true! Item was changed: ----- Method: Parser>>primaryExpression (in category 'expression types') ----- primaryExpression hereType == #word ifTrue: [parseNode := self variable. (parseNode isUndefTemp and: [self interactive]) ifTrue: [self queryUndefined]. parseNode nowHasRef. ^ true]. hereType == #leftBracket ifTrue: [self advance. self blockExpression. ^true]. hereType == #leftBrace ifTrue: [self braceExpression. ^true]. + hereType == #backQuote + ifTrue: + [self advance. + self quasiLiteralExpression. + ^true]. hereType == #leftParenthesis ifTrue: [self advance. self expression ifFalse: [^self expected: 'expression']. (self match: #rightParenthesis) ifFalse: [^self expected: 'right parenthesis']. ^true]. (hereType == #string or: [hereType == #number or: [hereType == #literal or: [hereType == #character]]]) ifTrue: [parseNode := encoder encodeLiteral: self advance. ^true]. (here == #- and: [tokenType == #number and: [1 + hereEnd = mark]]) ifTrue: [self advance. parseNode := encoder encodeLiteral: self advance negated. ^true]. ^false! Item was added: + ----- Method: Parser>>quasiLiteralExpression (in category 'expression types') ----- + quasiLiteralExpression + "`quasi-quote` + => { elements } concatenateQuasiLiteral + => MessageNode receiver: BraceNode selector: #concatenateQuasiLiteral. + + The syntax of quasi-quote is + quasi-quote := $` (characters | blockExpression) * $` + characters := (unescapedCharacter | $\ escapedCharacter) * + + The semantics of quasi-quote are that each blockExpression is evaluated + left-to-right in the scope of the enclosing method or block. The sequence + of interspersed character sequences and expressions are concatenated + left-to-right, sending asString to each element immediately prior to concatenation. + The concatenation is then the result of the expression. It is always a new string. + + The implementation inlines single-statement blocks into the brace expression that + comprises the receiver of concatenateQuasiLiteral" + + | elements locations stringStream loc | + elements := OrderedCollection new. + locations := OrderedCollection new. + stringStream := WriteStream on: (String new: 16). + [loc := hereMark + requestorOffset. + hereType == #doit ifTrue: + [^self expected: 'back quote']. + hereType == #leftBracket + ifTrue: + [self scanToken; advance. + parseNode := nil. + self blockExpression. + parseNode statements size = 1 + ifTrue: + [elements addLast: parseNode statements first] + ifFalse: + [elements addLast: (MessageNode new + receiver: parseNode + selector: #value + arguments: #() + precedence: 1 + from: encoder)]. + source position: hereMark - 1. + [source peek ~~ $]] whileTrue: + [source position: source position - 1]. + source next. + self step; step. + self setHereTypeForQuasiLiteral. + locations addLast: loc] + ifFalse: + [(self scanQuasiLiteralCharactersUsing: stringStream) ifNotNil: + [:lit| + elements addLast: lit. + locations addLast: loc]]. + hereType ~~ #backQuote] whileTrue. + parseNode := MessageNode new + receiver: (BraceNode new elements: elements sourceLocations: locations) + selector: #concatenateQuasiLiteral + arguments: #() + precedence: 1 + from: encoder. + self scanToken; advance. + ^true! Item was added: + ----- Method: Parser>>scanQuasiLiteralCharactersUsing: (in category 'scanning') ----- + scanQuasiLiteralCharactersUsing: stringStream + "Answer the next non-empty sequence of characters in a quasi-quote string, or nil, if none." + stringStream reset. + [hereChar ~~ $` and: [hereChar ~~ $[ and: [hereChar ~~ DoItCharacter]]] whileTrue: + [(hereChar == $$ and: ['`[$' includes: aheadChar]) + ifTrue: + [stringStream nextPut: aheadChar. self step] + ifFalse: + [stringStream nextPut: hereChar]. + self step]. + self setHereTypeForQuasiLiteral. + ^stringStream position > 0 ifTrue: + [encoder encodeLiteral: stringStream contents]! Item was added: + ----- Method: Parser>>setHereTypeForQuasiLiteral (in category 'scanning') ----- + setHereTypeForQuasiLiteral + "Set hereType appropriately based on hereChar. Used only for quasi-quote parsing." + hereChar == $` + ifTrue: + [hereType := #backQuote. + self step] + ifFalse: + [hereChar == $[ + ifTrue: + [hereType := #leftBracket. + self step] + ifFalse: + [hereChar == $] + ifTrue: + [hereType := #rightBracket. + self step] + ifFalse: + [hereChar == DoItCharacter ifTrue: + [hereType := #doit]]]]! Item was changed: ----- Method: Scanner class>>initializeTypeTable (in category 'initialization') ----- initializeTypeTable "self initializeTypeTable" | newTable | newTable := Array new: 256 withAll: #xBinary. "default" newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter. "tab lf ff cr space" newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit. 1 to: 255 do: [:index | (Character value: index) isLetter ifTrue: [newTable at: index put: #xLetter]]. newTable at: $" asciiValue put: #xDoubleQuote. newTable at: $# asciiValue put: #xLitQuote. newTable at: $$ asciiValue put: #xDollar. newTable at: $' asciiValue put: #xSingleQuote. + newTable at: $` asciiValue put: #backQuote. newTable at: $: asciiValue put: #xColon. newTable at: $( asciiValue put: #leftParenthesis. newTable at: $) asciiValue put: #rightParenthesis. newTable at: $. asciiValue put: #period. newTable at: $; asciiValue put: #semicolon. newTable at: $[ asciiValue put: #leftBracket. newTable at: $] asciiValue put: #rightBracket. newTable at: ${ asciiValue put: #leftBrace. newTable at: $} asciiValue put: #rightBrace. newTable at: $^ asciiValue put: #upArrow. newTable at: $_ asciiValue put: #xUnderscore. newTable at: $| asciiValue put: #verticalBar. TypeTable := newTable "bon voyage!!"!

1 0

The Inbox: Tests.quasiliteral-eem.296.mcz
by commits＠source.squeak.org 04 May '14

04 May '14

Eliot Miranda uploaded a new version of Tests to project The Inbox: http://source.squeak.org/inbox/Tests.quasiliteral-eem.296.mcz ==================== Summary ==================== Name: Tests.quasiliteral-eem.296 Author: eem Time: 4 May 2014, 1:43:00.087 pm UUID: af518e90-5c11-4582-9611-e46d26bdd5ff Ancestors: Tests-cwp.295, Tests.quasiquote-eem.189 Renamed from the bogus quasiquote to quasiliteral. Added Balazs' errors as failing tests. =============== Diff against Tests-cwp.295 =============== Item was added: + TestCase subclass: #QuasiLiteralTest + instanceVariableNames: 'foo bar baz' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-Compiler'! + + !QuasiLiteralTest commentStamp: 'eem 5/4/2014 12:00' prior: 0! + QuasiLiteralTest tests the quasi-literal facility which provides variable interpolation in string literals. + + Instance Variables + bar: <String> + baz: <String> + foo: <String> + + bar + - a string literal + + baz + - a string literal + + foo + - a string literal + ! Item was added: + ----- Method: QuasiLiteralTest>>testBalazsErrors (in category 'tests') ----- + testBalazsErrors + self assert: (self evaluate: '`[1] [2]`') equals: '1 2'. + self assert: (self evaluate: '`[1] [2] value]`') equals: '1 2 value]'. + self assert: (self evaluate: '`[1] [2] value`') equals: '1 2 value'.! Item was added: + ----- Method: QuasiLiteralTest>>testSimpleString (in category 'tests') ----- + testSimpleString + self assert: { 'hello world!!' } concatenateQuasiLiteral equals: 'hello world!!'. + self shouldnt: [Parser new parse: '`hello world!!`' readStream class: nil class noPattern: true notifying: nil ifFail: [Error signal]] + raise: SyntaxErrorNotification, Error. + self shouldnt: [self evaluate: '`hello world!!`'] + raise: SyntaxErrorNotification, Error. + self assert: (self evaluate: '`hello world!!`') equals: 'hello world!!'. + + self assert: { 'hello '. #cruel. ' world!!' } concatenateQuasiLiteral equals: 'hello cruel world!!'. + self shouldnt: [Parser new parse: '`hello [#cruel] world!!`' readStream class: nil class noPattern: true notifying: nil ifFail: [Error signal]] + raise: SyntaxErrorNotification, Error. + self shouldnt: [self evaluate: '`hello [#cruel] world!!`'] + raise: SyntaxErrorNotification, Error. + self assert: (self evaluate: '`hello [#cruel] world!!`') equals: 'hello cruel world!!'. + + self assert: (self evaluate: '`''hello world!!''`') equals: '''hello world!!'''.!

1 0

Daily Commit Log
by commits＠source.squeak.org 04 May '14

04 May '14

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2014-May/007014.html Name: Files-eem.134 Ancestors: Files-eem.133 Make the Files-eem.133 fix robust when the collection type doesn't match buffer1's type. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2014-May/007015.html Name: Kernel-eem.847 Ancestors: Kernel-eem.846 Fix class reshaping losing the correct methodClassAssociation in instance side methods. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2014-May/007016.html Name: KernelTests-eem.267 Ancestors: KernelTests-nice.266 Update ClassTest to test for Kernel-eem.847's fix. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2014-May/007017.html Name: KernelTests-nice.268 Ancestors: KernelTests-eem.267 Now that there is a direct access to Float negativeInfinity, use it. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2014-May/007018.html Name: Kernel-nice.848 Ancestors: Kernel-eem.847 Now that there is a direct access to Float negativeInfinity, use it. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2014-May/007019.html Name: CollectionsTests-nice.217 Ancestors: CollectionsTests-eem.216 Now that there is a direct access to Float negativeInfinity, use it. =============================================

1 0

The Trunk: CollectionsTests-nice.217.mcz
by commits＠source.squeak.org 03 May '14

03 May '14

Nicolas Cellier uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-nice.217.mcz ==================== Summary ==================== Name: CollectionsTests-nice.217 Author: nice Time: 3 May 2014, 10:50:53.513 pm UUID: 9841df48-0242-4d53-8a66-cc3bec9c24c9 Ancestors: CollectionsTests-eem.216 Now that there is a direct access to Float negativeInfinity, use it. =============== Diff against CollectionsTests-eem.216 =============== Item was changed: ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAt (in category 'testing') ----- testFloatArrayPluginPrimitiveAt "if FloatArrayPlugin primitive are not here, this test is dumb. Otherwise, it will compare primitive and #fromIEEE32Bit:" #( "regular numbers no truncation or rounding" 2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001 2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10 2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10 "smallest float32 before gradual underflow" 2r1.0e-126 "biggest float32" 2r1.11111111111111111111111e127 "overflow" 2r1.11111111111111111111111e128 "gradual underflow" 2r0.11111111111111111111111e-126 2r0.00000000000000000000001e-126 "with rounding mode : tests on 25 bits" 2r1.0000000000000000000000001 2r1.0000000000000000000000010 2r1.0000000000000000000000011 2r1.0000000000000000000000100 2r1.0000000000000000000000101 2r1.0000000000000000000000110 2r1.0000000000000000000000111 2r1.1111111111111111111111001 2r1.1111111111111111111111010 2r1.1111111111111111111111011 2r1.1111111111111111111111101 2r1.1111111111111111111111110 2r1.1111111111111111111111111 "overflow" 2r1.1111111111111111111111110e127 "gradual underflow" 2r0.1111111111111111111111111e-126 2r0.1111111111111111111111110e-126 2r0.1111111111111111111111101e-126 2r0.1111111111111111111111011e-126 2r0.1111111111111111111111010e-126 2r0.1111111111111111111111001e-126 2r0.0000000000000000000000111e-126 2r0.0000000000000000000000110e-126 2r0.0000000000000000000000101e-126 2r0.0000000000000000000000011e-126 2r0.0000000000000000000000010e-126 2r0.0000000000000000000000001e-126 2r0.0000000000000000000000010000000000000000000000000001e-126 ) do: [:e | self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)). self assert: ((FloatArray with: e negated) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e negated) basicAt: 1))]. "special cases" + (Array with: Float infinity with: Float negativeInfinity with: Float negativeZero) - (Array with: Float infinity with: Float infinity negated with: Float negativeZero) do: [:e | self assert: ((FloatArray with: e) at: 1) = (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1))]. "Cannot compare NaN" (Array with: Float nan) do: [:e | self assert: (Float fromIEEE32Bit: ((FloatArray with: e) basicAt: 1)) isNaN].! Item was changed: ----- Method: FloatArrayTest>>testFloatArrayPluginPrimitiveAtPut (in category 'testing') ----- testFloatArrayPluginPrimitiveAtPut "if FloatArrayPlugin primitive are not here, this test is dumb. Otherwise, it will compare primitive and #asIEEE32BitWord" #( "regular numbers no truncation or rounding" 2r0.0 2r1.0 2r1.1 2r1.00000000000000000000001 2r1.0e-10 2r1.1e-10 2r1.00000000000000000000001e-10 2r1.0e10 2r1.1e10 2r1.00000000000000000000001e10 "smallest float32 before gradual underflow" 2r1.0e-126 "biggest float32" 2r1.11111111111111111111111e127 "overflow" 2r1.11111111111111111111111e128 "gradual underflow" 2r0.11111111111111111111111e-126 2r0.00000000000000000000001e-126 "with rounding mode : tests on 25 bits" 2r1.0000000000000000000000001 2r1.0000000000000000000000010 2r1.0000000000000000000000011 2r1.0000000000000000000000100 2r1.0000000000000000000000101 2r1.0000000000000000000000110 2r1.0000000000000000000000111 2r1.1111111111111111111111001 2r1.1111111111111111111111010 2r1.1111111111111111111111011 2r1.1111111111111111111111101 2r1.1111111111111111111111110 2r1.1111111111111111111111111 "overflow" 2r1.1111111111111111111111110e127 "gradual underflow" 2r0.1111111111111111111111111e-126 2r0.1111111111111111111111110e-126 2r0.1111111111111111111111101e-126 2r0.1111111111111111111111011e-126 2r0.1111111111111111111111010e-126 2r0.1111111111111111111111001e-126 2r0.0000000000000000000000111e-126 2r0.0000000000000000000000110e-126 2r0.0000000000000000000000101e-126 2r0.0000000000000000000000011e-126 2r0.0000000000000000000000010e-126 2r0.0000000000000000000000001e-126 2r0.0000000000000000000000010000000000000000000000000001e-126 ) do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord. self assert: ((FloatArray with: e negated) basicAt: 1) = e negated asIEEE32BitWord]. "special cases" + (Array with: Float infinity with: Float negativeInfinity with: Float negativeZero with: Float nan) - (Array with: Float infinity with: Float infinity negated with: Float negativeZero with: Float nan) do: [:e | self assert: ((FloatArray with: e) basicAt: 1) = e asIEEE32BitWord]. !

1 0

The Trunk: Kernel-nice.848.mcz
by commits＠source.squeak.org 03 May '14

03 May '14

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.848.mcz ==================== Summary ==================== Name: Kernel-nice.848 Author: nice Time: 3 May 2014, 10:47:32.344 pm UUID: 8e301b04-6b3d-4f42-8292-6d3a8eb34f82 Ancestors: Kernel-eem.847 Now that there is a direct access to Float negativeInfinity, use it. =============== Diff against Kernel-eem.847 =============== Item was changed: ----- Method: FORTRANNumberParser>>nextNumber (in category 'parsing-public') ----- nextNumber "main method for reading a number with FORTRAN syntax. This one can read Real and Integer (not complex)" | numberOfTrailingZeroInIntegerPart numberOfNonZeroFractionDigits mantissa value numberOfTrailingZeroInFractionPart noInt | base := 10. (self nextMatchAll: 'NaN') ifTrue: [^Float nan]. neg := self peekSignIsMinus. (self nextMatchAll: 'Infinity') + ifTrue: [^neg ifTrue: [Float negativeInfinity] ifFalse: [Float infinity]]. - ifTrue: [^neg ifTrue: [Float infinity negated] ifFalse: [Float infinity]]. (noInt := sourceStream peekFor: $.) ifTrue: [integerPart := 0. numberOfTrailingZeroInIntegerPart := 0] ifFalse: [integerPart := self nextUnsignedIntegerBase: base. numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero]. (noInt or: [sourceStream peekFor: $.]) ifTrue: [fractionPart := self nextUnsignedIntegerBase: base ifFail: [nil]. fractionPart isNil ifTrue: [noInt ifTrue: ["no interger part, no fraction part..." self expected: 'a digit 0 to 9'. ^nil]. fractionPart := 0] ifFalse: [numberOfNonZeroFractionDigits := lastNonZero. numberOfTrailingZeroInFractionPart := nDigits - lastNonZero]. self readExponent] ifFalse: [self readExponent ifFalse: [^neg ifTrue: [integerPart negated] ifFalse: [integerPart]]. fractionPart := 0]. fractionPart isZero ifTrue: [mantissa := integerPart // (base raisedTo: numberOfTrailingZeroInIntegerPart). exponent := exponent + numberOfTrailingZeroInIntegerPart] ifFalse: [mantissa := integerPart * (base raisedTo: numberOfNonZeroFractionDigits) + (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)). exponent := exponent - numberOfNonZeroFractionDigits]. value := self makeFloatFromMantissa: mantissa exponent: exponent base: base. ^neg ifTrue: [value isZero ifTrue: [Float negativeZero] ifFalse: [value negated]] ifFalse: [value]! Item was changed: ----- Method: Float class>>fromIEEE32Bit: (in category 'instance creation') ----- fromIEEE32Bit: word "Convert the given 32 bit word (which is supposed to be a positive 32bit value) from a 32bit IEEE floating point representation into an actual Squeak float object (being 64bit wide). Should only be used for conversion in FloatArrays or likewise objects." | sign mantissa exponent newFloat delta | word negative ifTrue: [^ self error:'Cannot deal with negative numbers']. word = 0 ifTrue: [^ Float zero]. sign := word bitAnd: 16r80000000. word = sign ifTrue: [^self negativeZero]. exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127. mantissa := word bitAnd: 16r7FFFFF. exponent = 128 ifTrue:["Either NAN or INF" mantissa = 0 ifFalse:[^ Float nan]. sign = 0 ifTrue:[^ Float infinity] + ifFalse:[^ Float negativeInfinity]]. - ifFalse:[^ Float infinity negated]]. exponent = -127 ifTrue: [ "gradual underflow (denormalized number) Remove first bit of mantissa and adjust exponent" delta := mantissa highBit. mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1. exponent := exponent + delta - 23]. "Create new float" newFloat := self new: 2. newFloat basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)). newFloat basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29). ^newFloat! Item was changed: ----- Method: SqNumberParser>>readNamedFloatOrFail (in category 'parsing-private') ----- readNamedFloatOrFail "This method is used when there is no digit encountered: It try and read a named Float NaN or Infinity. Negative sign for -Infinity has been read before sending this method, and is indicated in the neg inst.var. Fail if no named Float is found" neg ifFalse: [(sourceStream nextMatchAll: 'NaN') ifTrue: [^ Float nan]]. (sourceStream nextMatchAll: 'Infinity') ifTrue: [^ neg + ifTrue: [Float negativeInfinity] - ifTrue: [Float infinity negated] ifFalse: [Float infinity]]. ^self expected: 'a digit between 0 and ' , (String with: (Character digitValue: base - 1))!

1 0

The Trunk: KernelTests-nice.268.mcz
by commits＠source.squeak.org 03 May '14

03 May '14

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.268.mcz ==================== Summary ==================== Name: KernelTests-nice.268 Author: nice Time: 3 May 2014, 10:37:15.215 pm UUID: e0058bc7-5cbc-43da-a0d6-34b19b06a6d5 Ancestors: KernelTests-eem.267 Now that there is a direct access to Float negativeInfinity, use it. =============== Diff against KernelTests-eem.267 =============== Item was changed: ----- Method: FloatTest>>testCharacterization (in category 'characterization') ----- testCharacterization "Test the largest finite representable floating point value" self assert: Float fmax successor = Float infinity. self assert: Float infinity predecessor = Float fmax. + self assert: Float fmax negated predecessor = Float negativeInfinity. + self assert: Float negativeInfinity successor = Float fmax negated. - self assert: Float fmax negated predecessor = Float infinity negated. - self assert: Float infinity negated successor = Float fmax negated. "Test the smallest positive representable floating point value" self assert: Float fmin predecessor = 0.0. self assert: 0.0 successor = Float fmin. self assert: Float fmin negated successor = 0.0. self assert: 0.0 predecessor = Float fmin negated. "Test the relative precision" self assert: Float one + Float epsilon > Float one. self assert: Float one + Float epsilon = Float one successor. self assert: Float one + (Float epsilon / Float radix) = Float one. "Test maximum and minimum exponent" self assert: Float fmax exponent = Float emax. self assert: Float fminNormalized exponent = Float emin. Float denormalized ifTrue: [ self assert: Float fminDenormalized exponent = (Float emin + 1 - Float precision)]. "Alternative tests for maximum and minimum" self assert: (Float radix - Float epsilon) * (Float radix raisedTo: Float emax) = Float fmax. self assert: Float epsilon * (Float radix raisedTo: Float emin) = Float fmin. "Test sucessors and predecessors" self assert: Float one predecessor successor = Float one. self assert: Float one successor predecessor = Float one. self assert: Float one negated predecessor successor = Float one negated. self assert: Float one negated successor predecessor = Float one negated. self assert: Float infinity successor = Float infinity. + self assert: Float negativeInfinity predecessor = Float negativeInfinity. - self assert: Float infinity negated predecessor = Float infinity negated. self assert: Float fmin negated successor = 0.0. self assert: Float fmin negated successor sign = -1. self assert: Float nan predecessor isNaN. self assert: Float nan successor isNaN. "SPECIFIC FOR IEEE 754 double precision - 64 bits" self assert: Float fmax hex = '7FEFFFFFFFFFFFFF'. self assert: Float fminDenormalized hex = '0000000000000001'. self assert: Float fminNormalized hex = '0010000000000000'. self assert: 0.0 hex = '0000000000000000'. self assert: Float negativeZero hex = '8000000000000000'. self assert: Float one hex = '3FF0000000000000'. self assert: Float infinity hex = '7FF0000000000000'. + self assert: Float negativeInfinity hex = 'FFF0000000000000'.! - self assert: Float infinity negated hex = 'FFF0000000000000'.! Item was changed: ----- Method: FloatTest>>testComparison (in category 'testing compare') ----- testComparison "test equality when Float conversion loose bits" | a b c | a := 16r1FFFFFFFFFFFFF1. b := 16r1FFFFFFFFFFFFF3. c := a asFloat. self assert: ((a = c) & (b = c)) ==> (a = b). "Test equality when Float conversion exact" self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat. self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat asInteger. "Test inequality when Float conversion loose bits" self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1. self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1.0. self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1. self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1.0. "Test exact vs inexact arithmetic" (1 to: 100) do: [:i | i isPowerOfTwo ifTrue: [self assert: (1/i) = (1/i) asFloat] ifFalse: [self deny: (1/i) = (1/i) asFloat]]. "Test overflow (compare to infinity)" a := (11 raisedTo: 400) / 2. b := (13 raisedTo: 400) / 2. c := a asFloat. self assert: ((a = c) & (b = c)) ==> (a = b). "every integer is smaller than infinity" self assert: a < Float infinity. + self assert: a > Float negativeInfinity. - self assert: a > Float infinity negated. "Test underflow" self deny: 1 / (11 raisedTo: 400) = 0. self deny: 1 / (11 raisedTo: 400) = 0.0. "Test hash code" self assert: ((Set new: 3) add: 3; add: 3.0; size) = ((Set new: 4) add: 3; add: 3.0; size).! Item was changed: ----- Method: FloatTest>>testCopy (in category 'testing') ----- testCopy "Elementary tests" self assert: 2.0 copy = 2.0. self assert: -0.5 copy = -0.5. "Are exceptional Floats preserved by the copy ?" self assert: Float nan copy isNaN. self assert: Float infinity copy = Float infinity. + self assert: Float negativeInfinity copy = Float negativeInfinity. - self assert: Float infinity negated copy = Float infinity negated. "Is the sign of zero preserved by the copy ?" self assert: 0.0 copy hex = 0.0 hex. self assert: Float negativeZero copy hex = Float negativeZero hex.! Item was changed: ----- Method: FloatTest>>testDegreeCosForExceptionalValues (in category 'tests - mathematical functions') ----- testDegreeCosForExceptionalValues self assert: Float nan degreeCos isNaN. self assert: Float infinity degreeCos isNaN. + self assert: Float negativeInfinity degreeCos isNaN.! - self assert: Float infinity negated degreeCos isNaN.! Item was changed: ----- Method: FloatTest>>testDegreeSinForExceptionalValues (in category 'tests - mathematical functions') ----- testDegreeSinForExceptionalValues self assert: Float nan degreeSin isNaN. self assert: Float infinity degreeSin isNaN. + self assert: Float negativeInfinity degreeSin isNaN.! - self assert: Float infinity negated degreeSin isNaN.! Item was changed: ----- Method: FloatTest>>testInfinity3 (in category 'IEEE 754') ----- testInfinity3 + self assert: (Float negativeInfinity asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = - self assert: (Float infinity negated asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '11111111100000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '11111111100000000000000000000000' readStream base: 2)) + = Float negativeInfinity! - = Float infinity negated! Item was changed: ----- Method: FloatTest>>testInfinityCloseTo (in category 'infinity behavior') ----- testInfinityCloseTo "This is a test for bug http://bugs.squeak.org/view.php?id=6729:" "FloatTest new testInfinityCloseTo" + self deny: (Float infinity closeTo: Float negativeInfinity). + self deny: (Float negativeInfinity closeTo: Float infinity).! - self deny: (Float infinity closeTo: Float infinity negated). - self deny: (Float infinity negated closeTo: Float infinity).! Item was changed: ----- Method: FloatTest>>testSign (in category 'testing') ----- testSign "Set up" | negatives negz positives strictNegatives strictPositives zero | strictPositives := {2. 2.5. Float infinity}. + strictNegatives := {-3. -3.25. Float negativeInfinity}. - strictNegatives := {-3. -3.25. Float infinity negated}. zero := 0.0. negz := Float negativeZero. positives := strictPositives copyWith: zero. negatives := strictNegatives copyWith: negz. "The sign of non zeros" strictPositives do: [:aPositive | self assert: aPositive sign = 1]. strictNegatives do: [:aNegative | self assert: aNegative sign = -1]. "The sign of zeros" self assert: zero sign = 0. self assert: negz sign = -1. "remark though that negz >= 0.0, and is thus considered positive... Weird" "Test the copy sign functions" positives do: [:aPositiveSign | positives do: [:aPositive | self assert: (aPositive sign: aPositiveSign) = aPositive]. negatives do: [:aNegative | self assert: (aNegative sign: aPositiveSign) = aNegative negated]. (zero sign: aPositiveSign) sign = 0. (negz sign: aPositiveSign) sign = 0]. negatives do: [:aNegativeSign | positives do: [:aPositive | self assert: (aPositive sign: aNegativeSign) = aPositive negated]. negatives do: [:aNegative | self assert: (aNegative sign: aNegativeSign) = aNegative]. (zero sign: aNegativeSign) sign = -1. (negz sign: aNegativeSign) sign = -1].! Item was changed: ----- Method: FloatTest>>testSignificandAndExponent (in category 'characterization') ----- testSignificandAndExponent | denormals exceptionals normals | normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. + exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. - exceptionals := {Float nan. Float infinity. Float infinity negated.}. normals , denormals , exceptionals do: [:aFloat | "Any Float can be decomposed into its significand and exponent, and the significand holds the sign" aFloat isNaN ifTrue: [self assert: (aFloat significand timesTwoPower: aFloat exponent) isNaN] ifFalse: [self assert: (aFloat significand timesTwoPower: aFloat exponent) equals: aFloat]]. normals , denormals do: [:aFloat | "The significand magnitude is in interval [1.0,2.0( " aFloat = 0.0 ifTrue: [self assert: aFloat significand equals: 0] ifFalse: [self assert: aFloat significand abs >= 1.0; assert: aFloat significand abs < 2.0]]! Item was changed: ----- Method: FloatTest>>testSignificandAsInteger (in category 'characterization') ----- testSignificandAsInteger | mantissaBits denormalPowersOfTwo denormals exceptionals normalPowersOfTwo normals | "There are 52 bits used for representing the mantissa (plus an eventual leading 1, see below)" mantissaBits := Float precision - 1. normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. + exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. - exceptionals := {Float nan. Float infinity. Float infinity negated.}. normalPowersOfTwo := (-10 to: 10) collect: [:i | 1.0 timesTwoPower: i]. denormalPowersOfTwo := (Float emin - mantissaBits to: Float emin - 1) collect: [:i | 1.0 timesTwoPower: i]. normals do: [:aNormalFloat | "Assume the mantissa is written in least 52 bits of hex format, with an implied 1 on position 53" self assert: (((Integer readFrom: aNormalFloat hex base: 16) bitAnd: 1<<mantissaBits-1) bitOr: 1<<mantissaBits) equals: aNormalFloat significandAsInteger]. denormals , exceptionals do: [:aDenormalOrExceptionalFloat | "For every other Float, zero, denormal or exceptional, no implied leading one" self assert: ((Integer readFrom: aDenormalOrExceptionalFloat hex base: 16) bitAnd: 1<<mantissaBits-1) equals: aDenormalOrExceptionalFloat significandAsInteger]. normalPowersOfTwo do: [:aNormalPowerOfTwoFloat | "The significand of a power of two is a power of two, with high bit of expected precision" self assert: aNormalPowerOfTwoFloat significandAsInteger isPowerOfTwo. self assert: aNormalPowerOfTwoFloat significandAsInteger highBit equals: Float precision. self assert: aNormalPowerOfTwoFloat successor significandAsInteger equals: aNormalPowerOfTwoFloat significandAsInteger + 1. "The last one is not true for fminNormalized" aNormalPowerOfTwoFloat = Float fminNormalized or: [ self assert: aNormalPowerOfTwoFloat predecessor significandAsInteger equals: aNormalPowerOfTwoFloat significandAsInteger * 2 - 1]]. denormalPowersOfTwo do: [:aDenormalPowerOfTwoFloat | "The significand of a denormal power of two is a power of two, just with less bits" self assert: aDenormalPowerOfTwoFloat significandAsInteger isPowerOfTwo. self assert: aDenormalPowerOfTwoFloat significandAsInteger highBit equals: Float precision + aDenormalPowerOfTwoFloat exponent - Float emin. aDenormalPowerOfTwoFloat successor = Float fminNormalized or: [ self assert: aDenormalPowerOfTwoFloat successor significandAsInteger equals: aDenormalPowerOfTwoFloat significandAsInteger + 1]. self assert: aDenormalPowerOfTwoFloat predecessor significandAsInteger equals: aDenormalPowerOfTwoFloat significandAsInteger - 1.]. "Well known value for a few extremal cases" self assert: Float fmax significandAsInteger equals: 1 << Float precision - 1. self assert: Float fmin significandAsInteger equals: 1. self assert: 0.0 significandAsInteger equals: 0. self assert: Float infinity significandAsInteger equals: 0. self assert: Float nan significandAsInteger > 0! Item was changed: ----- Method: FloatTest>>testStoreOn (in category 'testing') ----- testStoreOn "If storeOn: prints exactly and the parser avoid cumulating round off Errors, then Float should be read back exactly. Note: there is no guarantee to restore the bit pattern of NaN though" self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. + self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. - self assert: (Compiler evaluate: Float infinity negated storeString) = Float infinity negated. self assert: (Compiler evaluate: Float nan storeString) isNaN.! Item was changed: ----- Method: FloatTest>>testUlp (in category 'characterization') ----- testUlp {Float pi predecessor. Float pi. Float pi successor} do: [:f | self assert: (f * 2) ulp = (f ulp * 2). self assert: (f / 2) ulp = (f ulp / 2). self deny: f + f ulp = f. self deny: f - f ulp = f. "Tests below are valid as long as default rounding mode (to nearest even) is used" self assert: f significandAsInteger odd ==> (f ulp / 2.0 + f = f successor). self assert: f significandAsInteger even ==> (f ulp / 2.0 + f = f)]. self assert: 0.0 ulp = Float fmin. self assert: 1.0 ulp = Float epsilon. self assert: Float nan ulp isNaN. self assert: Float infinity ulp = Float infinity. + self assert: Float negativeInfinity ulp = Float infinity. - self assert: Float infinity negated ulp = Float infinity. self assert: ((0 to: Float precision - 1) allSatisfy: [:each | (Float fmin timesTwoPower: each) ulp = Float fmin]). ! Item was changed: ----- Method: NumberTest>>testZeroDivideHandler (in category 'tests') ----- testZeroDivideHandler "Test for user-defined ZeroDivide behavior" [ self assert: 1 / 0 = Float infinity. + self assert: -1 / 0 = Float negativeInfinity. - self assert: -1 / 0 = Float infinity negated. self assert: 1.0 / 0 = Float infinity. + self assert: -1.0 / 0 = Float negativeInfinity. - self assert: -1.0 / 0 = Float infinity negated. self assert: 1 / 0.0 = Float infinity. + self assert: -1 / 0.0 = Float negativeInfinity. - self assert: -1 / 0.0 = Float infinity negated. self assert: 1.0 / 0.0 = Float infinity. + self assert: -1.0 / 0.0 = Float negativeInfinity. - self assert: -1.0 / 0.0 = Float infinity negated. ] on: ZeroDivide do: [:ex | ex resume: ex dividend sign * Float infinity ] !

1 0

Jump to page: