diff --git a/ReStore/AbstractB.cls b/ReStore/AbstractB.cls index a668cdb..7efc795 100644 --- a/ReStore/AbstractB.cls +++ b/ReStore/AbstractB.cls @@ -1,13 +1,30 @@ -"Filed out from Dolphin Smallalk"! +"Filed out from Dolphin Smalltalk"! AbstractA subclass: #AbstractB - instanceVariableNames: '' + instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + AbstractB guid: (GUID fromString: '{a925b7f2-6652-486f-8438-85177645d692}')! + AbstractB comment: ''! + !AbstractB categoriesForClass!Unclassified! ! + +!AbstractB methodsFor! + +reference + ^reference! + +reference: anObject + reference := anObject! ! + +!AbstractB categoriesForMethods! +reference!accessing!private! ! +reference:!accessing!private! ! +! + !AbstractB class methodsFor! addClassDefinitionToEmpty: aClassDef @@ -21,6 +38,7 @@ reStoreDefinitionEmpty shouldSubclassesInheritPersistencyFalse ^self ~~ ##(self)! ! + !AbstractB class categoriesForMethods! addClassDefinitionToEmpty:!public! ! reStoreDefinitionEmpty!public! ! diff --git a/ReStore/ConcreteA.cls b/ReStore/ConcreteA.cls index 0a01bc7..28c0bf9 100644 --- a/ReStore/ConcreteA.cls +++ b/ReStore/ConcreteA.cls @@ -1,20 +1,26 @@ -"Filed out from Dolphin Smallalk"! +"Filed out from Dolphin Smalltalk"! AbstractB subclass: #ConcreteA instanceVariableNames: 'a' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + ConcreteA guid: (GUID fromString: '{63d5e45e-b7f4-477a-a90b-fa09627cae9c}')! + ConcreteA comment: ''! + !ConcreteA categoriesForClass!Unclassified! ! + !ConcreteA class methodsFor! reStoreDefinition ^super reStoreDefinition define: #a as: String; + define: #reference as: ConcreteReferenceA; yourself! ! + !ConcreteA class categoriesForMethods! reStoreDefinition!public! ! ! diff --git a/ReStore/ConcreteB.cls b/ReStore/ConcreteB.cls index 080ff85..441acc3 100644 --- a/ReStore/ConcreteB.cls +++ b/ReStore/ConcreteB.cls @@ -1,20 +1,26 @@ -"Filed out from Dolphin Smallalk"! +"Filed out from Dolphin Smalltalk"! AbstractB subclass: #ConcreteB instanceVariableNames: 'b' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + ConcreteB guid: (GUID fromString: '{e57bf062-b41d-4043-947f-795c9fde9b3b}')! + ConcreteB comment: ''! + !ConcreteB categoriesForClass!Unclassified! ! + !ConcreteB class methodsFor! reStoreDefinition ^super reStoreDefinition define: #b as: String; + define: #reference as: ConcreteReferenceB; yourself! ! + !ConcreteB class categoriesForMethods! reStoreDefinition!public! ! ! diff --git a/ReStore/ConcreteReferenceA.cls b/ReStore/ConcreteReferenceA.cls new file mode 100644 index 0000000..d91dbd0 --- /dev/null +++ b/ReStore/ConcreteReferenceA.cls @@ -0,0 +1,39 @@ +"Filed out from Dolphin Smalltalk"! + +Object subclass: #ConcreteReferenceA + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +ConcreteReferenceA guid: (GUID fromString: '{a2655220-0fab-450d-870d-04118189070b}')! + +ConcreteReferenceA comment: ''! + +!ConcreteReferenceA categoriesForClass!Unclassified! ! + +!ConcreteReferenceA methodsFor! + +name + ^name! + +name: anObject + name := anObject! ! + +!ConcreteReferenceA categoriesForMethods! +name!accessing!private! ! +name:!accessing!private! ! +! + +!ConcreteReferenceA class methodsFor! + +reStoreDefinition + + ^super reStoreDefinition + define: #name as: (String maxSize: 100); + yourself! ! + +!ConcreteReferenceA class categoriesForMethods! +reStoreDefinition!public! ! +! + diff --git a/ReStore/ConcreteReferenceB.cls b/ReStore/ConcreteReferenceB.cls new file mode 100644 index 0000000..4b3e9ab --- /dev/null +++ b/ReStore/ConcreteReferenceB.cls @@ -0,0 +1,39 @@ +"Filed out from Dolphin Smalltalk"! + +Object subclass: #ConcreteReferenceB + instanceVariableNames: 'number' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +ConcreteReferenceB guid: (GUID fromString: '{0ea038f5-2e2e-44b1-a9bc-41837f4cf103}')! + +ConcreteReferenceB comment: ''! + +!ConcreteReferenceB categoriesForClass!Unclassified! ! + +!ConcreteReferenceB methodsFor! + +number + ^number! + +number: anObject + number := anObject! ! + +!ConcreteReferenceB categoriesForMethods! +number!accessing!private! ! +number:!accessing!private! ! +! + +!ConcreteReferenceB class methodsFor! + +reStoreDefinition + + ^super reStoreDefinition + define: #number as: Integer; + yourself! ! + +!ConcreteReferenceB class categoriesForMethods! +reStoreDefinition!public! ! +! + diff --git a/ReStore/SSW ReStore Collections.pax b/ReStore/SSW ReStore Collections.pax index 8fccb41..82ff9d2 100644 --- a/ReStore/SSW ReStore Collections.pax +++ b/ReStore/SSW ReStore Collections.pax @@ -5,7 +5,6 @@ package paxVersion: 1; ©2019 John Aspinall https://github.com/rko281/ReStore'. - package classNames add: #SSWDBArrayedStaticCollectionSpec; add: #SSWDBCacheDictionaryEntry; @@ -106,135 +105,157 @@ Object subclass: #SSWDBCacheDictionaryWrapper classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + Object subclass: #SSWDBCollectionChange instanceVariableNames: 'affectedEntry' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + Object subclass: #SSWDBCollectionEntry instanceVariableNames: 'table entryID sourceID target' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCacheDictionaryWrapper subclass: #SSWDBMultiValueCacheDictionaryWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionChange subclass: #SSWDBCollectionAddition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionChange subclass: #SSWDBCollectionRemoval instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionChange subclass: #SSWDBCollectionUpdate instanceVariableNames: 'newTarget' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionRemoval subclass: #SSWDBCollectionRemovalWithKey instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionEntry subclass: #SSWDBCacheDictionaryEntry instanceVariableNames: 'keyAccessor' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionEntry subclass: #SSWDBKeyedCollectionEntry instanceVariableNames: 'index' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCacheDictionaryEntry subclass: #SSWDBMultiValueCacheDictionaryEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBTableComponent subclass: #SSWDBCollectionSpec instanceVariableNames: 'templateCollection isValueDependent isValueRelated readStatement refreshStatement refreshWithContentsIfUpdatedStatement deleteStatement' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionSpec subclass: #SSWDBGeneralCollectionSpec instanceVariableNames: 'sourceField targetField collectionTable' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBCollectionSpec subclass: #SSWDBOwnedCollectionSpec instanceVariableNames: 'targetClass ownerField ownerAccessor orderingSpecs' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBGeneralCollectionSpec subclass: #SSWDBStaticCollectionSpec instanceVariableNames: 'targetClass deleteEntriesStatement' classVariableNames: 'NilCookie' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBStaticCollectionSpec subclass: #SSWDBHashedStaticCollectionSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBStaticCollectionSpec subclass: #SSWDBKeyedStaticCollectionSpec instanceVariableNames: 'indexField updateTargetStatement' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBStaticCollectionSpec subclass: #SSWDBSortedStaticCollectionSpec instanceVariableNames: 'orderingSpecs' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBHashedStaticCollectionSpec subclass: #SSWDBStaticCacheDictionarySpec instanceVariableNames: 'keyAccessor' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBStaticCacheDictionarySpec subclass: #SSWDBStaticMultiValueCacheDictionarySpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBKeyedStaticCollectionSpec subclass: #SSWDBOrderedStaticCollectionSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBKeyedStaticCollectionSpec subclass: #SSWDBStaticDictionarySpec instanceVariableNames: 'keyClass isKeyDependent isKeyRelated keyTableForRead keyTableForRefresh deleteKeysStatement' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBOrderedStaticCollectionSpec subclass: #SSWDBArrayedStaticCollectionSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBOwnedCollectionSpec subclass: #SSWDBOwnedCacheDictionarySpec instanceVariableNames: 'keyAccessor' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBOwnedCollectionSpec subclass: #SSWDBSortedOwnedCollectionSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBOwnedCacheDictionarySpec subclass: #SSWDBOwnedMultiValueCacheDictionarySpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! -"Global Aliases"! - - "Loose Methods"! !ArrayedCollection methodsFor! @@ -252,6 +273,7 @@ staticCollectionSpecClass ^SSWDBArrayedStaticCollectionSpec ! ! + !ArrayedCollection categoriesForMethods! _dbAdd:suggestedIndex:!adding!private! ! staticCollectionSpecClass!constants!private! ! @@ -274,6 +296,7 @@ beTargetClassOf: aCollectionSpec Initialize aCollectionSpec accordingly" aCollectionSpec targetClass: self! ! + !Class categoriesForMethods! beKeyClassOf:!accessing!public! ! beTargetClassOf:!accessing!public! ! @@ -399,6 +422,7 @@ staticCollectionSpecClass but should route configuration through of:specClass: " ^self subclassResponsibility! ! + !Collection categoriesForMethods! _dbAdd:!private!restore-internal! ! _dbAdd:suggestedIndex:!adding!private! ! @@ -429,6 +453,7 @@ of: targetClass owner: aSymbol ^self new of: targetClass owner: aSymbol ! ! + !Collection class categoriesForMethods! of:!public!specification! ! of:owner:!public!specification! ! @@ -545,6 +570,7 @@ staticDictionarySpecClass staticMultiValueCacheDictionarySpecClass ^SSWDBStaticMultiValueCacheDictionarySpec! ! + !Dictionary categoriesForMethods! _dbAdd:suggestedIndex:!adding!private! ! of:!public!specification! ! @@ -572,6 +598,7 @@ staticCollectionSpecClass ^SSWDBOrderedStaticCollectionSpec ! ! + !SequenceableCollection categoriesForMethods! isOrdered!public!testing! ! staticCollectionSpecClass!constants!private! ! @@ -586,6 +613,7 @@ staticCollectionSpecClass but should route configuration through of:specClass: " ^SSWDBHashedStaticCollectionSpec! ! + !Set categoriesForMethods! staticCollectionSpecClass!constants!private! ! ! @@ -628,6 +656,7 @@ staticCollectionSpecClass ^SSWDBSortedStaticCollectionSpec ! ! + !SortedCollection categoriesForMethods! _dbAdd:!comparing!private! ! orderingSpecsFor:in:!accessing!private! ! @@ -650,6 +679,7 @@ beTargetClassOf: aTableComponent super beTargetClassOf: aTableComponent. aTableComponent beValueDependent! ! + !SSWDBDependentWrapper categoriesForMethods! beKeyClassOf:!defining!public! ! beTargetClassOf:!defining!public! ! @@ -670,6 +700,7 @@ beTargetClassOf: aTableComponent self relatedObject beTargetClassOf: aTableComponent. aTableComponent beValueRelated! ! + !SSWDBRelatedWrapper categoriesForMethods! beKeyClassOf:!defining!public! ! beTargetClassOf:!defining!public! ! @@ -690,6 +721,7 @@ beTargetClassOf: aTableComponent self unrelatedObject beTargetClassOf: aTableComponent. aTableComponent beValueUnrelated! ! + !SSWDBUnrelatedWrapper categoriesForMethods! beKeyClassOf:!defining!public! ! beTargetClassOf:!defining!public! ! diff --git a/ReStore/SSW ReStore Tables.pax b/ReStore/SSW ReStore Tables.pax index 0e5708d..0c4580d 100644 --- a/ReStore/SSW ReStore Tables.pax +++ b/ReStore/SSW ReStore Tables.pax @@ -26,6 +26,7 @@ package classNames add: #SSWDBInstVarWithFieldName; add: #SSWDBIntermediateTable; add: #SSWDBNonParameterizedControlField; + add: #SSWDBPolymorphicDataField; add: #SSWDBPrivateAccessor; add: #SSWDBQueryField; add: #SSWDBQueryTable; @@ -326,6 +327,12 @@ SSWDBControlField subclass: #SSWDBNonParameterizedControlField poolDictionaries: '' classInstanceVariableNames: ''! +SSWDBDataField subclass: #SSWDBPolymorphicDataField + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + "Loose Methods"! !Class methodsFor! diff --git a/ReStore/SSW ReStore Tests.pax b/ReStore/SSW ReStore Tests.pax index 1743cc3..cf4c9a7 100644 --- a/ReStore/SSW ReStore Tests.pax +++ b/ReStore/SSW ReStore Tests.pax @@ -10,6 +10,8 @@ package classNames add: #AbstractB; add: #ConcreteA; add: #ConcreteB; + add: #ConcreteReferenceA; + add: #ConcreteReferenceB; add: #DetailedPerson; add: #DetailedPerson1; add: #DetailedPerson2; @@ -210,6 +212,18 @@ Object subclass: #AbstractA poolDictionaries: '' classInstanceVariableNames: ''! +Object subclass: #ConcreteReferenceA + instanceVariableNames: 'name' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +Object subclass: #ConcreteReferenceB + instanceVariableNames: 'number' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + Object subclass: #FieldNameTest instanceVariableNames: 'id name description' classVariableNames: '' @@ -313,7 +327,7 @@ Object subclass: #TypeTest classInstanceVariableNames: ''! AbstractA subclass: #AbstractB - instanceVariableNames: '' + instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! diff --git a/ReStore/SSW ReStore for Dolphin.pax b/ReStore/SSW ReStore for Dolphin.pax index d45d7fe..c44b68e 100644 --- a/ReStore/SSW ReStore for Dolphin.pax +++ b/ReStore/SSW ReStore for Dolphin.pax @@ -17,6 +17,7 @@ package methodNames add: #CompiledCode -> #sswWritesInstVar:at:; add: #DateAndTime -> #withResolution:; add: #GUID -> #writeSQLOn:; + add: #OrderedCollection -> #identityIncludes:; add: #Presenter -> #respondsTo:; add: #Process -> #isExpectedToResumePromptly; add: #Process -> #isInIDECallStack; @@ -28,6 +29,8 @@ package methodNames add: #SSWDBBlockArgument -> #preProcessNextMessageFor:in:; add: #SSWDBBlockArgument -> #simulateMethod:withArguments:; add: #SSWDBBlockArgument -> #stackFrameDetect:; + add: #SSWDBOwnedCollectionSpec -> #elementsIn:notIn:; + add: #SSWDBOwnedCollectionSpec -> #hasCollection:anyAdditionsOrRemovalsFrom:; add: #SSWDBProtoObject -> #perform:; add: #SSWDBProtoObject -> #perform:with:; add: #SSWDBProtoObject -> #perform:with:with:; @@ -100,6 +103,7 @@ package setPrerequisites: #( '..\Core\Object Arts\Dolphin\Base\Dolphin Legacy Date & Time' '..\Core\Object Arts\Dolphin\MVP\Base\Dolphin MVP Base' 'SSW ReStore Base Additions' + 'SSW ReStore Collections' 'SSW ReStore Main' 'SSW ReStore ODBC' 'SSW ReStore Querying' @@ -227,6 +231,22 @@ reStoreNewUnique!persistency!private! ! writeSQLTypeOn:using:!persistency!private! ! ! +!OrderedCollection methodsFor! + +identityIncludes: anObject + "Backport from D8" + + "Implementation Note: Override superclass to provide a more efficient implementation using the identity search primitive." + + ^(self + basicIdentityIndexOf: anObject + from: firstIndex + to: lastIndex) ~~ 0! ! + +!OrderedCollection categoriesForMethods! +identityIncludes:!public!searching! ! +! + !Presenter methodsFor! respondsTo: selector @@ -508,6 +528,21 @@ platformClass platformClass!constants!public! ! ! +!SSWDBOwnedCollectionSpec methodsFor! + +elementsIn: aCollection notIn: anotherCollection + + ^aCollection reject: [ :each | anotherCollection identityIncludes: each]! + +hasCollection: updatedCollection anyAdditionsOrRemovalsFrom: originalCollection + + ^updatedCollection size ~= originalCollection size or: [updatedCollection anySatisfy: [ :each | (originalCollection identityIncludes: each) not]]! ! + +!SSWDBOwnedCollectionSpec categoriesForMethods! +elementsIn:notIn:!accessing!private! ! +hasCollection:anyAdditionsOrRemovalsFrom:!private!testing! ! +! + !SSWDBProtoObject methodsFor! perform: selector diff --git a/ReStore/SSWDBDataField.cls b/ReStore/SSWDBDataField.cls index b036f28..6e8b107 100644 --- a/ReStore/SSWDBDataField.cls +++ b/ReStore/SSWDBDataField.cls @@ -1,19 +1,43 @@ -"Filed out from Dolphin Smalltalk"! - -SSWDBStaticField subclass: #SSWDBDataField - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - classInstanceVariableNames: ''! -SSWDBDataField guid: (GUID fromString: '{caf73965-42bb-4a4b-bf79-34f5a71d3394}')! -SSWDBDataField comment: ''! -!SSWDBDataField categoriesForClass!Unclassified! ! -!SSWDBDataField methodsFor! - -populateObject: anObject with: aValue - - (self convertValue: aValue) ifNotNil: [ :obj | self accessor value: obj in: anObject]! ! -!SSWDBDataField categoriesForMethods! -populateObject:with:!actions!private! ! -! - +"Filed out from Dolphin Smalltalk"! + +SSWDBStaticField subclass: #SSWDBDataField + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +SSWDBDataField guid: (GUID fromString: '{caf73965-42bb-4a4b-bf79-34f5a71d3394}')! + +SSWDBDataField comment: ''! + +!SSWDBDataField categoriesForClass!Unclassified! ! + +!SSWDBDataField methodsFor! + +asPolymorphicDataField + + | polymorphic | + + polymorphic := SSWDBPolymorphicDataField new. + + polymorphic + name: self name; + table: self table; + accessor: self accessor; + columnIndex: self columnIndex; + targetClass: self targetClass. + + self isDependent ifTrue: [polymorphic beDependent]. + self isRelated ifTrue: [polymorphic beRelated]. + + ^polymorphic! + +populateObject: anObject with: aValue + + (self convertValue: aValue) ifNotNil: [ :obj | self accessor value: obj in: anObject]! ! + +!SSWDBDataField categoriesForMethods! +asPolymorphicDataField!converting!public! ! +populateObject:with:!actions!private! ! +! + diff --git a/ReStore/SSWDBField.cls b/ReStore/SSWDBField.cls index 78d11c8..2ddfdef 100644 --- a/ReStore/SSWDBField.cls +++ b/ReStore/SSWDBField.cls @@ -5,11 +5,15 @@ SSWDBTableComponent subclass: #SSWDBField classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBField guid: (GUID fromString: '{266e4dd6-398e-11d5-b1df-444553540000}')! + SSWDBField comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWDBField categoriesForClass!Unclassified! ! + !SSWDBField methodsFor! = anSSWDBField @@ -197,6 +201,7 @@ writeSQLOn: aStream aStream nextPut: $.; nextPutIdentifier: self name! ! + !SSWDBField categoriesForMethods! =!comparing!public! ! aboutToBeUnstored:!actions!public! ! diff --git a/ReStore/SSWDBInheritedTable.cls b/ReStore/SSWDBInheritedTable.cls index b511524..0d97ee6 100644 --- a/ReStore/SSWDBInheritedTable.cls +++ b/ReStore/SSWDBInheritedTable.cls @@ -5,11 +5,15 @@ SSWDBTable subclass: #SSWDBInheritedTable classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBInheritedTable guid: (GUID fromString: '{266e4dcd-398e-11d5-b1df-444553540000}')! + SSWDBInheritedTable comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWDBInheritedTable categoriesForClass!Unclassified! ! + !SSWDBInheritedTable methodsFor! classField @@ -29,6 +33,12 @@ classField: anSSWDBField classField := anSSWDBField! +equivalentDataFieldTo: aPolymorphicDataField + + "Look for the equivalent (same-named) field as aPolymorphicDataField in this table" + + ^self dataFields detect: [ :each | each name = aPolymorphicDataField name] ifNone: [nil]! + initializeClassField: aDBField ^aDBField @@ -87,13 +97,16 @@ withAllFields table := self reStore tableForClass: cls. table dataFields do: [ :field | - (withAllFields hasFieldAccessing: field accessor name) ifFalse: - [withAllFields dataFields add: field]]]. + (withAllFields fieldAccessing: field accessor name) + ifNil: [withAllFields dataFields add: field] + ifNotNil: [ :existingField | withAllFields dataFields remove: existingField; add: field asPolymorphicDataField]]]. ^withAllFields! ! + !SSWDBInheritedTable categoriesForMethods! classField!accessing!public! ! classField:!accessing!public! ! +equivalentDataFieldTo:!accessing!public! ! initializeClassField:!defining!private! ! instanceClassFromRow:!instance creation!private! ! recoverExactClassInstanceFromRow:into:!private! ! diff --git a/ReStore/SSWDBOwnedCollectionSpec.cls b/ReStore/SSWDBOwnedCollectionSpec.cls index a9497a5..d292d8a 100644 --- a/ReStore/SSWDBOwnedCollectionSpec.cls +++ b/ReStore/SSWDBOwnedCollectionSpec.cls @@ -5,11 +5,15 @@ SSWDBCollectionSpec subclass: #SSWDBOwnedCollectionSpec classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBOwnedCollectionSpec guid: (GUID fromString: '{fb82fd82-49e2-11d5-b1df-0010a70883e2}')! + SSWDBOwnedCollectionSpec comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWDBOwnedCollectionSpec categoriesForClass!Unclassified! ! + !SSWDBOwnedCollectionSpec methodsFor! allElementsIn: aCollection @@ -46,14 +50,6 @@ deleteQuery conditions: (SSWSQLCondition field: self ownerField equalTo: SSWSQLQueryParameter); yourself! -elementsIn: aCollection notIn: anotherCollection - - ^aCollection reject: [ :each | anotherCollection identityIncludes: each]! - -hasCollection: updatedCollection anyAdditionsOrRemovalsFrom: originalCollection - - ^updatedCollection size ~= originalCollection size or: [updatedCollection anySatisfy: [ :each | (originalCollection identityIncludes: each) not]]! - orderingSpecs orderingSpecs isNil ifTrue: [self setOrderingSpecs]. @@ -289,13 +285,12 @@ targetClass: aClass targetTable ^self reStore tableForClass: self targetClass! ! + !SSWDBOwnedCollectionSpec categoriesForMethods! allElementsIn:!accessing!private! ! copyCollection:!actions!public! ! dbInstancesFor:!accessing!public! ! deleteQuery!accessing-queries!public! ! -elementsIn:notIn:!accessing!private! ! -hasCollection:anyAdditionsOrRemovalsFrom:!private!testing! ! orderingSpecs!accessing!public! ! orderingSpecs:!accessing!public! ! owner:!accessing!public! ! diff --git a/ReStore/SSWDBPolymorphicDataField.cls b/ReStore/SSWDBPolymorphicDataField.cls new file mode 100644 index 0000000..f571caa --- /dev/null +++ b/ReStore/SSWDBPolymorphicDataField.cls @@ -0,0 +1,26 @@ +"Filed out from Dolphin Smalltalk"! + +SSWDBDataField subclass: #SSWDBPolymorphicDataField + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +SSWDBPolymorphicDataField guid: (GUID fromString: '{3e2db01c-9189-4be8-a069-7701c2fa1343}')! + +SSWDBPolymorphicDataField comment: ''! + +!SSWDBPolymorphicDataField categoriesForClass!Unclassified! ! + +!SSWDBPolymorphicDataField methodsFor! + +populateObject: anObject with: aValue from: anSSWDBTable + + "For polymorphic fields ask anSSWDBTable for its concrete equivalent to the receiver to carry this out" + + ^(anSSWDBTable equivalentDataFieldTo: self) ifNotNil: [ :concreteField | concreteField populateObject: anObject with: aValue from: anSSWDBTable]! ! + +!SSWDBPolymorphicDataField categoriesForMethods! +populateObject:with:from:!accessing!public! ! +! + diff --git a/ReStore/SSWDBQueryTableField.cls b/ReStore/SSWDBQueryTableField.cls index ba833d0..1f116b8 100644 --- a/ReStore/SSWDBQueryTableField.cls +++ b/ReStore/SSWDBQueryTableField.cls @@ -5,11 +5,15 @@ SSWDBQueryField subclass: #SSWDBQueryTableField classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBQueryTableField guid: (GUID fromString: '{266e4dca-398e-11d5-b1df-444553540000}')! + SSWDBQueryTableField comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWDBQueryTableField categoriesForClass!Unclassified! ! + !SSWDBQueryTableField methodsFor! = anSSWDBField @@ -40,6 +44,10 @@ isInlined ^self field isInlined! +populateObject: anObject with: aValue from: anSSWDBTable + + "A no-op for query fields"! + printOn: aStream super printOn: aStream. @@ -89,6 +97,7 @@ writeSQLOn: aStream aStream nextPut: $.; nextPutIdentifier: self name! ! + !SSWDBQueryTableField categoriesForMethods! =!comparing!public! ! accesses:!public!testing! ! @@ -96,6 +105,7 @@ accessorPath!accessing!public! ! accessorPath:!accessing!public! ! hash!comparing!public! ! isInlined!public!testing! ! +populateObject:with:from:!public! ! printOn:!output!public! ! table!accessing!public! ! table:!accessing!public! ! @@ -116,6 +126,7 @@ forField: anSSWDBField in: anSSWDBQueryTable path: anArray table: anSSWDBQueryTable; accessorPath: anArray; yourself! ! + !SSWDBQueryTableField class categoriesForMethods! forField:in:!instance creation!public! ! forField:in:path:!instance creation!public! ! diff --git a/ReStore/SSWDBStaticField.cls b/ReStore/SSWDBStaticField.cls index f9a8e06..04dce42 100644 --- a/ReStore/SSWDBStaticField.cls +++ b/ReStore/SSWDBStaticField.cls @@ -5,11 +5,15 @@ SSWDBField subclass: #SSWDBStaticField classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWDBStaticField guid: (GUID fromString: '{266e4dd7-398e-11d5-b1df-444553540000}')! + SSWDBStaticField comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWDBStaticField categoriesForClass!Unclassified! ! + !SSWDBStaticField methodsFor! applyValueFromRow: aDBRow to: anObject @@ -39,6 +43,12 @@ populateObject: anObject with: aValue self subclassResponsibility! +populateObject: anObject with: aValue from: anSSWDBTable + + "Populate the aspect of anObject related to this field with aValue sourced from anSSWDBTable" + + (self table == anSSWDBTable or: [self table = anSSWDBTable]) ifTrue: [self populateObject: anObject with: aValue]! + readAllFor: aCollection | ids stream allResults | @@ -91,12 +101,14 @@ writeSQLDefinitionOn: aStream super writeSQLDefinitionOn: aStream. aStream space. self targetClass writeSQLTypeOn: aStream using: self sqlDialect! ! + !SSWDBStaticField categoriesForMethods! applyValueFromRow:to:!actions!public! ! applyValueIfChangedFromRow:to:!actions!public! ! convertValue:!actions!public! ! isValidForPersistence!public! ! populateObject:with:!actions!private! ! +populateObject:with:from:!actions!private! ! readAllFor:!actions!public! ! readAllQuery!accessing!public! ! targetClass!accessing!public! ! diff --git a/ReStore/SSWDBTable.cls b/ReStore/SSWDBTable.cls index 2f9ae89..9482e4b 100644 --- a/ReStore/SSWDBTable.cls +++ b/ReStore/SSWDBTable.cls @@ -389,6 +389,12 @@ dependentDataFieldsSelect: aBlock ^self dataFields select: [ :field | field isDependent and: [aBlock value: field]]! +equivalentDataFieldTo: aPolymorphicDataField + + "No polymorphic equivalents here" + + ^nil! + fieldAccessing: aSymbol "Determine and return the field of the receiver which accesses the inst var named aSymbol of the receiver's instanceClass" @@ -912,6 +918,7 @@ deleteStatementGeneratedFrom:!accessing!public! ! dependentComponents!accessing!public! ! dependentDataFields!evaluating!public! ! dependentDataFieldsSelect:!evaluating!public! ! +equivalentDataFieldTo:!accessing!public! ! fieldAccessing:!evaluating!public! ! fieldNamed:!evaluating!public! ! fieldsAccessing:!evaluating!public! ! diff --git a/ReStore/SSWODBCRow.cls b/ReStore/SSWODBCRow.cls index 00230c0..82ee51a 100644 --- a/ReStore/SSWODBCRow.cls +++ b/ReStore/SSWODBCRow.cls @@ -1,74 +1,78 @@ -"Filed out from Dolphin Smalltalk"! - -DBRow subclass: #SSWODBCRow - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - classInstanceVariableNames: ''! -SSWODBCRow guid: (GUID fromString: '{a08f875a-3b6c-4962-9633-730ff9ab89b2}')! -SSWODBCRow comment: 'ReStore -©2019 John Aspinall -https://github.com/rko281/ReStore'! -!SSWODBCRow categoriesForClass!Kernel-Objects! ! -!SSWODBCRow methodsFor! - -deAliasQueryFieldsFor: aDBQueryTable - - "The receiver is derived from a query containing the given SSWDBQueryTable as an alias for an actual SSWDBTable. - To allow field lookup by the original SSWDBTable, initialize the field map based on the original, non-aliased, fields" - - columns := - columns collect: - [ :each | - each field - ifNil: [each] - ifNotNil: [ :field | field table == aDBQueryTable ifTrue: [each copy field: field field] ifFalse: [each copy field: nil]]]! - -initializeFromBuffer: anSSWODBCBuffer - - columns := anSSWODBCBuffer columns. - contents := anSSWODBCBuffer objects. - status := anSSWODBCBuffer status! - -lookupField: aField - - "Optimised method: - Use the columnIndex where available; - In the common case fields will be identical; check for this first. - Use to:do: to maximize inlining and avoid full blocks. " - - aField columnIndex ifNotNil: - [ :index | - (columns at: index ifAbsent: [nil]) ifNotNil: - [ :column | - (column field == aField or: [column field = aField]) ifTrue: [^contents at: index]]]. - - 1 to: columns size do: [ :index | (columns at: index) field == aField ifTrue: [^contents at: index]]. - 1 to: columns size do: [ :index | (columns at: index) field = aField ifTrue: [^contents at: index]]. - - ^nil! - -lookupIDField: aField - - "Optimised lookup for ID fields which are usually first" - - ^(columns at: 1) field == aField - ifTrue: [contents at: 1] - ifFalse: [self lookupField: aField]! - -populateObject: anObject from: anSSWDBTable - - 1 to: columns size do: - [ :index | - (columns at: index) field ifNotNil: - [ :field | - (field table == anSSWDBTable or: [field table = anSSWDBTable]) ifTrue: - [field populateObject: anObject with: (contents at: index)]]]! ! -!SSWODBCRow categoriesForMethods! -deAliasQueryFieldsFor:!initializing!public! ! -initializeFromBuffer:!initializing!public! ! -lookupField:!accessing!public! ! -lookupIDField:!accessing!public! ! -populateObject:from:!initializing!private! ! -! - +"Filed out from Dolphin Smalltalk"! + +DBRow subclass: #SSWODBCRow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + classInstanceVariableNames: ''! + +SSWODBCRow guid: (GUID fromString: '{a08f875a-3b6c-4962-9633-730ff9ab89b2}')! + +SSWODBCRow comment: 'ReStore +©2019 John Aspinall +https://github.com/rko281/ReStore'! + +!SSWODBCRow categoriesForClass!Kernel-Objects! ! + +!SSWODBCRow methodsFor! + +deAliasQueryFieldsFor: aDBQueryTable + + "The receiver is derived from a query containing the given SSWDBQueryTable as an alias for an actual SSWDBTable. + To allow field lookup by the original SSWDBTable, initialize the field map based on the original, non-aliased, fields" + + columns := + columns collect: + [ :each | + each field + ifNil: [each] + ifNotNil: [ :field | field table == aDBQueryTable ifTrue: [each copy field: field field] ifFalse: [each copy field: nil]]]! + +initializeFromBuffer: anSSWODBCBuffer + + columns := anSSWODBCBuffer columns. + contents := anSSWODBCBuffer objects. + status := anSSWODBCBuffer status! + +lookupField: aField + + "Optimised method: + Use the columnIndex where available; + In the common case fields will be identical; check for this first. + Use to:do: to maximize inlining and avoid full blocks. " + + aField columnIndex ifNotNil: + [ :index | + (columns at: index ifAbsent: [nil]) ifNotNil: + [ :column | + (column field == aField or: [column field = aField]) ifTrue: [^contents at: index]]]. + + 1 to: columns size do: [ :index | (columns at: index) field == aField ifTrue: [^contents at: index]]. + 1 to: columns size do: [ :index | (columns at: index) field = aField ifTrue: [^contents at: index]]. + + ^nil! + +lookupIDField: aField + + "Optimised lookup for ID fields which are usually first" + + ^(columns at: 1) field == aField + ifTrue: [contents at: 1] + ifFalse: [self lookupField: aField]! + +populateObject: anObject from: anSSWDBTable + + 1 to: columns size do: + [ :index | + (columns at: index) field ifNotNil: + [ :field | + field populateObject: anObject with: (contents at: index) from: anSSWDBTable]]! ! + +!SSWODBCRow categoriesForMethods! +deAliasQueryFieldsFor:!initializing!public! ! +initializeFromBuffer:!initializing!public! ! +lookupField:!accessing!public! ! +lookupIDField:!accessing!public! ! +populateObject:from:!initializing!private! ! +! + diff --git a/ReStore/SSWReStoreDataIDTest.cls b/ReStore/SSWReStoreDataIDTest.cls index 9f69ac6..a7eb9f3 100644 --- a/ReStore/SSWReStoreDataIDTest.cls +++ b/ReStore/SSWReStoreDataIDTest.cls @@ -1,15 +1,19 @@ -"Filed out from Dolphin Smallalk"! +"Filed out from Dolphin Smalltalk"! SSWReStoreIDTest subclass: #SSWReStoreDataIDTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWReStoreDataIDTest guid: (GUID fromString: '{f5d07b7c-08c7-401c-9818-185ec77d38c7}')! + SSWReStoreDataIDTest comment: 'ReStore ©2019 John Aspinall https://github.com/rko281/ReStore'! + !SSWReStoreDataIDTest categoriesForClass!Unclassified! ! + !SSWReStoreDataIDTest methodsFor! createTestData @@ -187,6 +191,7 @@ test9CheckForUnknownDuplicateID testClass ^ReStoreTestWithID! ! + !SSWReStoreDataIDTest categoriesForMethods! createTestData!public!running! ! test1VerifySetUp!public!unit tests! ! diff --git a/ReStore/SSWReStoreHierarchyTest.cls b/ReStore/SSWReStoreHierarchyTest.cls index 5682811..79e8000 100644 --- a/ReStore/SSWReStoreHierarchyTest.cls +++ b/ReStore/SSWReStoreHierarchyTest.cls @@ -302,7 +302,35 @@ testRetrievingIncompatibleClassRaisesError "Attempt to retrieve what is actually a DetailedPerson as if it were a MidPerson (siblings)" self should: [(reStore deferredObjectOfClass: MidPerson withID: detailedID) firstName] raise: Error description: 'Proxy for MidPerson retrieved a DetailedPerson1 from the database.'. "As above, but parent of the declared class" - self should: [(reStore deferredObjectOfClass: SubPerson withID: midID) firstName] raise: Error description: 'Proxy for SubPerson retrieved a MidPerson from the database.'! ! + self should: [(reStore deferredObjectOfClass: SubPerson withID: midID) firstName] raise: Error description: 'Proxy for SubPerson retrieved a MidPerson from the database.'! + +testSharedTableHierarchyReference + + "Test for issue #7 - Issue with retrieval of polymorphic collections" + + | ownerA ownerB owners | + + reStore + addClassWithSubclasses: AbstractA; + addClass: ConcreteReferenceA; + addClass: ConcreteReferenceB; + destroyAllClasses; + synchronizeAllClasses. + + ownerA := ConcreteA new reference: (ConcreteReferenceA new name: 'a'). + ownerB := ConcreteB new reference: (ConcreteReferenceB new number: 123). + {ownerA. ownerB} storeAllIn: reStore. + + reStore simulateReconnect. + + owners := (AbstractA storedInstancesIn: reStore) asOrderedCollection. + ownerA := owners detect: [ :each | each class = ConcreteA]. + ownerB := owners detect: [ :each | each class = ConcreteB]. + + self assert: ownerA reference isDBProxy. + self assert: ownerA reference class = ConcreteReferenceA. + self assert: ownerB reference isDBProxy. + self assert: ownerB reference class = ConcreteReferenceB.! ! !SSWReStoreHierarchyTest categoriesForMethods! _testClassOfProxyOfIndirectInstanceOf:!private!unit tests! ! @@ -329,5 +357,6 @@ testInheritanceStructureWithoutInheritancePersistentIntermediateOldFormat!public testInheritanceStructureWithoutIntermediateInheritancePersistentIntermediate!public!unit tests! ! testInheritanceStructureWithoutIntermediateInheritancePersistentIntermediateOldFormat!public!unit tests! ! testRetrievingIncompatibleClassRaisesError!public!unit tests! ! +testSharedTableHierarchyReference!public!running! ! ! diff --git a/ReStore/SSWSQLite3Row.cls b/ReStore/SSWSQLite3Row.cls index 4b192d3..3d93175 100644 --- a/ReStore/SSWSQLite3Row.cls +++ b/ReStore/SSWSQLite3Row.cls @@ -5,9 +5,13 @@ SQLite3Row subclass: #SSWSQLite3Row classVariableNames: '' poolDictionaries: '' classInstanceVariableNames: ''! + SSWSQLite3Row guid: (GUID fromString: '{35b12246-cadd-4829-a233-07b0cf83b37e}')! + SSWSQLite3Row comment: ''! + !SSWSQLite3Row categoriesForClass!SQLite3-Core-Database! ! + !SSWSQLite3Row methodsFor! at: aKey put: anObject ^values at: aKey put: anObject! @@ -80,12 +84,12 @@ populateObject: anObject from: anSSWDBTable [ :index | (columns at: index) field ifNotNil: [ :field | - (field table == anSSWDBTable or: [field table = anSSWDBTable]) ifTrue: - [field populateObject: anObject with: (values at: index)]]]! + field populateObject: anObject with: (values at: index) from: anSSWDBTable]]! values ^values! ! + !SSWSQLite3Row categoriesForMethods! at:put:!accessing!public! ! atIndex:!accessing!public! !