SystemOrganization addCategory: #'Roe-Attributes'! SystemOrganization addCategory: #'Roe-Conditions'! SystemOrganization addCategory: #'Roe-Mapping'! SystemOrganization addCategory: #'Roe-Relations-Concrete'! SystemOrganization addCategory: #'Roe-Relations-Core'! SystemOrganization addCategory: #'Roe-Relations-Indexed'! SystemOrganization addCategory: #'Roe-Tests'! SystemOrganization addCategory: #'Roe-Tuples'! SystemOrganization addCategory: #'Roe-Visitors'! !Object methodsFor: '*Roe' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitObject: self! ! Object subclass: #RAAttribute instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Attributes'! RAAttribute subclass: #RAAliasedAttribute instanceVariableNames: 'source name' classVariableNames: '' poolDictionaries: '' category: 'Roe-Attributes'! !RAAliasedAttribute class methodsFor: 'instance creation' stamp: 'ab 3/22/2003 11:23'! attribute: anAttribute name: aString ^ self new setAttribute: anAttribute name: aString! ! !RAAliasedAttribute methodsFor: 'accessing' stamp: 'avi 1/26/2004 02:06'! name ^name! ! !RAAliasedAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:58'! originalAttribute ^ source originalAttribute! ! !RAAliasedAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:58'! originalRelation ^ source originalRelation! ! !RAAliasedAttribute methodsFor: 'as yet unclassified' stamp: 'dao 3/22/2004 10:52'! resolveAttributeIn: aCollection (aCollection includes: self) ifTrue: [^ self]. RAAttribute errorCouldNotResolveAttribute! ! !RAAliasedAttribute methodsFor: 'private' stamp: 'ab 3/23/2003 20:34'! setAttribute: anAttribute name: aString source _ anAttribute. name _ aString.! ! !RAAliasedAttribute methodsFor: 'accessing' stamp: 'ab 3/23/2003 20:34'! source ^ source! ! !RAAttribute methodsFor: 'accessing' stamp: 'avi 1/26/2004 02:06'! name self subclassResponsibility! ! !RAAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:55'! originalAttribute self subclassResponsibility ! ! !RAAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:55'! originalRelation self subclassResponsibility ! ! !RAAttribute methodsFor: 'printing' stamp: 'avi 1/27/2004 03:07'! printOn: aStream super printOn: aStream. aStream nextPutAll: '(', self name, ')'.! ! !RAAttribute methodsFor: 'resolving' stamp: 'avi 1/26/2004 02:06'! resolveAttributeIn: aCollection self subclassResponsibility ! ! RAAttribute subclass: #RAClonedAttribute instanceVariableNames: 'source' classVariableNames: '' poolDictionaries: '' category: 'Roe-Attributes'! !RAClonedAttribute class methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:08'! attribute: anAttribute ^ self new setAttribute: anAttribute! ! !RAClonedAttribute methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:10'! name ^ source name! ! !RAClonedAttribute methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:07'! originalAttribute ^ source originalAttribute! ! !RAClonedAttribute methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:07'! originalRelation ^ source originalRelation! ! !RAClonedAttribute methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:11'! resolveAttributeIn: aCollection (aCollection includes: self) ifTrue: [^ self]. RAAttribute errorCouldNotResolveAttribute! ! !RAClonedAttribute methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:07'! setAttribute: anAttribute source _ anAttribute! ! RAAttribute subclass: #RASimpleAttribute instanceVariableNames: 'relation name' classVariableNames: '' poolDictionaries: '' category: 'Roe-Attributes'! !RASimpleAttribute class methodsFor: 'instance creation' stamp: 'ab 3/27/2003 17:59'! named: aString relation: aRelation ^ self new setName: aString relation: aRelation! ! !RASimpleAttribute methodsFor: 'accessing' stamp: 'avi 1/26/2004 02:06'! name ^name! ! !RASimpleAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:55'! originalAttribute ^ self! ! !RASimpleAttribute methodsFor: 'accessing' stamp: 'ab 3/27/2003 17:55'! originalRelation ^ relation! ! !RASimpleAttribute methodsFor: 'resolving' stamp: 'avi 1/25/2004 14:31'! resolveAttributeIn: aCollection (aCollection includes: self) ifTrue: [^ self]. RAAttribute errorCouldNotResolveAttribute! ! !RASimpleAttribute methodsFor: 'private' stamp: 'ab 3/27/2003 17:59'! setName: aString relation: aRelation name _ aString. relation _ aRelation! ! Object subclass: #RAConditionNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Conditions'! RAConditionNode subclass: #RAAttributeNode instanceVariableNames: 'attribute' classVariableNames: '' poolDictionaries: '' category: 'Roe-Conditions'! !RAAttributeNode methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitAttributeNode: self! ! !RAAttributeNode methodsFor: 'private' stamp: 'avi 1/26/2004 03:50'! attribute ^ attribute! ! !RAAttributeNode methodsFor: 'private' stamp: 'ab 3/22/2003 16:39'! attribute: anAttribute attribute _ anAttribute! ! !RAAttributeNode methodsFor: 'accessing' stamp: 'ab 3/22/2003 16:40'! name ^ attribute name! ! RAConditionNode subclass: #RABinaryNode instanceVariableNames: 'left right operator' classVariableNames: '' poolDictionaries: '' category: 'Roe-Conditions'! !RABinaryNode class methodsFor: 'as yet unclassified' stamp: 'ab 3/22/2003 16:43'! left: leftNode right: rightNode operator: aSymbol ^ self new setLeft: leftNode right: rightNode operator: aSymbol! ! !RABinaryNode methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitBinaryNode: self! ! !RABinaryNode methodsFor: 'accessing' stamp: 'ab 3/22/2003 16:42'! left ^ left! ! !RABinaryNode methodsFor: 'accessing' stamp: 'ab 3/22/2003 16:43'! operator ^ operator! ! !RABinaryNode methodsFor: 'accessing' stamp: 'ab 3/22/2003 16:42'! right ^ right! ! !RABinaryNode methodsFor: 'private' stamp: 'ab 3/22/2003 16:43'! setLeft: aNode right: otherNode operator: aSymbol left _ aNode. right _ otherNode. operator _ aSymbol! ! !RABinaryNode methodsFor: 'accessing' stamp: 'avi 4/6/2004 16:04'! sqlOperator (operator = #&) ifTrue: [^' AND ']. (operator = #|) ifTrue: [^' OR ']. (operator = #~=) ifTrue: [^' !!= ']. (operator = #like) ifTrue: [^' LIKE ']. (operator = #ilike) ifTrue: [^' ILIKE ']. ^operator ! ! !RAConditionNode methodsFor: 'logical' stamp: 'ab 3/22/2003 17:42'! & other ^ RABinaryNode left: self right: other operator: #&! ! !RAConditionNode methodsFor: 'arithmetic' stamp: 'ab 3/22/2003 16:44'! * other ^ RABinaryNode left: self right: other operator: #*! ! !RAConditionNode methodsFor: 'arithmetic' stamp: 'ab 3/22/2003 16:45'! + other ^ RABinaryNode left: self right: other operator: #+! ! !RAConditionNode methodsFor: 'arithmetic' stamp: 'ab 3/22/2003 16:45'! - other ^ RABinaryNode left: self right: other operator: #-! ! !RAConditionNode methodsFor: 'arithmetic' stamp: 'ab 3/22/2003 16:45'! / other ^ RABinaryNode left: self right: other operator: #/! ! !RAConditionNode methodsFor: 'comparing' stamp: 'ab 3/22/2003 16:45'! < other ^ RABinaryNode left: self right: other operator: # other ^ RABinaryNode left: self right: other operator: #>! ! !RAConditionNode methodsFor: 'comparing' stamp: 'ab 3/22/2003 16:45'! >= other ^ RABinaryNode left: self right: other operator: #>=! ! !RAConditionNode methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor self subclassResponsibility! ! !RAConditionNode methodsFor: 'converting' stamp: 'avi 1/27/2004 02:43'! asString ^ self! ! !RAConditionNode methodsFor: 'comparing' stamp: 'lr 8/19/2003 09:16'! like: aString ^self like: aString ignoreCase: false! ! !RAConditionNode methodsFor: 'comparing' stamp: 'lr 8/19/2003 09:16'! like: aString ignoreCase: aBoolean ^aBoolean ifFalse: [ RABinaryNode left: self right: aString operator: #like ] ifTrue: [ RABinaryNode left: self right: aString operator: #ilike ]! ! !RAConditionNode methodsFor: 'logical' stamp: 'ab 3/22/2003 17:42'! | other ^ RABinaryNode left: self right: other operator: #|! ! !RAConditionNode methodsFor: 'comparing' stamp: 'ab 3/23/2003 14:37'! ~= other ^ RABinaryNode left: self right: other operator: #~=! ! Object subclass: #RAMockObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! RAMockObject subclass: #RAMockCourse instanceVariableNames: 'title' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RAMockCourse methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:06'! initializeWithValues: aDictionary title _ aDictionary at: 'title'! ! !RAMockObject class methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:06'! fromValues: aDictionary ^ self new initializeWithValues: aDictionary! ! RAMockObject subclass: #RAMockStudent instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RAMockStudent methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:07'! initializeWithValues: aDictionary name _ aDictionary at: 'name'! ! Object subclass: #RATuple instanceVariableNames: 'relation' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tuples'! RATuple subclass: #RASelectTuple instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tuples'! !RASelectTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:18'! valueForAttribute: anAttribute ^ RAAttributeNode new attribute: anAttribute! ! RATuple subclass: #RASimpleTuple instanceVariableNames: 'values' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tuples'! RASimpleTuple subclass: #RABoxedTuple instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tuples'! !RABoxedTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:16'! isMutable ^ true! ! !RABoxedTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:06'! takeValue: anObject forAttribute: anAttribute (values at: (relation attributes indexOf: anAttribute)) at: 1 put: anObject! ! !RABoxedTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 16:55'! valueForAttribute: anAttribute ^ (super valueForAttribute: anAttribute) first! ! !RASimpleTuple class methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 14:14'! relation: aRelation values: anArray ^ self basicNew initializeWithRelation: aRelation values: anArray! ! !RASimpleTuple methodsFor: 'as yet unclassified' stamp: 'rbb 3/24/2005 11:19'! = anObject ^ self values = anObject values! ! !RASimpleTuple methodsFor: 'as yet unclassified' stamp: 'rbb 3/24/2005 11:19'! hash ^ self values hash! ! !RASimpleTuple methodsFor: 'initializing' stamp: 'avi 9/28/2003 15:16'! initializeWithRelation: aRelation self initializeWithRelation: aRelation values: (Array new: aRelation attributes size)! ! !RASimpleTuple methodsFor: 'initializing' stamp: 'avi 9/28/2003 15:15'! initializeWithRelation: aRelation values: anArray super initializeWithRelation: aRelation. values _ anArray! ! !RASimpleTuple methodsFor: 'accessing' stamp: 'avi 9/28/2003 15:04'! valueForAttribute: anAttribute ^ values at: (relation attributes indexOf: anAttribute) ! ! !RASimpleTuple methodsFor: 'accessing' stamp: 'avi 9/28/2003 14:15'! values ^ values! ! !RATuple class methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:15'! relation: aRelation ^ self basicNew initializeWithRelation: aRelation! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 1/25/2004 17:03'! at: anObject ^ self valueForAttribute: (anObject resolveAttributeIn: relation attributes)! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'dao 3/30/2004 16:21'! doesNotUnderstand: aMessage | selector | selector _ aMessage selector. (selector numArgs = 0 and: [self hasAttributeNamed: selector asString]) ifTrue: [^ self valueForAttributeNamed: selector]. ((selector numArgs = 1 and: [self hasAttributeNamed: selector allButLast]) and: [self isMutable]) ifTrue: [^ self takeValue: aMessage argument forAttributeNamed: selector allButLast]. ^ super doesNotUnderstand: aMessage! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:33'! hasAttributeNamed: aString ^ relation attributes anySatisfy: [:ea | ea name = aString]! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:15'! initializeWithRelation: aRelation relation _ aRelation! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:16'! isMutable ^ false! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:17'! name ^ self valueForAttributeNamed: #name ifAbsent: [super name]! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:17'! takeValue: anObject forAttribute: anAttribute self isMutable ifTrue: [self subclassResponsibility] ifFalse: [self shouldNotImplement]! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:34'! takeValue: anObject forAttributeNamed: aString self takeValue: anObject forAttribute: (relation attributeNamed: aString)! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:17'! valueForAttribute: anAttribute ^ self subclassResponsibility ! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:17'! valueForAttributeNamed: aString ^ self valueForAttribute: (relation attributeNamed: aString)! ! !RATuple methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:17'! valueForAttributeNamed: aString ifAbsent: errorBlock ^ self valueForAttribute: (relation attributeNamed: aString ifAbsent: [^ errorBlock value])! ! RATuple subclass: #RAUpdateTuple instanceVariableNames: 'nodes' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tuples'! !RAUpdateTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:21'! isMutable ^ true! ! !RAUpdateTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:21'! nodes ^ nodes ifNil: [nodes _ Dictionary new]! ! !RAUpdateTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:21'! takeValue: anObject forAttribute: anAttribute self nodes at: anAttribute put: anObject! ! !RAUpdateTuple methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 17:20'! valueForAttribute: anAttribute ^ RAAttributeNode new attribute: anAttribute! ! Object subclass: #RAVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! RAVisitor subclass: #RAEvaluator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! !RAEvaluator class methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 21:01'! evaluate: aRelation ^ self new visit: aRelation! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 17:06'! visitCartesianProduct: aRelation | right left | right _ self visit: aRelation right. left _ self visit: aRelation left. ^ (Array streamContents: [:s | left do: [:l | right do: [:r | s nextPut: l, r]]]). ! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:14'! visitClone: aClone ^ self visitTransformation: aClone! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'lr 7/25/2003 19:43'! visitDifference: aRelation | right | right _ self visit: aRelation right. ^Array streamContents: [:stream | (self visit: aRelation left) do: [:row | (right includes: row) ifFalse: [stream nextPut: row]]]! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'lr 7/25/2003 19:50'! visitDistinct: aRelation ^(self visit: aRelation source) asSet asArray! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'lr 7/11/2003 16:49'! visitIntersection: aRelation ^(self visit: aRelation left) intersection: (self visit: aRelation right)! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'lr 7/14/2003 09:59'! visitInterval: aRelation ^(self visitTransformation: aRelation) copyFrom: aRelation start to: aRelation stop! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 16:54'! visitOrder: aRelation | result ascending order pos block | result _ self visitTransformation: aRelation. aRelation order size to: 1 by: -1 do: [ :index | ascending _ aRelation ascending at: index. order _ aRelation order at: index. pos _ aRelation attributes indexOf: order. block _ [ :x :y | ascending ifTrue: [ (x at: pos) first < (y at: pos) first] ifFalse: [ (x at: pos) first > (y at: pos) first] ]. result _ result sortBy: block ]. ^result! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 20:24'! visitProjection: aRelation |projectedAttributes sourceAttributes| projectedAttributes _ aRelation attributes. sourceAttributes _ aRelation source attributes. ^ (self visitTransformation: aRelation) collect: [:tuple | Array streamContents: [:s | tuple with: sourceAttributes do: [:val :attr | (projectedAttributes includes: attr) ifTrue: [s nextPut: val]]]]! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 17:03'! visitRelation: aRelation ^ aRelation tuples! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 16:54'! visitSelection: aRelation | arrays tuples | arrays _ self visitTransformation: aRelation. tuples _ arrays collect: [:ea | RABoxedTuple relation: aRelation values: ea]. tuples _ tuples select: [:ea | aRelation evaluateTuple: ea]. ^ tuples collect: [:ea | ea values]! ! !RAEvaluator methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 22:02'! visitUnion: aRelation ^ (self visit: aRelation left) , (self visit: aRelation right)! ! RAVisitor subclass: #RAPrinter instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! RAPrinter subclass: #RAAlgebraicPrinter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/7/2003 17:53'! visitAlias: aRelation | sourceAttributes attributes | stream nextPutAll: 'R['. sourceAttributes _ aRelation source attributes. attributes _ aRelation attributes. sourceAttributes with: attributes do: [:old :new | old = new ifFalse: [stream nextPutAll: old name; nextPutAll: '->'; nextPutAll: new name; nextPutAll: ',']]. (stream contents endsWith: ',') ifTrue: [stream skip: -1]. stream nextPutAll: ']'. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 17:01'! visitCartesianProduct: aRelation self visit: aRelation left. stream nextPutAll: ' X '. self visit: aRelation right.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/11/2003 16:48'! visitDifference: aRelation self visit: aRelation left. stream nextPutAll: ' \ '. self visit: aRelation right! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/25/2003 19:49'! visitDistinct: aRelation stream nextPut: ${. self visit: aRelation source. stream nextPut: $}.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/7/2003 17:27'! visitGroup: aRelation stream nextPutAll: 'G['. aRelation group do: [ :each | stream nextPutAll: each name ] separatedBy: [ stream nextPut: $, ]. stream nextPut: $]. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/11/2003 16:49'! visitIntersection: aRelation self visit: aRelation left. stream nextPutAll: ' n '. self visit: aRelation right! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/14/2003 09:59'! visitInterval: aRelation stream nextPutAll: 'I['. stream print: aRelation start. stream nextPut: $,. stream print: aRelation stop. stream nextPut: $]. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/7/2003 17:57'! visitOrder: aRelation stream nextPutAll: 'O['. (1 to: aRelation order size) do: [ :index | stream nextPutAll: (aRelation order at: index) name. (aRelation ascending at: index) ifTrue: [ stream nextPutAll: '->asc' ] ifFalse: [ stream nextPutAll: '->desc' ] ] separatedBy: [ stream nextPut: $, ]. stream nextPut: $]. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/7/2003 17:28'! visitProjection: aRelation stream nextPutAll: 'P['. aRelation attributes do: [ :each | stream nextPutAll: each name ] separatedBy: [ stream nextPut: $, ]. stream nextPutAll: ']'. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'avi 1/25/2004 00:52'! visitRelation: aRelation stream nextPutAll: aRelation name! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 20:23'! visitSelection: aRelation stream nextPutAll: 'S['. self visitConditionNodesFor: aRelation. stream nextPut: $]. self visitTransformation: aRelation.! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 20:16'! visitTransformation: aRelation stream nextPut: $(. super visitTransformation: aRelation. stream nextPut: $).! ! !RAAlgebraicPrinter methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 08:39'! visitUnion: aRelation self visit: aRelation left. stream nextPutAll: ' u '. self visit: aRelation right.! ! !RAPrinter class methodsFor: 'as yet unclassified' stamp: 'ab 3/22/2003 13:04'! on: aStream ^ self new stream: aStream! ! !RAPrinter class methodsFor: 'as yet unclassified' stamp: 'ab 3/23/2003 17:02'! print: aRelation ^ String streamContents: [:s | (self on: s) visit: aRelation]! ! !RAPrinter methodsFor: 'printing' stamp: 'dao 3/30/2004 16:06'! printOperator: aNode stream nextPutAll: aNode operator! ! !RAPrinter methodsFor: 'accessing' stamp: 'ab 3/22/2003 13:05'! stream: aStream stream _ aStream! ! !RAPrinter methodsFor: 'accessing' stamp: 'avi 9/28/2003 15:31'! tupleFor: aRelation ^ RASelectTuple relation: aRelation! ! !RAPrinter methodsFor: 'visiting' stamp: 'ab 3/22/2003 16:50'! visitAttributeNode: aNode stream nextPutAll: aNode name! ! !RAPrinter methodsFor: 'visiting' stamp: 'dao 3/30/2004 16:05'! visitBinaryNode: aNode stream nextPut: $(. self visit: aNode left. self printOperator: aNode. self visit: aNode right. stream nextPut: $).! ! !RAPrinter methodsFor: 'visiting' stamp: 'avi 9/28/2003 15:13'! visitConditionNodesFor: aRelation self visit: (aRelation evaluateTuple: (self tupleFor: aRelation))! ! !RAPrinter methodsFor: 'visiting' stamp: 'ab 3/22/2003 17:42'! visitObject: anObject anObject printOn: stream! ! !RAPrinter methodsFor: 'visiting' stamp: 'ab 3/22/2003 17:55'! visitRelation: aRelation aRelation printOn: stream! ! RAPrinter subclass: #RASingleTableSqlPrinter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 01:01'! errorInvalidOperation self error: 'Invalid operation on this relation'! ! !RASingleTableSqlPrinter methodsFor: 'private' stamp: 'dao 3/30/2004 16:06'! printOperator: aNode stream nextPutAll: aNode sqlOperator! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:57'! visitAlias: aRelation self visit: aRelation source! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 01:23'! visitAttributeNode: aNode stream nextPutAll: '"', aNode attribute originalAttribute name, '"'! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitCartesianProduct: aRelation self errorInvalidOperation! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitDifference: aRelation self errorInvalidOperation ! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitDistinct: aRelation self errorInvalidOperation ! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitGroup: aRelation self errorInvalidOperation ! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitIntersection: aRelation self errorInvalidOperation ! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:58'! visitInterval: aRelation self errorInvalidOperation ! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:56'! visitObject: anObject ^super visitObject: (self isString ifTrue: [ anObject asEscapedSql ] ifFalse: [ anObject ])! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:59'! visitOrder: aRelation self visit: aRelation source! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:59'! visitProjection: aRelation self visit: aRelation source! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 01:15'! visitRelation: aRelation stream nextPutAll: ' 1=1'! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 01:00'! visitSelection: aRelation self visit: aRelation source. stream nextPutAll: ' AND ( '. self visitConditionNodesFor: aRelation. stream nextPutAll: ')'.! ! !RASingleTableSqlPrinter methodsFor: 'visiting' stamp: 'avi 3/29/2004 00:59'! visitUnion: aRelation self errorInvalidOperation ! ! RAPrinter subclass: #RASqlPrinter instanceVariableNames: 'tableCounter columnCounter columnMap' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! !RASqlPrinter methodsFor: 'private' stamp: 'avi 1/27/2004 02:45'! attributeNames: aCollection ^String streamContents: [ :s | aCollection do: [ :each | s nextPutAll: (self columnNameForAttribute: each) ] separatedBy: [ s nextPutAll: ', ' ] ]! ! !RASqlPrinter methodsFor: 'private' stamp: 'avi 1/27/2004 03:09'! attributeNames: aCollection aliasedAs: aliasCollection ^ String streamContents: [:s | aCollection with: aliasCollection do: [:attr :alias | s nextPutAll: (self columnNameForAttribute: attr); nextPutAll: ' AS '; nextPutAll: (self columnNameForAttribute: alias); nextPutAll: ', ']. s skip: -2]! ! !RASqlPrinter methodsFor: 'private' stamp: 'avi 1/26/2004 02:59'! columnNameForAttribute: anAttribute columnMap ifNil: [columnMap _ Dictionary new]. ^ columnMap at: anAttribute ifAbsentPut: [self nextColumnName]! ! !RASqlPrinter methodsFor: 'accessing' stamp: 'avi 1/26/2004 03:02'! nextColumnName columnCounter _ (columnCounter ifNil: [1] ifNotNil: [columnCounter + 1]). ^ 'c', columnCounter asString! ! !RASqlPrinter methodsFor: 'accessing' stamp: 'ab 3/23/2003 20:33'! nextTableName tableCounter _ (tableCounter ifNil: [1] ifNotNil: [tableCounter + 1]). ^ 't', tableCounter asString! ! !RASqlPrinter methodsFor: 'private' stamp: 'dao 3/30/2004 16:06'! printOperator: aNode stream nextPutAll: aNode sqlOperator! ! !RASqlPrinter methodsFor: 'private' stamp: 'ab 3/23/2003 17:09'! select: aString fromRelation: aRelation stream nextPutAll: 'SELECT '; nextPutAll: aString; nextPutAll: ' FROM '. self subselectRelation: aRelation.! ! !RASqlPrinter methodsFor: 'private' stamp: 'ab 3/23/2003 17:09'! selectAllFromRelation: aRelation self select: '*' fromRelation: aRelation! ! !RASqlPrinter methodsFor: 'private' stamp: 'ab 3/23/2003 20:32'! subselectRelation: aRelation stream nextPut: $(. self visit: aRelation. stream nextPutAll: ') AS '; nextPutAll: self nextTableName.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:12'! visitAlias: aRelation self select: (self attributeNames: aRelation source attributes aliasedAs: aRelation attributes) fromRelation: aRelation source.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'avi 1/27/2004 02:44'! visitAttributeNode: aNode stream nextPutAll: (self columnNameForAttribute: aNode attribute)! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:14'! visitCartesianProduct: aRelation stream nextPutAll: 'SELECT * FROM '. self subselectRelation: aRelation left. stream nextPutAll: ', '. self subselectRelation: aRelation right.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'avi 1/26/2004 03:45'! visitClone: aRelation self visitAlias: aRelation! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:48'! visitDifference: aRelation stream nextPutAll: '('. self visit: aRelation left. stream nextPutAll: ') EXCEPT ('. self visit: aRelation right. stream nextPutAll: ')'! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/25/2003 19:42'! visitDistinct: aRelation stream nextPutAll: 'SELECT DISTINCT * FROM '. self subselectRelation: aRelation source.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/7/2003 17:40'! visitGroup: aRelation stream nextPutAll: 'SELECT * FROM '. self subselectRelation: aRelation source. stream nextPutAll: ' GROUP BY '. stream nextPutAll: (self attributeNames: aRelation group).! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:49'! visitIntersection: aRelation stream nextPutAll: '('. self visit: aRelation left. stream nextPutAll: ') INTERSECT ('. self visit: aRelation right. stream nextPutAll: ')'! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/14/2003 09:45'! visitInterval: aRelation stream nextPutAll: 'SELECT * FROM '. self subselectRelation: aRelation source. stream nextPutAll: ' LIMIT '; print: aRelation limit. stream nextPutAll: ' OFFSET '; print: aRelation offset.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/14/2003 11:41'! visitObject: anObject ^super visitObject: (self isString ifTrue: [ anObject asEscapedSql ] ifFalse: [ anObject ])! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'avi 1/27/2004 02:46'! visitOrder: aRelation stream nextPutAll: 'SELECT * FROM '. self subselectRelation: aRelation source. stream nextPutAll: ' ORDER BY '. (1 to: aRelation order size) do: [ :index | stream nextPutAll: (self columnNameForAttribute: (aRelation order at: index)). (aRelation ascending at: index) ifTrue: [ stream nextPutAll: ' ASC' ] ifFalse: [ stream nextPutAll: ' DESC' ] ] separatedBy: [ stream nextPutAll: ', ' ]! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:14'! visitProjection: aRelation self select: (self attributeNames: aRelation attributes) fromRelation: aRelation source! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'avi 1/27/2004 02:46'! visitRelation: aRelation stream nextPutAll: 'SELECT '. aRelation attributes do: [:attr | stream nextPutAll: '"', attr name; nextPutAll: '" AS '; nextPutAll: (self columnNameForAttribute: attr); nextPutAll: ', ']. stream skip: -2. stream nextPutAll: ' FROM ', aRelation name! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:01'! visitSelection: aRelation self selectAllFromRelation: aRelation source. stream nextPutAll: ' WHERE '. self visitConditionNodesFor: aRelation.! ! !RASqlPrinter methodsFor: 'visiting' stamp: 'lr 7/10/2003 09:03'! visitUnion: aRelation stream nextPutAll: '('. self visit: aRelation left. stream nextPutAll: ') UNION ('. self visit: aRelation right. stream nextPutAll: ')'.! ! RAPrinter subclass: #RASqlUpdatePrinter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Visitors'! !RASqlUpdatePrinter methodsFor: 'as yet unclassified' stamp: 'avi 1/27/2004 03:18'! visitAttributeNode: aNode stream nextPutAll: '"', (aNode attribute originalAttribute name), '"'! ! !RASqlUpdatePrinter methodsFor: 'as yet unclassified' stamp: 'avi 1/27/2004 02:49'! visitObject: anObject ^super visitObject: (self isString ifTrue: [ anObject asEscapedSql ] ifFalse: [ anObject ])! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:03'! visit: anObject ^ anObject acceptRoeVisitor: self! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:16'! visitAlias: aRelation ^ self visitTransformation: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/22/2003 12:04'! visitCartesianProduct: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'avi 1/26/2004 02:09'! visitClone: aClone! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:48'! visitDifference: aRelation ! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/25/2003 19:41'! visitDistinct: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/7/2003 16:55'! visitGroup: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:49'! visitIntersection: aRelation ! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/14/2003 09:42'! visitInterval: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/10/2003 08:35'! visitOrder: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:25'! visitProjection: aRelation ! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/22/2003 12:13'! visitRelation: aRelation! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:24'! visitSelection: aRelation ! ! !RAVisitor methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:16'! visitTransformation: aRelation ^ self visit: aRelation source! ! !RAVisitor methodsFor: 'visiting' stamp: 'lr 7/10/2003 08:35'! visitUnion: aRelation! ! !ByteString methodsFor: '*Roe' stamp: 'lr 7/14/2003 11:34'! asEscapedSql ^String streamContents: [ :stream | self do: [ :char | (#($' $\) includes: char) ifTrue: [ stream nextPut: char ]. stream nextPut: char ] ]! ! !ByteString methodsFor: '*Roe' stamp: 'avi 4/6/2004 19:02'! resolveAttributeIn: aCollection ^ aCollection detect: [:ea | ea name asString asUppercase = self asString asUppercase] ifNone: [self errorCouldNotResolveAttribute]! ! Collection subclass: #RAMappedCollection instanceVariableNames: 'relation' classVariableNames: '' poolDictionaries: '' category: 'Roe-Mapping'! !RAMappedCollection class methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:04'! on: aRelation ^ self new initializeWithRelation: aRelation! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:04'! do: aBlock relation do: [:tuple | aBlock value: (self objectsForTuple: tuple)]! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:04'! initializeWithRelation: aRelation relation _ aRelation! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:05'! objectForTuple: anArray relation: aRelation attributes: attributeCollection ^ aRelation objectForValues: (self valuesForTuple: anArray attributes: attributeCollection)! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:05'! objectsForTuple: anArray ^ relation attributesGroupedByOriginalRelation collect: [:relationToAttributes | self objectForTuple: anArray relation: relationToAttributes key attributes: relationToAttributes value]! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:05'! valueForAttribute: anAttribute fromTuple: anArray ^ anArray at: (relation attributes indexOf: anAttribute)! ! !RAMappedCollection methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:10'! valuesForTuple: aTuple attributes: attributeCollection ^ Dictionary withAll: (attributeCollection collect: [:attr | attr -> (aTuple valueForAttribute: attr)])! ! RAMappedCollection subclass: #RASingleMappedCollection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Mapping'! !RASingleMappedCollection methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:08'! do: aBlock super do: [:ea | aBlock value: ea first]! ! Collection subclass: #RARelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! RARelation subclass: #RABinaryTransformation instanceVariableNames: 'left right' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RABinaryTransformation class methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 08:33'! of: leftRelation with: rightRelation ^self new setLeftRelation: leftRelation rightRelation: rightRelation! ! !RABinaryTransformation methodsFor: 'accessing' stamp: 'lr 7/10/2003 21:35'! attributesGroupedByOriginalRelation ^ left attributesGroupedByOriginalRelation, right attributesGroupedByOriginalRelation! ! !RABinaryTransformation methodsFor: 'private' stamp: 'avi 9/28/2003 15:41'! concreteRelation ^ left concreteRelation! ! !RABinaryTransformation methodsFor: 'accessing' stamp: 'lr 7/10/2003 08:28'! left ^left! ! !RABinaryTransformation methodsFor: 'printing' stamp: 'lr 7/10/2003 08:25'! printOn: aStream (RAAlgebraicPrinter on: aStream) visit: self! ! !RABinaryTransformation methodsFor: 'accessing' stamp: 'lr 7/10/2003 08:25'! right ^right! ! !RABinaryTransformation methodsFor: 'initialization' stamp: 'lr 7/10/2003 08:30'! setLeftRelation: leftRelation rightRelation: rightRelation left _ leftRelation. right _ rightRelation.! ! RABinaryTransformation subclass: #RACartesianProduct instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RACartesianProduct methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitCartesianProduct: self! ! !RACartesianProduct methodsFor: 'accessing' stamp: 'ab 3/23/2003 20:14'! attributes ^ left attributes, right attributes! ! RABinaryTransformation subclass: #RADifference instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RADifference methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:48'! acceptRoeVisitor: aVisitor ^aVisitor visitDifference: self! ! !RADifference methodsFor: 'accessing' stamp: 'lr 7/10/2003 08:32'! attributes ^left attributes! ! RABinaryTransformation subclass: #RAIntersection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAIntersection methodsFor: 'visiting' stamp: 'lr 7/11/2003 16:48'! acceptRoeVisitor: aVisitor ^aVisitor visitIntersection: self! ! !RAIntersection methodsFor: 'accessing' stamp: 'lr 7/10/2003 08:37'! attributes ^left attributes! ! RABinaryTransformation subclass: #RAUnion instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAUnion methodsFor: 'visiting' stamp: 'lr 7/10/2003 08:33'! acceptRoeVisitor: aVisitor ^aVisitor visitUnion: self! ! !RAUnion methodsFor: 'accessing' stamp: 'lr 7/10/2003 08:32'! attributes ^left attributes! ! RARelation subclass: #RAConcreteRelation instanceVariableNames: 'name attributes' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Concrete'! RAConcreteRelation subclass: #RAArrayRelation instanceVariableNames: 'tuples' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Concrete'! !RAArrayRelation class methodsFor: 'as yet unclassified' stamp: 'avi 9/29/2003 11:46'! name: aString attributes: anArray ^ self basicNew initializeWithName: aString attributes: anArray! ! !RAArrayRelation methodsFor: 'adding' stamp: 'avi 9/29/2003 16:55'! addValues: anArray tuples add: (anArray collect: [:ea | Array with: ea])! ! !RAArrayRelation methodsFor: 'private' stamp: 'avi 9/29/2003 16:56'! for: aRelation do: aBlock (RAEvaluator evaluate: aRelation) do: [:array | aBlock value: (RASimpleTuple relation: aRelation values: (array collect: [:ea | ea first]))]! ! !RAArrayRelation methodsFor: 'updating' stamp: 'avi 9/30/2003 00:34'! for: aRelation update: aBlock (RAEvaluator evaluate: aRelation) do: [:ea | aBlock value: (RABoxedTuple relation: aRelation values: ea)]! ! !RAArrayRelation methodsFor: 'initializing' stamp: 'avi 9/29/2003 11:47'! initializeWithName: aString self initializeWithName: aString attributes: #()! ! !RAArrayRelation methodsFor: 'initializing' stamp: 'avi 9/29/2003 11:46'! initializeWithName: aString attributes: anArray super initializeWithName: aString. attributes _ anArray collect: [:ea | RASimpleAttribute named: ea relation: self]. tuples _ OrderedCollection new ! ! !RAArrayRelation methodsFor: 'accessing' stamp: 'lr 7/7/2003 20:53'! tuples ^tuples! ! !RAArrayRelation methodsFor: 'updating' stamp: 'avi 9/29/2003 17:03'! update: aBlock tuples do: [:ea | aBlock value: (RABoxedTuple relation: self values: ea)]! ! RAArrayRelation subclass: #RAMockRelation instanceVariableNames: 'objectClass' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RAMockRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:07'! objectClass ^ objectClass! ! !RAMockRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:07'! objectClass: aClass objectClass _ aClass! ! !RAMockRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:07'! objectForValues: aDictionary | values | values _ Dictionary new. aDictionary associationsDo: [:ea | values add: (ea key name -> ea value)]. ^ self objectClass fromValues: values! ! !RAMockRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:07'! printOn: aStream self attributes do: [:ea | aStream nextPutAll: ea name]! ! !RAConcreteRelation class methodsFor: 'instance creation' stamp: 'lr 7/7/2003 20:14'! factory: aFactory name: aString ^self new factory: aFactory; name: aString; yourself! ! !RAConcreteRelation methodsFor: 'adding' stamp: 'avi 4/6/2004 16:22'! addAllValues: anArray anArray do: [ :row | self addValues: row ]! ! !RAConcreteRelation methodsFor: 'adding' stamp: 'avi 9/29/2003 16:20'! addValues: anArray self subclassResponsibility! ! !RAConcreteRelation methodsFor: 'accessing' stamp: 'lr 7/7/2003 20:09'! attributes ^attributes! ! !RAConcreteRelation methodsFor: 'private' stamp: 'avi 9/28/2003 15:42'! concreteRelation ^ self! ! !RAConcreteRelation methodsFor: 'private' stamp: 'avi 9/28/2003 15:42'! for: aRelation do: aBlock self subclassResponsibility ! ! !RAConcreteRelation methodsFor: 'initializing' stamp: 'avi 9/29/2003 11:44'! initializeWithName: aString name _ aString! ! !RAConcreteRelation methodsFor: 'accessing' stamp: 'lr 7/7/2003 20:03'! name ^name! ! !RAConcreteRelation methodsFor: 'printing' stamp: 'avi 9/29/2003 11:44'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self name; nextPut: $)! ! RAConcreteRelation subclass: #RASQLRelation instanceVariableNames: 'connection' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Concrete'! RASQLRelation subclass: #RAPostgresRelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Concrete'! !RAPostgresRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:25'! basicExec: aString | result | result _ connection execute: aString. result errorResponse ifNotNilDo: [:err | self error: err value]. ^ result! ! !RAPostgresRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:25'! basicQuery: aString | result | result _ self basicExec: aString. ^ result resultSets first rows collect: [:ea | ea data]! ! !RAPostgresRelation methodsFor: 'accessing' stamp: 'dao 3/30/2004 17:21'! discoverAttributes ^(self query: self sqlDiscoverAttributes) collect: [ :each | RASimpleAttribute named: each first relation: self ] ! ! !RAPostgresRelation methodsFor: 'accessing' stamp: 'rbb 12/29/2005 13:49'! log ^ false! ! !RAPostgresRelation methodsFor: 'core' stamp: 'rbb 3/17/2005 12:26'! size ^ (self query: self sqlCount) asArray first first! ! !RAPostgresRelation methodsFor: 'private' stamp: 'dao 2/20/2004 16:02'! sqlDiscoverAttributes ^ 'SELECT attname FROM pg_class, pg_attribute WHERE relname = ', self name printString, ' AND attnum > 0 AND attrelid = pg_class.oid AND NOT attisdropped'! ! !RASQLRelation class methodsFor: 'as yet unclassified' stamp: 'dao 3/30/2004 16:51'! name: aString self shouldNotImplement! ! !RASQLRelation class methodsFor: 'as yet unclassified' stamp: 'dao 3/30/2004 16:51'! name: aString connection: aConnection ^ self basicNew initializeWithName: aString connection: aConnection! ! !RASQLRelation methodsFor: 'adding' stamp: 'rbb 3/24/2005 14:34'! addMostValues: anArray self exec: (self sqlInsert: (self attributes allButFirst collect: [:ea | ea name]) values: anArray)! ! !RASQLRelation methodsFor: 'adding' stamp: 'dao 3/30/2004 17:21'! addValues: anArray self exec: (self sqlInsert: (self attributes collect: [:ea | ea name]) values: anArray)! ! !RASQLRelation methodsFor: 'accessing' stamp: 'dao 3/30/2004 16:51'! attributes attributes isNil ifTrue: [ attributes _ self discoverAttributes ]. ^attributes! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:25'! basicExec: aString self subclassResponsibility! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:25'! basicQuery: aString self subclassResponsiblity ! ! !RASQLRelation methodsFor: 'removing' stamp: 'dao 3/30/2004 17:21'! deleteFor: aRelation | conditionString | conditionString _ RASingleTableSqlPrinter print: aRelation. self exec: (self sqlDeleteWhere: conditionString).! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:55'! discoverAttributes self subclassResponsibility ! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:23'! exec: aString ^ self logging: aString do: [self basicExec: aString] ! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 19:05'! for: aRelation do: aBlock (self query: (self sqlPrinterClass print: aRelation)) do: [:ea | aBlock value: (RASimpleTuple relation: aRelation values: ea)].! ! !RASQLRelation methodsFor: 'updating' stamp: 'dao 3/30/2004 17:22'! for: aRelation update: aBlock | tuple conditionString | tuple _ RAUpdateTuple relation: aRelation. aBlock value: tuple. conditionString _ (RASingleTableSqlPrinter print: aRelation). self exec: (self sqlUpdate: tuple nodes where: conditionString).! ! !RASQLRelation methodsFor: 'initializing' stamp: 'dao 3/30/2004 16:51'! initializeWithName: aString connection: aConnection super initializeWithName: aString. connection _ aConnection.! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:51'! log ^ true! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:24'! logging: aString do: aBlock | time val | time _ Time millisecondsToRun: [val _ aBlock value]. self log ifTrue: [Transcript cr; show: aString, ' [', time asString, ']']. ^ val! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 16:23'! query: aString ^ self logging: aString do: [self basicQuery: aString]! ! !RASQLRelation methodsFor: 'core' stamp: 'dao 3/30/2004 16:54'! size self subclassResponsibility ! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:51'! sqlCount ^ 'SELECT COUNT(*) FROM ' , self name! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:51'! sqlDeleteWhere: conditionString ^ String streamContents: [:stream | stream nextPutAll: 'DELETE FROM '; nextPutAll: self name; nextPutAll: ' WHERE '; nextPutAll: conditionString] ! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:51'! sqlInsert: attributeNames values: anArray ^String streamContents: [ :stream | stream nextPutAll: 'INSERT INTO '; nextPutAll: self name; nextPutAll: ' ('. attributeNames do: [ :each | stream nextPut: $"; nextPutAll: each; nextPut: $" ] separatedBy: [ stream nextPutAll: ', ' ]. stream nextPutAll: ') VALUES ('. anArray do: [ :each | each isString ifTrue: [ stream nextPut: $'; nextPutAll: each asEscapedSql; nextPut: $' ] ifFalse: [ stream nextPutAll: each asString printString ] ] separatedBy: [ stream nextPutAll: ', ' ]. stream nextPutAll: ')' ]! ! !RASQLRelation methodsFor: 'private' stamp: 'avi 4/6/2004 19:06'! sqlPrinterClass ^ RASqlPrinter ! ! !RASQLRelation methodsFor: 'private' stamp: 'rbb 12/23/2005 18:21'! sqlSum: aColumn ^ 'SELECT SUM(', aColumn, ') FROM ' , self name! ! !RASQLRelation methodsFor: 'private' stamp: 'dao 3/30/2004 16:51'! sqlUpdate: attributesToNodes where: conditionString ^ String streamContents: [:stream | stream nextPutAll: 'UPDATE '; nextPutAll: name; nextPutAll: ' SET '. attributesToNodes keysAndValuesDo: [:attribute :node | stream nextPutAll: '"', attribute originalAttribute name, '"'; nextPutAll: ' = ('; nextPutAll: (RASqlUpdatePrinter print: node); nextPutAll: '), ']. stream skip: -2. stream nextPutAll: ' WHERE '. stream nextPutAll: conditionString] ! ! RARelation subclass: #RAIndexedRelation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Indexed'! RAIndexedRelation subclass: #RAIndexWrapper instanceVariableNames: 'source key unique' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Indexed'! !RAIndexWrapper class methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! on: aRelation key: anAttribute ^ self new setRelation: aRelation key: anAttribute unique: false! ! !RAIndexWrapper class methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! on: aRelation uniqueKey: anAttribute ^ self new setRelation: aRelation key: anAttribute unique: true! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! acceptRoeVisitor: aVisitor ^ aVisitor visitTransformation: self! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! attributes ^ source attributes! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'avi 9/28/2003 15:41'! concreteRelation ^ source concreteRelation! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! keyIsUnique ^ unique! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! keyName ^ key! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:02'! printOn: aStream source printOn: aStream! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! setRelation: aRelation key: aString unique: aBoolean source _ aRelation. key _ aString. unique _ aBoolean! ! !RAIndexWrapper methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! source ^ source! ! !RAIndexedRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! at: anObject | relation | relation _ self where: self keyName equals: anObject. self keyIsUnique ifFalse: [^ relation] ifTrue: [relation do: [:tuple | ^ tuple]]. self error: 'No value for key ', anObject printString.! ! !RAIndexedRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! keyAttribute ^ self attributeNamed: self keyName! ! !RAIndexedRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! keyIsUnique self subclassResponsibility! ! !RAIndexedRelation methodsFor: 'as yet unclassified' stamp: 'lr 7/10/2003 21:03'! keyName self subclassResponsibility! ! !RARelation methodsFor: 'core operators' stamp: 'ab 3/22/2003 10:26'! * aRelation ^ RACartesianProduct of: self with: aRelation! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/10/2003 08:52'! , aRelation ^self union: aRelation! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/11/2003 16:50'! - aRelation ^self difference: aRelation! ! !RARelation methodsFor: 'comparing' stamp: 'ab 3/27/2003 18:22'! = other "pretty hackish" ^ self printString = other printString! ! !RARelation methodsFor: 'convenience' stamp: 'avi 1/26/2004 02:10'! >> aSymbol ^ self attributeNamed: aSymbol! ! !RARelation methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:00'! acceptRoeVisitor: aVisitor ^ aVisitor visitRelation: self! ! !RARelation methodsFor: 'private' stamp: 'ab 3/27/2003 18:18'! ambiguousAttributeError: aString self error: 'More than one attribute named ', aString printString.! ! !RARelation methodsFor: 'converting' stamp: 'lr 7/11/2003 16:42'! asAlgebraicString ^String streamContents: [ :stream | (RAAlgebraicPrinter on: stream) visit: self ]! ! !RARelation methodsFor: 'converting' stamp: 'AL 9/1/2003 18:43'! asArray ^(OrderedCollection new addAll: self; yourself) asArray! ! !RARelation methodsFor: 'converting' stamp: 'lr 7/10/2003 21:13'! asMappedCollection ^ RAMappedCollection on: self! ! !RARelation methodsFor: 'converting' stamp: 'lr 7/10/2003 21:13'! asSingleMappedCollection ^ RASingleMappedCollection on: self ! ! !RARelation methodsFor: 'accessing' stamp: 'avi 9/28/2003 14:58'! attributeNamed: aString ^ self attributeNamed: aString ifAbsent: [self couldNotFindAttributeError: aString]! ! !RARelation methodsFor: 'accessing' stamp: 'dao 3/30/2004 15:15'! attributeNamed: aString ifAbsent: errorBlock | attribute | self attributes do: [:ea | ea name asString = aString asString ifTrue: [attribute ifNil: [attribute _ ea] ifNotNil: [self ambiguousAttributeError: aString]]]. ^ attribute ifNotNil: [attribute] ifNil: errorBlock! ! !RARelation methodsFor: 'accessing' stamp: 'ab 3/22/2003 10:28'! attributes self subclassResponsibility ! ! !RARelation methodsFor: 'accessing' stamp: 'lr 7/10/2003 21:13'! attributesGroupedByOriginalRelation ^ Array with: self -> self attributes! ! !RARelation methodsFor: 'core operators' stamp: 'avi 1/26/2004 02:08'! clone ^ RAClone of: self! ! !RARelation methodsFor: 'private' stamp: 'avi 9/28/2003 15:41'! concreteRelation self subclassResponsibility! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/14/2003 09:58'! copyFrom: start to: stop ^self from: start to: stop! ! !RARelation methodsFor: 'private' stamp: 'ab 3/27/2003 18:18'! couldNotFindAttributeError: aString self error: 'Could not find attribute named ', aString printString.! ! !RARelation methodsFor: 'removing' stamp: 'dao 3/9/2004 12:10'! delete self concreteRelation deleteFor: self! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/11/2003 16:50'! difference: aRelation ^RADifference of: self with: aRelation! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/25/2003 19:45'! distinct ^RADistinct source: self! ! !RARelation methodsFor: 'enumerating' stamp: 'avi 9/28/2003 15:41'! do: aBlock self concreteRelation for: self do: aBlock! ! !RARelation methodsFor: 'core operators' stamp: 'avi 1/26/2004 01:59'! from: start to: stop ^RARange of: self from: start to: stop! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/7/2003 16:50'! groupBy: aString ^self groupByAll: (Array with: aString)! ! !RARelation methodsFor: 'core operators' stamp: 'avi 1/25/2004 16:08'! groupByAll: attributeNames ^RAGrouping of: self by: attributeNames! ! !RARelation methodsFor: 'comparing' stamp: 'ab 3/27/2003 18:21'! hash ^ self printString hash! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/10/2003 21:13'! indexBy: attributeName ^ RAIndexWrapper on: self key: attributeName! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/11/2003 16:51'! intersection: aRelation ^RAIntersection of: self with: aRelation! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/10/2003 21:14'! keyBy: attributeName ^ RAIndexWrapper on: self uniqueKey: attributeName ! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/7/2003 16:51'! orderBy: aString ^self orderByAll: (Array with: aString)! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/7/2003 16:51'! orderBy: aString ascending: aBoolean ^self orderByAll: (Array with: aString) ascending: (Array with: aBoolean)! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/7/2003 16:54'! orderByAll: attributeNames | ascending | ascending := Array new: attributeNames size withAll: true. ^self orderByAll: attributeNames ascending: ascending! ! !RARelation methodsFor: 'core operators' stamp: 'avi 1/25/2004 16:08'! orderByAll: attributeNames ascending: booleanArray ^RAOrdering of: self order: attributeNames ascending: booleanArray! ! !RARelation methodsFor: 'core operators' stamp: 'ab 3/22/2003 13:55'! project: aString ^ self projectAll: (Array with: aString)! ! !RARelation methodsFor: 'core operators' stamp: 'ab 3/22/2003 13:55'! projectAll: attributeNames ^ RAProjection of: self into: attributeNames! ! !RARelation methodsFor: 'core operators' stamp: 'ab 3/22/2003 11:12'! rename: oldName to: newName ^ self renameAll: (Array with: oldName) to: (Array with: newName)! ! !RARelation methodsFor: 'core operators' stamp: 'avi 1/26/2004 02:04'! renameAll: oldNameArray to: newNameArray ^ RAAlias of: self from: oldNameArray to: newNameArray ! ! !RARelation methodsFor: 'core operators' stamp: 'avi 9/28/2003 14:54'! select: aBlock ^ RASelection from: self where: aBlock! ! !RARelation methodsFor: 'private' stamp: 'ab 3/22/2003 15:13'! species ^ OrderedCollection! ! !RARelation methodsFor: 'core operators' stamp: 'lr 7/10/2003 08:53'! union: aRelation ^RAUnion of: self with: aRelation! ! !RARelation methodsFor: 'updating' stamp: 'avi 9/30/2003 00:31'! update: aBlock self concreteRelation for: self update: aBlock! ! !RARelation methodsFor: 'convenience' stamp: 'rbb 11/28/2006 20:49'! where: attributeName equals: anObject "Transcript cr; show: self asMappedCollection." ^ self select: [:ea | (ea valueForAttributeNamed: attributeName) = anObject]! ! !RARelation methodsFor: 'convenience' stamp: 'avi 9/28/2003 15:04'! whereEqual: attributePair ^ self select: [:ea | (ea valueForAttributeNamed: attributePair first) = (ea valueForAttributeNamed: attributePair last)]! ! !RARelation methodsFor: 'enumerating' stamp: 'rbb 4/11/2005 19:05'! withIndexDo: aBlock |i| i _ 1. self do: [:ea | aBlock value: ea value: i. i _ i + 1]! ! RARelation subclass: #RATransformation instanceVariableNames: 'source' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! RATransformation subclass: #RAAlias instanceVariableNames: 'attributes' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAAlias class methodsFor: 'as yet unclassified' stamp: 'avi 1/25/2004 14:35'! of: aRelation from: attributeRefs to: nameArray ^ self new setRelation: aRelation attributes: attributeRefs newNames: nameArray! ! !RAAlias methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitAlias: self! ! !RAAlias methodsFor: 'accessing' stamp: 'ab 3/26/2003 18:17'! attributes ^ attributes! ! !RAAlias methodsFor: 'accessing' stamp: 'lr 7/10/2003 21:00'! attributesGroupedByOriginalRelation ^ source attributesGroupedByOriginalRelation collect: [:assoc | assoc key -> (assoc value collect: [:attr | attributes detect: [:ea | (ea respondsTo: #source) and: [ea source = attr]] ifNone: [attr]])]! ! !RAAlias methodsFor: 'initializing' stamp: 'avi 1/25/2004 14:34'! setRelation: aRelation attributes: attributeRefs newNames: newNames source _ aRelation. attributes _ source attributes copy. attributeRefs with: newNames do: [:ref :new ||attr| attr _ ref resolveAttributeIn: attributes. attributes replaceAll: attr with: (RAAliasedAttribute attribute: attr name: new)]! ! RATransformation subclass: #RAClone instanceVariableNames: 'attributes' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAClone class methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:08'! of: aRelation ^ self basicNew setRelation: aRelation! ! !RAClone methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:09'! acceptRoeVisitor: aVisitor ^ aVisitor visitClone: self! ! !RAClone methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:09'! attributes ^ attributes! ! !RAClone methodsFor: 'as yet unclassified' stamp: 'avi 1/26/2004 02:08'! setRelation: aRelation source _ aRelation. attributes _ source attributes collect: [:ea | RAClonedAttribute attribute: ea]! ! RATransformation subclass: #RADistinct instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RADistinct class methodsFor: 'as yet unclassified' stamp: 'avi 1/25/2004 16:12'! source: aRelation ^ self basicNew setSource: aRelation! ! !RADistinct methodsFor: 'visiting' stamp: 'lr 7/25/2003 19:40'! acceptRoeVisitor: aVisitor ^aVisitor visitDistinct: self! ! !RADistinct methodsFor: 'visiting' stamp: 'avi 1/25/2004 16:12'! setSource: aRelation source _ aRelation! ! RATransformation subclass: #RAGrouping instanceVariableNames: 'group' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAGrouping class methodsFor: 'instance creation' stamp: 'avi 1/25/2004 16:08'! of: aSource by: attributeRefs ^ self basicNew setSource: aSource groupAttributes: attributeRefs! ! !RAGrouping methodsFor: 'visiting' stamp: 'lr 7/7/2003 16:49'! acceptRoeVisitor: aVisitor ^aVisitor visitGroup: self! ! !RAGrouping methodsFor: 'accessing' stamp: 'lr 7/7/2003 16:59'! group ^group! ! !RAGrouping methodsFor: 'initializing' stamp: 'avi 1/25/2004 16:04'! setSource: aRelation groupAttributes: attributeRefs source _ aRelation. group _ attributeRefs collect: [:ea | ea resolveAttributeIn: source attributes].! ! RATransformation subclass: #RAOrdering instanceVariableNames: 'order ascending' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAOrdering class methodsFor: 'instance creation' stamp: 'avi 1/25/2004 16:06'! of: aRelation order: attributeRefs ascending: booleanArray ^ self basicNew setSource: aRelation orderAttributes: attributeRefs ascending: booleanArray! ! !RAOrdering methodsFor: 'visiting' stamp: 'lr 7/7/2003 16:44'! acceptRoeVisitor: aVisitor ^aVisitor visitOrder: self! ! !RAOrdering methodsFor: 'accessing' stamp: 'lr 7/7/2003 17:02'! ascending ^ascending! ! !RAOrdering methodsFor: 'accessing' stamp: 'lr 7/7/2003 17:02'! order ^order! ! !RAOrdering methodsFor: 'initialization' stamp: 'avi 1/25/2004 16:12'! setSource: aRelation orderAttributes: attributeRefs ascending: booleanArray source _ aRelation. order _ attributeRefs collect: [ :ea | ea resolveAttributeIn: source attributes ]. ascending _ booleanArray.! ! RATransformation subclass: #RAProjection instanceVariableNames: 'attributes' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RAProjection class methodsFor: 'as yet unclassified' stamp: 'avi 1/25/2004 14:24'! of: aRelation into: attributeRefs ^ self new setRelation: aRelation attributes: attributeRefs! ! !RAProjection methodsFor: 'visiting' stamp: 'ab 3/23/2003 16:59'! acceptRoeVisitor: aVisitor ^ aVisitor visitProjection: self! ! !RAProjection methodsFor: 'visiting' stamp: 'ab 3/26/2003 19:52'! attributes ^ attributes! ! !RAProjection methodsFor: 'accessing' stamp: 'lr 7/10/2003 21:16'! attributesGroupedByOriginalRelation ^ source attributesGroupedByOriginalRelation collect: [:assoc | assoc key -> (assoc value select: [:ea | attributes includes: ea])] thenSelect: [:assoc | assoc value isEmpty not]! ! !RAProjection methodsFor: 'initializing' stamp: 'rbb 12/24/2005 00:21'! setRelation: aRelation attributes: attributeRefs source _ aRelation. attributes _ attributeRefs collect: [:ea | ea resolveAttributeIn: source attributes]! ! RATransformation subclass: #RARange instanceVariableNames: 'interval' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RARange class methodsFor: 'instance creation' stamp: 'avi 1/25/2004 16:05'! of: aSource from: min to: max ^ self basicNew setSource: aSource interval: (min to: max)! ! !RARange methodsFor: 'visiting' stamp: 'lr 7/14/2003 09:41'! acceptRoeVisitor: aVisitor ^aVisitor visitInterval: self! ! !RARange methodsFor: 'accessing' stamp: 'lr 7/14/2003 09:41'! interval ^interval! ! !RARange methodsFor: 'accessing-interval' stamp: 'lr 7/14/2003 09:44'! limit ^self interval size! ! !RARange methodsFor: 'accessing-interval' stamp: 'lr 7/14/2003 10:07'! offset ^self interval first - 1! ! !RARange methodsFor: 'initializing' stamp: 'avi 1/25/2004 16:05'! setSource: aRelation interval: anInterval source _ aRelation. interval _ anInterval! ! !RARange methodsFor: 'accessing-interval' stamp: 'lr 7/14/2003 09:58'! start ^self interval first! ! !RARange methodsFor: 'accessing-interval' stamp: 'lr 7/14/2003 09:59'! stop ^self interval last! ! RATransformation subclass: #RASelection instanceVariableNames: 'condition' classVariableNames: '' poolDictionaries: '' category: 'Roe-Relations-Core'! !RASelection class methodsFor: 'as yet unclassified' stamp: 'ab 3/22/2003 15:34'! from: aRelation where: aBlock ^ self new setRelation: aRelation condition: aBlock! ! !RASelection methodsFor: 'visiting' stamp: 'ab 3/23/2003 17:00'! acceptRoeVisitor: aVisitor ^ aVisitor visitSelection: self! ! !RASelection methodsFor: 'evaluating' stamp: 'avi 9/28/2003 14:55'! evaluateTuple: anArray ^ condition value: anArray! ! !RASelection methodsFor: 'initializing' stamp: 'ab 3/23/2003 20:04'! setRelation: aRelation condition: aBlock source _ aRelation. condition _ aBlock.! ! !RATransformation methodsFor: 'visiting' stamp: 'ab 3/23/2003 20:16'! acceptRoeVisitor: aVisitor ^ aVisitor visitTransformation: self! ! !RATransformation methodsFor: 'accessing' stamp: 'ab 3/22/2003 12:01'! attributes ^ source attributes! ! !RATransformation methodsFor: 'accessing' stamp: 'lr 7/10/2003 21:17'! attributesGroupedByOriginalRelation ^ source attributesGroupedByOriginalRelation ! ! !RATransformation methodsFor: 'private' stamp: 'avi 9/28/2003 15:41'! concreteRelation ^ source concreteRelation! ! !RATransformation methodsFor: 'printing' stamp: 'lr 7/11/2003 16:42'! printOn: aStream aStream nextPutAll: self asAlgebraicString! ! !RATransformation methodsFor: 'accessing' stamp: 'ab 3/22/2003 12:05'! source ^ source! ! !ByteSymbol methodsFor: '*Roe' stamp: 'rbb 12/23/2005 19:09'! resolveAttributeIn: aCollection ^ aCollection detect: [:ea | ea name asString asUppercase = self asString asUppercase] ifNone: [self errorCouldNotResolveAttribute]! ! TestCase subclass: #RATestMapping instanceVariableNames: 'courses students' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RATestMapping methodsFor: 'running' stamp: 'avi 1/25/2004 00:48'! setUp courses _ RAMockRelation name: 'courses' attributes: #(id title). students _ RAMockRelation name: 'students' attributes: #(name courseID). courses addAllValues: #((1 'Discrete Math') (2 'Databases')). students addAllValues: #(('Avi' 2) ('Ken' 2)). courses objectClass: RAMockCourse. students objectClass: RAMockStudent.! ! !RATestMapping methodsFor: 'private' stamp: 'lr 7/10/2003 21:09'! studentsForCourseID: courseID ^ (students * (courses where: #id equals: courseID)) whereEqual: #(id courseID)! ! !RATestMapping methodsFor: 'testing' stamp: 'lr 7/10/2003 21:09'! testObjectInstantiation | mappedStudents | mappedStudents _ (self studentsForCourseID: 2) asMappedCollection. self assert: mappedStudents size = 2. self assert: mappedStudents anyOne first class = RAMockStudent. self assert: mappedStudents anyOne second class = RAMockCourse.! ! !RATestMapping methodsFor: 'testing' stamp: 'lr 7/10/2003 21:09'! testSelfJoins | mapping tuple | mapping _ (students * students * courses * students * courses) asMappedCollection. tuple _ mapping anyOne. self assert: (tuple collect: [:ea | ea class name]) = #(RAMockStudent RAMockStudent RAMockCourse RAMockStudent RAMockCourse).! ! !RATestMapping methodsFor: 'testing' stamp: 'lr 7/10/2003 21:09'! testSingleObjectInstantiation | mappedStudents | mappedStudents _ students asSingleMappedCollection. self assert: mappedStudents size = 2. self assert: mappedStudents anyOne class = RAMockStudent! ! TestCase subclass: #RATestSemantics instanceVariableNames: 'students students2 courses profs enrollment' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! RATestSemantics subclass: #RATestEvaluatorSemantics instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RATestEvaluatorSemantics methodsFor: 'private' stamp: 'avi 9/29/2003 11:59'! createRelation: aString attributes: anArray ^ RAArrayRelation name: aString attributes: anArray! ! RATestSemantics subclass: #RATestPostgresSemantics instanceVariableNames: 'connection' classVariableNames: 'ConnectionArgs' poolDictionaries: '' category: 'Roe-Tests'! !RATestPostgresSemantics methodsFor: 'configuration' stamp: 'avi 4/6/2004 16:12'! connection ^ connection ifNil: [connection _ PGConnection new connectionArgs: self defaultConnectionArgs; startup; yourself]! ! !RATestPostgresSemantics methodsFor: 'configuration' stamp: 'avi 9/29/2003 11:59'! createRelation: aString attributes: anArray ^ RAPostgresRelation name: aString connection: self connection! ! !RATestPostgresSemantics methodsFor: 'configuration' stamp: 'rbb 3/15/2005 17:00'! defaultConnectionArgs ^ConnectionArgs ifNil: [ConnectionArgs _ PGConnectionArgs hostname: '10.0.0.75' portno: 5432 databaseName: 'appmanager' userName: 'ablemanage' password: nil]! ! !RATestPostgresSemantics methodsFor: 'private' stamp: 'dao 3/24/2004 11:18'! setUp self connection execute: 'create table profs ("facultyID" integer, name varchar)'; execute: 'create table students ("studentNumber" integer, name varchar)'; execute: 'create table students2 ("studentNumber" integer, name varchar)'; execute: 'create table courses ("courseNumber" integer, title varchar, prof integer)'; execute: 'create table enrollment (student integer, course integer)'. super setUp. ! ! !RATestPostgresSemantics methodsFor: 'private' stamp: 'avi 9/29/2003 12:42'! tearDown #(profs students students2 courses enrollment) do: [:ea | connection execute: 'DROP TABLE ', ea]. connection terminate. ! ! RATestPostgresSemantics subclass: #RATestPostgresSemanticsWithNils instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 12:00'! addNilColumnsToTables: tableNames | setNotNilValues | setNotNilValues _ false. tableNames do: [:ea | self connection execute: ('ALTER TABLE ' , ea , ' ADD COLUMN ' , self nilColumnName , ' int4 '). setNotNilValues ifTrue: [ self connection execute: ('UPDATE ' , ea , ' SET ' , self nilColumnName , '=1')] ] ! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 11:24'! assertQueryOrdered: aRelation gives: anArray | myRelation | myRelation _ self dropNilColumnFromRelation: aRelation. super assertQueryOrdered: myRelation gives: anArray! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 11:24'! assertQueryUnordered: aRelation gives: anArray | myRelation | myRelation _ self dropNilColumnFromRelation: aRelation. super assertQueryUnordered: myRelation gives: anArray! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 11:24'! assertTuple: aTuple is: anArray "another ugly hack" self assert: aTuple values asArray allButLast = anArray ! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/30/2004 13:21'! dropNilColumnFromRelation: aRelation ^aRelation projectAll: (aRelation attributes reject: [:attr | attr name = self nilColumnName]) ! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 11:15'! nilColumnName ^'nilcolumn'! ! !RATestPostgresSemanticsWithNils methodsFor: 'private' stamp: 'dao 3/24/2004 11:18'! setUp super setUp. self addNilColumnsToTables: #('profs' 'students' 'students2' 'courses' 'enrollment') . ! ! !RATestSemantics methodsFor: 'private' stamp: 'avi 4/6/2004 16:16'! addAllValues: anArray to: aRelation aRelation addAllValues: anArray! ! !RATestSemantics methodsFor: 'private' stamp: 'avi 9/29/2003 12:39'! assertQueryOrdered: aRelation gives: anArray self assert: (aRelation collect: [:ea | ea values asArray]) asArray = anArray! ! !RATestSemantics methodsFor: 'private' stamp: 'avi 9/29/2003 12:41'! assertQueryUnordered: aRelation gives: anArray self assert: (aRelation collect: [:ea | ea values asArray]) asSet = anArray asSet! ! !RATestSemantics methodsFor: 'private' stamp: 'avi 9/29/2003 12:41'! assertTuple: aTuple is: anArray self assert: aTuple values asArray = anArray! ! !RATestSemantics methodsFor: 'private' stamp: 'lr 7/7/2003 21:50'! selectCourseNumbersForProf: aString ^ ((profs * courses whereEqual: #(facultyID prof)) where: #name equals: aString) project: #courseNumber! ! !RATestSemantics methodsFor: 'private' stamp: 'avi 9/28/2003 14:45'! selectCourseTitlesForStudent: aString ^ (((students select: [:ea | ea name = aString]) * enrollment * courses) select: [:ea | (ea student = ea studentNumber) & (ea course = ea courseNumber)]) project: #title! ! !RATestSemantics methodsFor: 'running' stamp: 'avi 4/6/2004 16:15'! setUp profs _ self createRelation: 'profs' attributes: #(facultyID name). self addAllValues: #((1 'Murphy') (2 'Cavers') (3 'Tsiknis') (4 'Bob')) to: profs. students _ self createRelation: 'students' attributes: #(studentNumber name). self addAllValues: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob')) to: students. students2 _ self createRelation: 'students2' attributes: #(studentNumber name). self addAllValues: #((1 'Avi') (2 'Julian') (5 'Lukas') (6 'Adrian')) to: students2. courses _ self createRelation: 'courses' attributes: #('courseNumber' 'title' 'prof'). self addAllValues: #((310 'Software Engineering' 1) (220 'Discrete Math' 2) (128 'Scheme' 2) (304 'Databases' 3)) to: courses. enrollment _ self createRelation: 'enrollment' attributes: #('student' 'course'). self addAllValues: #((1 310) (1 220) (2 220) (2 128) (3 220) (3 304) (3 310)) to: enrollment.! ! !RATestSemantics methodsFor: 'running' stamp: 'avi 9/29/2003 11:57'! tearDown ! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:26'! testAllStudents self assertQueryOrdered: students gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/25/2004 17:01'! testBothStudentAndProf | profName studentName | profName _ profs attributeNamed: #name. studentName _ students attributeNamed: #name. self assertQueryOrdered: ((profs * students select: [:ea | (ea at: profName) = (ea at: studentName)]) project: profName) gives: #(('Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/25/2004 14:21'! testBothStudentAndProfOldStyle self assertQueryOrdered: ((((profs rename: #name to: #profName) * (students rename: #name to: #studName)) select: [:ea | ea profName = ea studName]) project: #profName) gives: #(('Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/25/2004 16:14'! testDistinct | student | student _ enrollment attributeNamed: #student. self assertQueryOrdered: ((enrollment project: student) distinct orderBy: student) gives: #((1) (2) (3)). self assertQueryOrdered: ((enrollment project: #course) distinct orderBy: #course) gives: #((128) (220) (304) (310)).! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:28'! testFindClassmates | classmates | classmates _ enrollment clone. self assertQueryUnordered: ((enrollment * classmates select: [:ea | ((ea at: enrollment>>#course) = (ea at: classmates>>#course)) & ((ea at: enrollment>>#student) ~= (ea at: classmates>>#student))]) projectAll: ( Array with: enrollment>>#student with: classmates>>#student)) gives: #((1 3)(1 2)(2 3)(3 1)(2 1)(3 2)) ! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/25/2004 17:07'! testFindClassmatesOldStyle self assertQueryUnordered: (((enrollment * (enrollment renameAll: #(student course) to: #(classmate course2))) select: [:ea | (ea course = ea course2) & (ea student ~= ea classmate)]) projectAll: #(student classmate)) gives: #((1 3)(1 2)(2 3)(3 1)(2 1)(3 2))! ! !RATestSemantics methodsFor: 'testing' stamp: 'lr 7/7/2003 21:54'! testFindProfCourses self assertQueryUnordered: (self selectCourseNumbersForProf: 'Cavers') gives: #((220) (128))! ! !RATestSemantics methodsFor: 'testing' stamp: 'lr 7/7/2003 21:54'! testFindStudentCourses self assertQueryUnordered: (self selectCourseTitlesForStudent: 'Andrew') gives: #(('Discrete Math') ('Databases') ('Software Engineering'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:26'! testIntervalStudents | relation | relation _ students orderBy: #studentNumber ascending: true. self assertQueryOrdered: (relation from: 1 to: 0) gives: #(). self assertQueryOrdered: (relation from: 1 to: 1) gives: #((1 'Avi')). self assertQueryOrdered: (relation from: 1 to: 4) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob')). self assertQueryOrdered: (relation from: 2 to: 3) gives: #((2 'Julian') (3 'Andrew')). self assertQueryOrdered: (relation copyFrom: 2 to: 3) gives: #((2 'Julian') (3 'Andrew')).! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:24'! testOrderStudents self assertQueryOrdered: (students orderBy: #studentNumber ascending: true) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob')). self assertQueryOrdered: (students orderBy: #studentNumber ascending: false) gives: #((4 'Bob') (3 'Andrew') (2 'Julian') (1 'Avi'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:23'! testSelectOneStudent self assertQueryOrdered: (students select: [:ea | ea name = 'Julian']) gives: #((2 'Julian'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:23'! testStudentExcept self assertQueryUnordered: (students - students2) gives: #((3 'Andrew') (4 'Bob')). self assertQueryUnordered: (students difference: students2) gives: #((3 'Andrew') (4 'Bob')). self assertQueryUnordered: (students2 - students) gives: #((5 'Lukas') (6 'Adrian')). self assertQueryUnordered: (students2 difference: students) gives: #((5 'Lukas') (6 'Adrian')). ! ! !RATestSemantics methodsFor: 'testing' stamp: 'lr 7/10/2003 21:43'! testStudentIndex |idx| idx _ students indexBy: #studentNumber. self assertQueryUnordered: (idx at: 1) gives: #((1 'Avi')). idx _ students keyBy: #studentNumber. self assertTuple: (idx at: 1) is: #(1 'Avi'). ! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:21'! testStudentIntersect self assertQueryUnordered: (students intersection: students2) gives: #((1 'Avi') (2 'Julian')). self assertQueryUnordered: (students2 intersection: students) gives: #((1 'Avi') (2 'Julian')).! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:21'! testStudentNames self assertQueryOrdered: (students project: #name) gives: #(('Avi') ('Julian') ('Andrew') ('Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:21'! testStudentUnion self assertQueryUnordered: (students , students2) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob') (5 'Lukas') (6 'Adrian')). self assertQueryUnordered: (students union: students2) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob') (5 'Lukas') (6 'Adrian')). self assertQueryUnordered: (students2 , students) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob') (5 'Lukas') (6 'Adrian')). self assertQueryUnordered: (students2 union: students) gives: #((1 'Avi') (2 'Julian') (3 'Andrew') (4 'Bob') (5 'Lukas') (6 'Adrian')). ! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:20'! testUpdateAlias (students rename: #studentNumber to: #sn) update: [:ea | ea sn: 1]. self assertQueryUnordered: students gives: #((1 'Avi') (1 'Julian') (1 'Andrew') (1 'Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/27/2004 02:53'! testUpdateAliasWithColumn (students renameAll: #(name studentNumber) to: #(cn sn)) update: [:ea | ea cn: ea sn asString]. self assertQueryUnordered: students gives: #((1 '1') (2 '2') (3 '3') (4 '4'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 3/29/2004 01:29'! testUpdateJoin | join | join _ students * profs. self should: [join update: [:ea | ea studentNumber: 17]] raise: Error! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:19'! testUpdateSimpleSelect (students select: [:ea | ea name = 'Julian']) update: [:ea | ea name: 'Fitzell']. self assertQueryUnordered: students gives: #((1 'Avi') (2 'Fitzell') (3 'Andrew') (4 'Bob'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'avi 1/26/2004 14:30'! testUpdateTableWithColumn students update: [:ea | ea name: ea studentNumber asString]. self assertQueryUnordered: students gives: #((1 '1') (2 '2') (3 '3') (4 '4'))! ! !RATestSemantics methodsFor: 'testing' stamp: 'dao 3/30/2004 15:19'! testUpdateTableWithLiteral students update: [:ea | ea name: 'Foo']. self assertQueryUnordered: students gives: #((1 'Foo') (2 'Foo') (3 'Foo') (4 'Foo'))! ! TestCase subclass: #RATestSyntax instanceVariableNames: 'abc def abcdef ab fe abd geh abqe aLT2 bEQfoo abcSquared abcGBa abcGBab abcOBaa abcOBad abcOBaabd abcEabc abcUabc abcIabc abcD abcI' classVariableNames: '' poolDictionaries: '' category: 'Roe-Tests'! !RATestSyntax methodsFor: 'private' stamp: 'ab 3/22/2003 17:50'! assert: aRelation hasAttributes: attributeNames self assert: (aRelation attributes collect: [:ea | ea name]) asArray = attributeNames! ! !RATestSyntax methodsFor: 'private' stamp: 'ab 3/26/2003 17:50'! assertError: aBlock self should: aBlock raise: Error! ! !RATestSyntax methodsFor: 'running' stamp: 'dao 3/30/2004 15:45'! setUp abc _ RAArrayRelation name: 'abc' attributes: #(a b c). def _ RAArrayRelation name: 'def' attributes: #(d e f). abcdef _ abc * def. ab _ abc projectAll: #(a b). fe _ def projectAll: #(f e). abd _ abc rename: #c to: #d. geh _ def renameAll: #(d f) to: #(g h). abqe _ ab * (fe rename: #f to: #q). aLT2 _ abc select: [:ea | ea a < 2]. bEQfoo _ abc select: [:ea | (ea b = 'foo') & (ea a >= (ea c * 2))]. abcSquared _ abc * (abc renameAll: #(a b c) to: #(a1 b1 c1)). abcGBa _ abc groupBy: #a. abcGBab _ abc groupByAll: #(a b). abcOBaa _ abc orderBy: #a. abcOBad _ abc orderBy: #a ascending: false. abcOBaabd _ abc orderByAll: #(a b) ascending: (Array with: true with: false). abcEabc _ abc difference: abc. " abc - abc " abcUabc _ abc union: abc. " abc , abc " abcIabc _ abc intersection: abc. abcD _ abc distinct. abcI _ abc from: 10 to: 15. " abc copyFrom: 10 to: 15 " ! ! !RATestSyntax methodsFor: 'testing' stamp: 'ab 7/26/2003 00:20'! testAttributeNames self assert: abc hasAttributes: #(a b c). self assert: def hasAttributes: #(d e f). self assert: abcdef hasAttributes: #(a b c d e f). self assert: ab hasAttributes: #(a b). self assert: fe hasAttributes: #(f e). self assert: abd hasAttributes: #(a b d). self assert: geh hasAttributes: #(g e h). self assert: abqe hasAttributes: #(a b q e). self assert: aLT2 hasAttributes: #(a b c). self assert: bEQfoo hasAttributes: #(a b c). self assert: abcSquared hasAttributes: #(a b c a1 b1 c1). self assert: abcGBa hasAttributes: #(a b c). self assert: abcGBab hasAttributes: #(a b c). self assert: abcOBaa hasAttributes: #(a b c). self assert: abcOBad hasAttributes: #(a b c). self assert: abcOBaabd hasAttributes: #(a b c). self assert: abcEabc hasAttributes: #(a b c). self assert: abcUabc hasAttributes: #(a b c). self assert: abcIabc hasAttributes: #(a b c). self assert: abcD hasAttributes: #(a b c). self assert: abcI hasAttributes: #(a b c). ! ! !RATestSyntax methodsFor: 'testing' stamp: 'ab 3/27/2003 18:22'! testEquality self assert: (abc project: #a) = (abc project: #a). self deny: (abc project: #a) = (abc project: #b). self deny: (abc project: #a) = (ab project: #a). self assert: (abc rename: #a to: #x) = (abc rename: #a to: #x). self assert: (abc renameAll: #(a) to: #(x)) = (abc rename: #a to: #x). self assert: (abc renameAll: #(a b) to: #(x y)) = (abc renameAll: #(b a) to: #(y x)). self deny: (abc rename: #a to: #x) = (abc renameAll: #(a b) to: #(x y)).! ! !RATestSyntax methodsFor: 'testing' stamp: 'ab 3/26/2003 17:50'! testErrors abc project: #c. self assertError: [abc project: #d]. self assertError: [ab project: #c]. abc rename: #c to: #e. self assertError: [abc rename: #d to: #e]. abc renameAll: #(a b) to: #(e f). self assertError: [abc renameAll: #(a b) to: #(e)]. abc where: #a equals: 3. self assertError: [abc where: #d equals: 3]. (abc*(abc rename: #a to: #a2)) project: #a. self assertError: [(abc*abc) project: #a]. (abc*(abc rename: #a to: #a2)) rename: #a to: #e. self assertError: [(abc*abc) rename: #a to: #e]. (abc*(abc rename: #a to: #a2)) where: #a equals: 3. self assertError: [(abc*abc) where: #a equals: 3]. ! ! !RATestSyntax methodsFor: 'testing' stamp: 'lr 7/14/2003 11:46'! testEscapingSql self assert: '\' asEscapedSql = '\\'. self assert: '''' asEscapedSql = ''''''. self assert: '\''' asEscapedSql = '\\'''''.! ! !RATestSyntax methodsFor: 'testing' stamp: 'ab 3/27/2003 17:54'! testOrigins self assert: (abc attributeNamed: #a) originalRelation = abc. self assert: (abcdef attributeNamed: #a) originalRelation = abc. self assert: (abd attributeNamed: #d) originalRelation = abc. self assert: (abc attributeNamed: #c) originalAttribute = (abc attributeNamed: #c). self assert: (abd attributeNamed: #d) originalAttribute = (abc attributeNamed: #c). ! ! !RATestSyntax methodsFor: 'testing' stamp: 'avi 1/25/2004 01:24'! testPrinting "commented out cause I'm not sure we care" " self assert: abc prints: 'abc'. self assert: def prints: 'def'. self assert: abcdef prints: '(abc) * (def)'. self assert: ab prints: '(abc) projectAll: #(#a #b)'. self assert: fe prints: '(def) projectAll: #(#f #e)'. self assert: abd prints: '(abc) renameAll: #(#c) to: #(#d)'. self assert: geh prints: '(def) renameAll: #(#d #f) to: #(#g #h)'. self assert: abqe prints: '((abc) projectAll: #(#a #b)) * ( X R[f->q](P[f,e](def))'. self assert: aLT2 prints: 'S[(a<2)](abc)'. self assert: bEQfoo prints: 'S[((b=''foo'')&(a>=(c*2)))](abc)'. self assert: abcSquared prints: 'abc X R[a->a1,b->b1,c->c1](abc)'. self assert: abcGBa prints: 'G[a](abc)'. self assert: abcGBab prints: 'G[a,b](abc)'. self assert: abcOBaa prints: 'O[a->asc](abc)'. self assert: abcOBad prints: 'O[a->desc](abc)'. self assert: abcOBaabd prints: 'O[a->asc,b->desc](abc)'. self assert: abcEabc prints: 'abc \ abc'. self assert: abcUabc prints: 'abc u abc'. self assert: abcIabc prints: 'abc n abc'. self assert: abcD prints: '{abc}'. self assert: abcI prints: 'I[10,15](abc)'. "! ! !RATestSyntax methodsFor: 'testing' stamp: 'ab 7/26/2003 00:20'! testPrintingAlgebraic self assert: abc asAlgebraicString = 'abc'. self assert: def asAlgebraicString = 'def'. self assert: abcdef asAlgebraicString = 'abc X def'. self assert: ab asAlgebraicString = 'P[a,b](abc)'. self assert: fe asAlgebraicString = 'P[f,e](def)'. self assert: abd asAlgebraicString = 'R[c->d](abc)'. self assert: geh asAlgebraicString = 'R[d->g,f->h](def)'. self assert: abqe asAlgebraicString = 'P[a,b](abc) X R[f->q](P[f,e](def))'. self assert: aLT2 asAlgebraicString = 'S[(a<2)](abc)'. self assert: bEQfoo asAlgebraicString = 'S[((b=''foo'')&(a>=(c*2)))](abc)'. self assert: abcSquared asAlgebraicString = 'abc X R[a->a1,b->b1,c->c1](abc)'. self assert: abcGBa asAlgebraicString = 'G[a](abc)'. self assert: abcGBab asAlgebraicString = 'G[a,b](abc)'. self assert: abcOBaa asAlgebraicString = 'O[a->asc](abc)'. self assert: abcOBad asAlgebraicString = 'O[a->desc](abc)'. self assert: abcOBaabd asAlgebraicString = 'O[a->asc,b->desc](abc)'. self assert: abcEabc asAlgebraicString = 'abc \ abc'. self assert: abcUabc asAlgebraicString = 'abc u abc'. self assert: abcIabc asAlgebraicString = 'abc n abc'. self assert: abcD asAlgebraicString = '{abc}'. self assert: abcI asAlgebraicString = 'I[10,15](abc)'. ! !