SystemOrganization addCategory: #'AST-Tests-Core'! TestCase subclass: #RBFormatterTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests-Core'! !RBFormatterTests methodsFor: 'private' stamp: 'lr 9/4/2010 16:56'! formatClass: aClass aClass selectors do: [ :each | self formatClass: aClass selector: each ]! ! !RBFormatterTests methodsFor: 'private' stamp: 'lr 9/4/2010 16:57'! formatClass: aClass selector: aSymbol self formatters do: [ :each | self formatClass: aClass selector: aSymbol formatter: each ]! ! !RBFormatterTests methodsFor: 'private' stamp: 'lr 9/4/2010 16:57'! formatClass: aClass selector: aSymbol formatter: aFormatterClass | source tree1 tree2 | source := aClass sourceCodeAt: aSymbol. tree1 := RBParser parseMethod: source. tree2 := RBParser parseMethod: (aFormatterClass new format: tree1) onError: [ :err :pos | self assert: false ]. self assert: tree1 = tree2! ! !RBFormatterTests methodsFor: 'accessing' stamp: 'lr 11/2/2009 09:14'! formatters ^ Array with: RBFormatter with: RBConfigurableFormatter! ! !RBFormatterTests methodsFor: 'testing' stamp: 'lr 9/4/2010 16:55'! testCoreSystem #(Object Behavior Boolean True False Integer SmallInteger Collection String) do: [ :each | | class | class := Smalltalk globals classNamed: each. self formatClass: class; formatClass: class class ]! ! TestCase subclass: #RBProgramNodeTest instanceVariableNames: 'node previous' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests-Core'! !RBProgramNodeTest class methodsFor: 'accessing' stamp: 'lr 9/18/2011 15:06'! packageNamesUnderTest ^ #('AST-Core')! ! !RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 12/29/2009 12:48'! node ^ node ifNil: [ node := RBProgramNode new ]! ! !RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 2/21/2010 12:17'! parseExpression: aString ^ RBParser parseExpression: aString! ! !RBProgramNodeTest methodsFor: 'accessing' stamp: 'lr 2/21/2010 12:17'! parseMethod: aString ^ RBParser parseMethod: aString! ! !RBProgramNodeTest methodsFor: 'running' stamp: 'lr 3/26/2010 17:35'! setUp super setUp. previous := RBProgramNode formatterClass. RBProgramNode formatterClass: RBFormatter! ! !RBProgramNodeTest methodsFor: 'running' stamp: 'lr 3/26/2010 17:35'! tearDown super tearDown. RBProgramNode formatterClass: previous! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'! testHasProperty self deny: (self node hasProperty: #foo). self node propertyAt: #foo put: 123. self assert: (self node hasProperty: #foo)! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'! testPropertyAt self should: [ self node propertyAt: #foo ] raise: Error. self node propertyAt: #foo put: true. self assert: (self node propertyAt: #foo)! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:49'! testPropertyAtIfAbsent self assert: (self node propertyAt: #foo ifAbsent: [ true ]). self node propertyAt: #foo put: true. self assert: (self node propertyAt: #foo ifAbsent: [ false ])! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:46'! testPropertyAtIfAbsentPut self assert: (self node propertyAt: #foo ifAbsentPut: [ true ]). self assert: (self node propertyAt: #foo ifAbsentPut: [ false ])! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:47'! testRemoveProperty self should: [ self node removeProperty: #foo ] raise: Error. self node propertyAt: #foo put: true. self assert: (self node removeProperty: #foo)! ! !RBProgramNodeTest methodsFor: 'testing-properties' stamp: 'lr 12/29/2009 12:47'! testRemovePropertyIfAbsent self assert: (self node removeProperty: #foo ifAbsent: [ true ]). self node propertyAt: #foo put: true. self assert: (self node removeProperty: #foo ifAbsent: [ false ])! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:38'! testReplaceLiteral | tree | tree := self parseMethod: 'run "1" 123 "2"'. tree body statements first replaceWith: (self parseExpression: '$a'). self assert: tree newSource = 'run "1" $a "2"'. tree := self parseMethod: 'run "1" 123 "2"'. tree body statements first replaceWith: (self parseExpression: 'zork'). self assert: tree newSource = 'run "1" zork "2"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:38'! testReplaceLiteralArray | tree | tree := self parseMethod: 'run "1" #(1 2 3) "2"'. tree body statements first replaceWith: (self parseExpression: '#[1 2 3]'). self assert: tree newSource = 'run "1" #[1 2 3] "2"'. tree := self parseMethod: 'run "1" #(1 2 3) "2"'. tree body statements first replaceWith: (self parseExpression: '123'). self assert: tree newSource = 'run "1" 123 "2"'. tree := self parseMethod: 'run "1" #[1 2 3] "2"'. tree body statements first replaceWith: (self parseExpression: '#(1 2 3)'). self assert: tree newSource = 'run "1" #(1 2 3) "2"'. tree := self parseMethod: 'run "1" #[1 2 3] "2"'. tree body statements first replaceWith: (self parseExpression: '123'). self assert: tree newSource = 'run "1" 123 "2"' ! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 2/21/2010 13:50'! testReplaceMessage | tree | tree := self parseMethod: 'run "1" self "2" run "3"'. tree body statements first replaceWith: (self parseExpression: 'self runCase'). self assert: tree newSource = 'run "1" self "2" runCase "3"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:36'! testReplaceMessageArgument | tree | tree := self parseMethod: 'foo "1" self "2" foo: "3" foo "4"'. tree body statements first arguments first replaceWith: (self parseExpression: 'bar'). self assert: tree newSource = 'foo "1" self "2" foo: "3" bar "4"'. tree := self parseMethod: 'foo "1" self "2" foo: "3" foo "4"'. tree body statements first arguments first replaceWith: (self parseExpression: 'bar msg1 msg2'). self assert: tree newSource = 'foo "1" self "2" foo: "3" bar msg1 msg2 "4"'. tree := self parseMethod: 'foo "1" self "2" foo: "3" foo bar "4"'. tree body statements first arguments first replaceWith: (self parseExpression: 'bar'). self assert: tree newSource = 'foo "1" self "2" foo: "3" bar "4"'. ! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:36'! testReplaceMessageReceiver | tree | tree := self parseMethod: 'foo "1" self "2" foo: "3" 123 "4"'. tree body statements first receiver replaceWith: (self parseExpression: 'bar'). self assert: tree newSource = 'foo "1" bar "2" foo: "3" 123 "4"'. tree := self parseMethod: 'foo "1" self "2" foo: "3" 123 "4"'. tree body statements first receiver replaceWith: (self parseExpression: 'bar msg1 msg2'). self assert: tree newSource = 'foo "1" bar msg1 msg2 "2" foo: "3" 123 "4"'. tree := self parseMethod: 'foo "1" self foo "2" foo: "3" 123 "4"'. tree body statements first receiver replaceWith: (self parseExpression: 'bar'). self assert: tree newSource = 'foo "1" bar "2" foo: "3" 123 "4"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'! testReplaceMethodBinary | tree | tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #runCase andArguments: #(). self assert: tree newSource = 'runCase "2" ^ "3" 4 "5"'. tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = '~~ "1" first "2" ^ "3" 4 "5"'. tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #assert: andArguments: (Array with: (RBVariableNode named: 'first')). self assert: tree newSource = 'assert: "1" first "2" ^ "3" 4 "5"'. tree := self parseMethod: '= "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #assert:description: andArguments: (Array with: (RBVariableNode named: 'first') with: (RBVariableNode named: 'second')). self assert: tree newSource = 'assert: first description: second "2" ^ "3" 4 "5"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'! testReplaceMethodKeyword | tree | tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #runCase andArguments: #(). self assert: tree newSource = 'runCase "2" ^ "3" 4 "5"'. tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = '~~ "1" first "2" ^ "3" 4 "5"'. tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #assert: andArguments: (Array with: (RBVariableNode named: 'first')). self assert: tree newSource = 'assert: "1" first "2" ^ "3" 4 "5"'. tree := self parseMethod: 'deny: "1" anObject "2" ^ "3" 4 "5"'. tree renameSelector: #assert:description: andArguments: (Array with: (RBVariableNode named: 'first') with: (RBVariableNode named: 'second')). self assert: tree newSource = 'assert: first description: second "2" ^ "3" 4 "5"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'! testReplaceMethodKeywordLong | tree | tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'. tree renameSelector: #runCase andArguments: #(). self assert: tree newSource = 'runCase "4" ^ "5" 6 "7"'. tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'. tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = '~~ first "4" ^ "5" 6 "7"'. tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'. tree renameSelector: #assert: andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = 'assert: first "4" ^ "5" 6 "7"'. tree := self parseMethod: 'deny: "1" anObject "2" description: "3" anotherObject "4" ^ "5" 6 "7"'. tree renameSelector: #assert:description: andArguments: (Array with: (self parseExpression: 'first') with: (self parseExpression: 'second')). self assert: tree newSource = 'assert: "1" first "2" description: "3" second "4" ^ "5" 6 "7"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'! testReplaceMethodUnary | tree | tree := self parseMethod: 'run "1" ^ "2" 3 "4"'. tree renameSelector: #runCase andArguments: #(). self assert: tree newSource = 'runCase "1" ^ "2" 3 "4"'. tree := self parseMethod: 'run "1" ^ "2" 3 "4"'. tree renameSelector: #~~ andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = '~~ first "1" ^ "2" 3 "4"'. tree := self parseMethod: 'run "1" ^ "2" 3 "4"'. tree renameSelector: #assert: andArguments: (Array with: (self parseExpression: 'first')). self assert: tree newSource = 'assert: first "1" ^ "2" 3 "4"'. tree := self parseMethod: 'run "1" ^ "2" 3 "4"'. tree renameSelector: #assert:description: andArguments: (Array with: (self parseExpression: 'first') with: (self parseExpression: 'second')). self assert: tree newSource = 'assert: first description: second "1" ^ "2" 3 "4"'! ! !RBProgramNodeTest methodsFor: 'testing-replacing' stamp: 'lr 5/26/2010 08:39'! testReplaceVariable | tree | tree := self parseMethod: 'run "1" foo "2"'. tree body statements first replaceWith: (self parseExpression: 'zork'). self assert: tree newSource = 'run "1" zork "2"'. tree := self parseMethod: 'run "1" foo "2"'. tree body statements first replaceWith: (self parseExpression: '123'). self assert: tree newSource = 'run "1" 123 "2"'! ! TestCase subclass: #RBSmallDictionaryTest instanceVariableNames: 'dict' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests-Core'! !RBSmallDictionaryTest methodsFor: 'running' stamp: 'lr 12/29/2009 12:54'! setUp super setUp. dict := RBSmallDictionary new! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 12:56'! testAtError dict at: #a put: 1. self shouldnt: [ dict at: #a ] raise: Error. self should: [ dict at: #b ] raise: Error! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 12:56'! testAtIfAbsent dict at: #a put: 666. self assert: (dict at: #a ifAbsent: [ nil ]) = 666. self assert: (dict at: #b ifAbsent: [ nil ]) isNil! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:02'! testAtPut self assert: (dict at: #a put: 3) = 3. self assert: (dict at: #a) = 3. self assert: (dict at: #a put: 4) = 4. self assert: (dict at: #a) = 4. self assert: (dict at: nil put: 5) = 5. self assert: (dict at: nil) = 5 ! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:08'! testCopy | copy | dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. copy := dict copy. copy at: 'Germany' put: 'Berlin'. dict at: 'Switzerland' put: 'Bern'. self assert: copy size = 3. self assert: (copy includesKey: 'Germany'). self deny: (copy includesKey: 'Switzerland'). self assert: dict size = 3. self assert: (dict includesKey: 'Switzerland'). self deny: (dict includesKey: 'Germany') ! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:01'! testEmpty dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. dict empty. self assert: dict isEmpty. self deny: (dict includesKey: 'France'). self deny: (dict includesKey: 'Italie'). self assert: dict keys isEmpty. self assert: dict values isEmpty! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 12:56'! testIncludesKey dict at: 'Italie' put: nil. dict at: 'France' put: 'Paris'. self assert: (dict includesKey: 'Italie'). self assert: (dict includesKey: 'France'). self deny: (dict includesKey: 'Switzerland')! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:05'! testKeys dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. self assert: dict keys = #('France' 'Italie')! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:04'! testKeysAndValuesDo | keys values | dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. keys := OrderedCollection new. values := OrderedCollection new. dict keysAndValuesDo: [ :key :value | keys add: key. values add: value ]. self assert: keys asArray = #('France' 'Italie'). self assert: values asArray = #('Paris' 'Rome')! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:05'! testKeysDo | keys | dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. keys := OrderedCollection new. dict keysDo: [ :each | keys add: each ]. self assert: keys asArray = #('France' 'Italie')! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 12:59'! testRemoveKey dict at: #a put: 1. dict at: #b put: 2. self assert: (dict keys size) = 2. self assert: (dict removeKey: #a) = 1. self assert: (dict keys size) = 1. self assert: (dict at: #a ifAbsent: [ true ]). self assert: (dict at: #b) = 2. self should: [ dict removeKey: #a ] raise: Error! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:00'! testRemoveKeyIfAbsent dict at: #a put: 1. dict at: #b put: 2. self assert: (dict keys size) = 2. self assert: (dict removeKey: #a ifAbsent: [ false ]) = 1. self assert: (dict keys size) = 1. self assert: (dict at: #a ifAbsent: [ true ]). self assert: (dict at: #b) = 2. self assert: (dict removeKey: #a ifAbsent: [ true ])! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:05'! testValues dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. self assert: dict values = #('Paris' 'Rome')! ! !RBSmallDictionaryTest methodsFor: 'testing' stamp: 'lr 12/29/2009 13:04'! testValuesDo | values | dict at: 'France' put: 'Paris'. dict at: 'Italie' put: 'Rome'. values := OrderedCollection new. dict valuesDo: [ :each | values add: each ].. self assert: values asArray = #('Paris' 'Rome')! !