SystemOrganization addCategory: #'AST-Tests-Semantic'! TestCase subclass: #RBSemanticTest instanceVariableNames: 'instVar' classVariableNames: 'ClassVar' poolDictionaries: '' category: 'AST-Tests-Semantic'! !RBSemanticTest class methodsFor: 'accessing' stamp: 'lr 4/27/2010 16:17'! packageNamesUnderTest ^ #('AST-Semantic')! ! !RBSemanticTest methodsFor: 'utilities' stamp: 'lr 5/29/2010 20:33'! parseExpression: aString ^ (RBParser parseExpression: aString) annotateInClass: self class; yourself! ! !RBSemanticTest methodsFor: 'utilities' stamp: 'lr 5/29/2010 20:33'! parseMethod: aString ^ (RBParser parseMethod: aString) annotateInClass: self class; yourself! ! !RBSemanticTest methodsFor: 'testing' stamp: 'lr 6/4/2010 15:41'! testAccessors | tree binding | tree := self parseExpression: '| var | var'. binding := tree lexicalScope bindingOf: 'var'. self assert: binding node = tree temporaries first. self assert: binding accessors size = 1. self assert: binding accessors first = tree statements first. self assert: binding readers isEmpty. self assert: binding writers isEmpty! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testBlockArgumentBinding | tree binding | tree := self parseExpression: '[ :arg | ]'. binding := tree arguments first variableBinding. self assert: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self deny: binding isAccessed. self assert: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self assert: binding isReadonly. self assert: binding name = 'arg'. self assert: binding printString isString. self assert: binding node = tree arguments first. self assert: binding scope = tree lexicalScope! ! !RBSemanticTest methodsFor: 'testing-scopes' stamp: 'lr 5/11/2010 21:56'! testBlockScope | tree scope | tree := self parseExpression: '[ :arg | | tmp | ]'. scope := tree lexicalScope. self assert: scope isBlockScope. self deny: scope isLiteralScope. self deny: scope isMethodScope. self deny: scope isRootScope. self deny: scope isVariableScope. self assert: scope node = tree. self assert: (scope lookup: 'arg') isArgumentBinding. self assert: (scope lookup: 'arg') scope = scope. self assert: (scope lookup: 'arg') name = 'arg'. self assert: (scope lookup: 'tmp') isTemporaryBinding. self assert: (scope lookup: 'tmp') scope = scope. self assert: (scope lookup: 'tmp') name = 'tmp'. self should: [ scope lookup: 'something' ] raise: Error. self assert: (scope lookup: 'something' ifAbsent: [ #nothing ]) = #nothing ! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testBlockTemporaryBinding | tree binding | tree := self parseExpression: '[ | tmp | ]'. binding := tree body temporaries first variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self assert: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self deny: binding isAccessed. self assert: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'tmp'. self assert: binding printString isString. self assert: binding node = tree body temporaries first. self assert: binding scope = tree lexicalScope! ! !RBSemanticTest methodsFor: 'testing-fixtures' stamp: 'lr 5/26/2010 18:48'! testCascadeReceiver | tree receiver receiver1 receiver2 | tree := self parseExpression: 'self foo; bar'. receiver := tree receiver. receiver1 := tree messages first receiver. receiver2 := tree messages last receiver. self assert: receiver variableBinding = receiver1 variableBinding. self assert: receiver variableBinding = receiver2 variableBinding! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testClassVariableBinding | tree binding | tree := self parseExpression: 'ClassVar'. binding := tree variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self assert: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'ClassVar'. self assert: binding printString isString. self assert: binding binding = (self class bindingOf: 'ClassVar'). self assert: binding scope notNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testGlobalVariableBinding | tree binding | tree := self parseExpression: self class name. binding := tree variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self assert: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = self class name. self assert: binding printString isString. self assert: binding binding = (self class bindingOf: self class name). self assert: binding scope notNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'cwp 4/10/2011 08:43'! testInstanceVariableBinding | tree binding | tree := self parseExpression: 'instVar'. binding := tree variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self assert: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'instVar'. self assert: binding printString isString. self assert: binding index = (self class allInstVarNames indexOf: 'instVar'). self assert: binding scope notNil! ! !RBSemanticTest methodsFor: 'testing-scopes' stamp: 'lr 6/7/2010 15:00'! testLiteralScope | scope literals | scope := RBLiteralScope owner: RBRootScope new class: RBMessageNode. self deny: scope isBlockScope. self assert: scope isLiteralScope. self deny: scope isMethodScope. self deny: scope isRootScope. self deny: scope isVariableScope. self assert: scope theClass = RBMessageNode. literals := OrderedCollection new. literals addAll: (RBMessageNode allClassVarNames). literals addAll: (RBProgramNode allSubclasses collect: [ :each | each name ]). literals do: [ :name | self assert: (scope lookup: name) isLiteralBinding. self assert: (scope lookup: name) scope = scope. self assert: (scope lookup: name) name = name ]. self assert: (scope lookup: 'self') scope = scope owner. self assert: (scope lookup: 'super') scope = scope owner. self assert: (scope lookup: 'thisContext') scope = scope owner. self should: [ scope lookup: 'something' ] raise: Error. self assert: (scope lookup: 'something' ifAbsent: [ #nothing ]) = #nothing ! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testMethodArgumentBinding | tree binding | tree := self parseMethod: 'foo: arg'. binding := tree arguments first variableBinding. self assert: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self deny: binding isAccessed. self assert: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self assert: binding isReadonly. self assert: binding name = 'arg'. self assert: binding printString isString. self assert: binding node = tree arguments first. self assert: binding scope = tree lexicalScope! ! !RBSemanticTest methodsFor: 'testing-scopes' stamp: 'lr 5/11/2010 21:56'! testMethodScope | tree scope | tree := self parseMethod: 'foo: arg | tmp |'. scope := tree lexicalScope. self deny: scope isBlockScope. self deny: scope isLiteralScope. self assert: scope isMethodScope. self deny: scope isRootScope. self deny: scope isVariableScope. self assert: scope node = tree. self assert: (scope lookup: 'arg') isArgumentBinding. self assert: (scope lookup: 'arg') scope = scope. self assert: (scope lookup: 'arg') name = 'arg'. self assert: (scope lookup: 'tmp') isTemporaryBinding. self assert: (scope lookup: 'tmp') scope = scope. self assert: (scope lookup: 'tmp') name = 'tmp'. self should: [ scope lookup: 'something' ] raise: Error. self assert: (scope lookup: 'something' ifAbsent: [ #nothing ]) = #nothing ! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testMethodTemporaryBinding | tree binding | tree := self parseMethod: 'foo | tmp |'. binding := tree body temporaries first variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self assert: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self deny: binding isAccessed. self assert: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'tmp'. self assert: binding printString isString. self assert: binding node = tree body temporaries first. self assert: binding scope = tree lexicalScope! ! !RBSemanticTest methodsFor: 'testing' stamp: 'lr 9/2/2010 13:58'! testMissing | tree | tree := self parseExpression: 'a'. self should: [ RBVariableNode new lexicalScope ] raise: RBSemanticAnnotationMissing. self shouldnt: [ tree lexicalScope ] raise: RBSemanticAnnotationMissing. self should: [ RBVariableNode new variableBinding ] raise: RBSemanticAnnotationMissing. self shouldnt: [ tree variableBinding ] raise: RBSemanticAnnotationMissing. self deny: RBVariableNode new hasVariableBinding. self assert: tree hasVariableBinding! ! !RBSemanticTest methodsFor: 'testing-fixtures' stamp: 'lr 6/7/2010 14:54'! testMultipleScopes | tree block1 variable1 block2 variable2 | tree := self parseExpression: '[ :a | a ]. [ | a | a ]'. block1 := tree statements first. variable1 := block1 arguments first. block2 := tree statements last. variable2 := block2 body temporaries first. self deny: variable1 variableBinding = variable2 variableBinding. self assert: variable1 variableBinding = block1 body statements first variableBinding. self deny: variable2 variableBinding = variable1 variableBinding. self assert: variable2 variableBinding = block2 body statements first variableBinding. self assert: variable1 variableBinding scope = block1 lexicalScope. self assert: variable2 variableBinding scope = block2 lexicalScope! ! !RBSemanticTest methodsFor: 'testing' stamp: 'lr 6/4/2010 15:39'! testReadWriter | tree binding | tree := self parseExpression: '| var | ^ var := 1'. binding := tree lexicalScope bindingOf: 'var'. self assert: binding node = tree temporaries first. self assert: binding accessors size = 1. self assert: binding accessors first = tree statements first value variable. self assert: binding readers size = 1. self assert: binding readers first = tree statements first value variable. self assert: binding writers size = 1. self assert: binding writers first = tree statements first value variable.! ! !RBSemanticTest methodsFor: 'testing' stamp: 'lr 6/4/2010 15:40'! testReader | tree binding | tree := self parseExpression: '| var | ^ var'. binding := tree lexicalScope bindingOf: 'var'. self assert: binding node = tree temporaries first. self assert: binding accessors size = 1. self assert: binding accessors first = tree statements first value. self assert: binding readers size = 1. self assert: binding readers first = tree statements first value. self assert: binding writers isEmpty! ! !RBSemanticTest methodsFor: 'testing-scopes' stamp: 'lr 5/11/2010 19:20'! testRootScope | scope | scope := RBRootScope new. self deny: scope isBlockScope. self deny: scope isLiteralScope. self deny: scope isMethodScope. self assert: scope isRootScope. self deny: scope isVariableScope. self assert: (scope lookup: 'self') isSelfBinding. self assert: (scope lookup: 'self') scope = scope. self assert: (scope lookup: 'super') isSuperBinding. self assert: (scope lookup: 'super') scope = scope. self assert: (scope lookup: 'thisContext') isContextBinding. self assert: (scope lookup: 'thisContext') scope = scope. self should: [ scope lookup: 'something' ] raise: Error. self assert: (scope lookup: 'something' ifAbsent: [ #nothing ]) = #nothing ! ! !RBSemanticTest methodsFor: 'testing-fixtures' stamp: 'lr 6/7/2010 15:14'! testShadowedVariables | tree variable1 variable2 variable3 variable4 | tree := self parseExpression: '| a | [ :a | a ]. a'. variable1 := tree temporaries first. variable2 := tree statements first arguments first. variable3 := tree statements first body statements first. variable4 := tree statements last. self deny: variable1 variableBinding isShadowing. self assert: variable2 variableBinding isShadowing. self assert: variable3 variableBinding isShadowing. self deny: variable4 variableBinding isShadowing. self assert: variable1 variableBinding = variable4 variableBinding. self deny: variable1 variableBinding = variable3 variableBinding. self deny: variable2 variableBinding = variable4 variableBinding. self assert: variable2 variableBinding = variable3 variableBinding. ! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testSpecialContextBinding | tree binding | tree := self parseExpression: 'thisContext'. binding := tree variableBinding. self deny: binding isArgumentBinding. self assert: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self assert: binding isReadonly. self assert: binding name = 'thisContext'. self assert: binding printString isString. self deny: binding scope isNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testSpecialSelfBinding | tree binding | tree := self parseExpression: 'self'. binding := tree variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self assert: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self assert: binding isReadonly. self assert: binding name = 'self'. self assert: binding printString isString. self deny: binding scope isNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testSpecialSuperBinding | tree binding | tree := self parseExpression: 'super'. binding := tree variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self assert: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self assert: binding isReadonly. self assert: binding name = 'super'. self assert: binding printString isString. self deny: binding scope isNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testUndeclaredBinding | tree binding | tree := self parseExpression: '[ undecl ]'. binding := tree body statements first variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self deny: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self assert: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'undecl'. self assert: binding printString isString. self assert: binding node = tree body statements first. self assert: binding scope notNil! ! !RBSemanticTest methodsFor: 'testing-bindings' stamp: 'lr 9/10/2010 13:24'! testUndeclaredHandled | seen tree binding | seen := false. tree := [ self parseExpression: '[ undecl ]' ] on: RBUndeclaredVariableNotification do: [ :err | seen := true. err resume: (RBLiteralBinding binding: (err node name -> 123)) ]. self assert: seen. binding := tree body statements first variableBinding. self deny: binding isArgumentBinding. self deny: binding isContextBinding. self deny: binding isInstanceBinding. self assert: binding isLiteralBinding. self deny: binding isSelfBinding. self deny: binding isSuperBinding. self deny: binding isTemporaryBinding. self deny: binding isUndeclaredBinding. self assert: binding isAccessed. self deny: binding accessors isEmpty. self deny: binding isRead. self assert: binding readers isEmpty. self deny: binding isWritten. self assert: binding writers isEmpty. self deny: binding isReadonly. self assert: binding name = 'undecl'. self assert: binding printString isString. self assert: binding binding key = 'undecl'. self assert: binding binding value = 123. self assert: binding scope notNil! ! !RBSemanticTest methodsFor: 'testing-scopes' stamp: 'lr 6/7/2010 15:00'! testVariableScope | scope | scope := RBVariableScope owner: RBRootScope new class: RBMessageNode. self deny: scope isBlockScope. self deny: scope isLiteralScope. self deny: scope isMethodScope. self deny: scope isRootScope. self assert: scope isVariableScope. self assert: scope theClass = RBMessageNode. RBMessageNode allInstVarNames keysAndValuesDo: [ :index :name | self assert: (scope lookup: name) isInstanceBinding. self assert: (scope lookup: name) scope = scope. self assert: (scope lookup: name) name = name. self assert: (scope lookup: name) index = index ]. self assert: (scope lookup: 'self') scope = scope owner. self assert: (scope lookup: 'super') scope = scope owner. self assert: (scope lookup: 'thisContext') scope = scope owner. self should: [ scope lookup: 'something' ] raise: Error. self assert: (scope lookup: 'something' ifAbsent: [ #nothing ]) = #nothing ! ! !RBSemanticTest methodsFor: 'testing' stamp: 'lr 6/4/2010 15:40'! testWriter | tree binding | tree := self parseExpression: '| var | var := 1'. binding := tree lexicalScope bindingOf: 'var'. self assert: binding node = tree temporaries first. self assert: binding accessors size = 1. self assert: binding accessors first = tree statements first variable. self assert: binding readers isEmpty. self assert: binding writers size = 1. self assert: binding writers first = tree statements first variable! !