diff --git a/Glorp-Unit-Tests/GlorpAccount.class.st b/Glorp-Unit-Tests/GlorpAccount.class.st new file mode 100644 index 00000000..be48bd2f --- /dev/null +++ b/Glorp-Unit-Tests/GlorpAccount.class.st @@ -0,0 +1,27 @@ +Class { + #name : #GlorpAccount, + #superclass : #GlorpTestModelClass, + #instVars : [ + 'id', + 'name' + ], + #category : #'Glorp-Unit-Tests-Models' +} + +{ #category : #'instance creation' } +GlorpAccount class >> knownAs: aName [ + + ^ self new initializeKnownAs: aName +] + +{ #category : #accessing } +GlorpAccount >> id [ + + ^ id +] + +{ #category : #initialization } +GlorpAccount >> initializeKnownAs: aName [ + + name := aName +] diff --git a/Glorp-Unit-Tests/GlorpOneToOneMappingTests.class.st b/Glorp-Unit-Tests/GlorpOneToOneMappingTests.class.st new file mode 100644 index 00000000..3cd3a462 --- /dev/null +++ b/Glorp-Unit-Tests/GlorpOneToOneMappingTests.class.st @@ -0,0 +1,177 @@ +Class { + #name : #GlorpOneToOneMappingTests, + #superclass : #GlorpSessionBasedTest, + #instVars : [ + 'sessionsPool', + 'lastPoolSessionIndex' + ], + #category : #'Glorp-Unit-Tests-Tests' +} + +{ #category : #accessing } +GlorpOneToOneMappingTests >> createNewFreshSession [ + + | freshSession | + + freshSession := GlorpSession new. + freshSession accessor: ( DatabaseAccessor forLogin: self defaultLogin ). + freshSession system: system copy. + freshSession loginIfError: [ :error | self halt: error description ]. + ^ freshSession +] + +{ #category : #accessing } +GlorpOneToOneMappingTests >> defaultLogin [ + + ^ GlorpDatabaseLoginResource defaultLogin +] + +{ #category : #'test support' } +GlorpOneToOneMappingTests >> inFreshTransactionDo: aBlock [ + + self + withFreshSessionDo: [ :sess | + sess transact: aBlock + ] +] + +{ #category : #'test support' } +GlorpOneToOneMappingTests >> inTransactionDo: aBlock [ + + session transact: aBlock. + session reset +] + +{ #category : #initialization } +GlorpOneToOneMappingTests >> setUp [ + + super setUp. + system := GlorpTradeDescriptorSystem forPlatform: session platform. + session system: system. + session recreateTablesIfError: [ :error | Error signal: error description ]. + + sessionsPool := OrderedCollection new + add: self createNewFreshSession; + add: self createNewFreshSession; + add: self createNewFreshSession; + yourself. + + lastPoolSessionIndex := -1 +] + +{ #category : #initialization } +GlorpOneToOneMappingTests >> tearDown [ + + super tearDown. + + sessionsPool + do: #reset; + do: #logout. + + sessionsPool := nil +] + +{ #category : #'test - single session' } +GlorpOneToOneMappingTests >> testRegisterAccountPreviouslyUsingOneSession [ + + | account trade found | + + self assert: ( session read: GlorpAccount ) isEmpty. + account := GlorpAccount knownAs: 'example account'. + self inTransactionDo: [ session register: account ]. + self assert: ( session read: GlorpAccount ) size equals: 1. + + self assert: ( session read: GlorpTrade ) isEmpty. + trade := GlorpTrade within: account. + + self inTransactionDo: [ session register: trade ]. + + found := session read: GlorpTrade. + self assert: found size equals: 1. + found := found first. + self assert: found id equals: trade id. + self assert: found account id equals: account id +] + +{ #category : #'test - session pool' } +GlorpOneToOneMappingTests >> testRegisterAccountPreviouslyUsingSessionPool [ + + | account trade found | + + self withFreshSessionDo: [ :sess | self assert: ( sess read: GlorpAccount ) isEmpty ]. + account := GlorpAccount knownAs: 'example account'. + self inFreshTransactionDo: [ :sess | sess register: account ]. + self withFreshSessionDo: [ :sess | self assert: ( sess read: GlorpAccount ) size equals: 1 ]. + + self withFreshSessionDo: [ :sess | self assert: ( sess read: GlorpTrade ) isEmpty ]. + trade := GlorpTrade within: account. + + self inFreshTransactionDo: [ :sess | sess register: trade ]. + + self withFreshSessionDo: [ :sess | found := sess read: GlorpTrade ]. + self assert: found size equals: 1. + found := found first. + self assert: found id equals: trade id. + self assert: found account id equals: account id +] + +{ #category : #'test - single session' } +GlorpOneToOneMappingTests >> testRegisterAccountTransitivelyUsingOneSession [ + + | account trade found | + + self assert: ( session read: GlorpAccount ) isEmpty. + self assert: ( session read: GlorpTrade ) isEmpty. + + account := GlorpAccount knownAs: 'example account'. + trade := GlorpTrade within: account. + + self inTransactionDo: [ session register: trade ]. + + found := session read: GlorpAccount. + self assert: found size equals: 1. + self assert: found first id equals: account id. + + found := session read: GlorpTrade. + self assert: found size equals: 1. + found := found first. + self assert: found id equals: trade id. + self assert: found account id equals: account id +] + +{ #category : #'test - session pool' } +GlorpOneToOneMappingTests >> testRegisterAccountTransitivelyUsingSessionsPool [ + + | account trade found | + + self withFreshSessionDo: [ :sess | self assert: ( sess read: GlorpAccount ) isEmpty ]. + self withFreshSessionDo: [ :sess | self assert: ( sess read: GlorpTrade ) isEmpty ]. + + account := GlorpAccount knownAs: 'example account'. + trade := GlorpTrade within: account. + + self inFreshTransactionDo: [ :sess | sess register: trade ]. + + self withFreshSessionDo: [ :sess | found := sess read: GlorpAccount ]. + self assert: found size equals: 1. + self assert: found first id equals: account id. + + self withFreshSessionDo: [ :sess | found := sess read: GlorpTrade ]. + self assert: found size equals: 1. + found := found first. + self assert: found id equals: trade id. + self assert: found account id equals: account id +] + +{ #category : #'test support' } +GlorpOneToOneMappingTests >> withFreshSessionDo: aBlock [ + + | currentIndex freshSession | + + currentIndex := ( lastPoolSessionIndex + 1 rem: sessionsPool size ) + 1. + freshSession := sessionsPool at: currentIndex. + [ aBlock value: freshSession ] + ensure: [ freshSession reset. + lastPoolSessionIndex := currentIndex - 1 + ] +] diff --git a/Glorp-Unit-Tests/GlorpTrade.class.st b/Glorp-Unit-Tests/GlorpTrade.class.st new file mode 100644 index 00000000..5b46eb82 --- /dev/null +++ b/Glorp-Unit-Tests/GlorpTrade.class.st @@ -0,0 +1,33 @@ +Class { + #name : #GlorpTrade, + #superclass : #GlorpTestModelClass, + #instVars : [ + 'id', + 'account' + ], + #category : #'Glorp-Unit-Tests-Models' +} + +{ #category : #'instance creation' } +GlorpTrade class >> within: anAccount [ + + ^ self new initializeWithin: anAccount +] + +{ #category : #accessing } +GlorpTrade >> account [ + + ^ account +] + +{ #category : #accessing } +GlorpTrade >> id [ + + ^ id +] + +{ #category : #initialization } +GlorpTrade >> initializeWithin: anAccount [ + + account := anAccount +] diff --git a/Glorp-Unit-Tests/GlorpTradeDescriptorSystem.class.st b/Glorp-Unit-Tests/GlorpTradeDescriptorSystem.class.st new file mode 100644 index 00000000..beced43c --- /dev/null +++ b/Glorp-Unit-Tests/GlorpTradeDescriptorSystem.class.st @@ -0,0 +1,76 @@ +Class { + #name : #GlorpTradeDescriptorSystem, + #superclass : #GlorpTestDescriptorSystem, + #category : #'Glorp-Unit-Tests-Models' +} + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> allTableNames [ + + ^#('ACCOUNT' 'TRADE') +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> classModelForGlorpAccount: aClassModel [ + + aClassModel newAttributeNamed: #id type: Integer. + aClassModel newAttributeNamed: #name type: String +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> classModelForGlorpTrade: aClassModel [ + + aClassModel newAttributeNamed: #id type: Integer. + aClassModel newAttributeNamed: #account type: GlorpAccount +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> constructAllClasses [ + + ^(super constructAllClasses) + add: GlorpAccount; + add: GlorpTrade; + yourself +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> descriptorForGlorpAccount: aDescriptor [ + + | table | + + table := self tableNamed: 'ACCOUNT'. + aDescriptor table: table. + (aDescriptor newMapping: DirectMapping) from: #id to: (table fieldNamed: 'ID'). + (aDescriptor newMapping: DirectMapping) from: #name to: (table fieldNamed: 'NAME') +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> descriptorForGlorpTrade: aDescriptor [ + + | table accountTable | + + table := self tableNamed: 'TRADE'. + accountTable := self tableNamed: 'ACCOUNT'. + aDescriptor table: table. + (aDescriptor newMapping: DirectMapping) from: #id to: (table fieldNamed: 'ID'). + (aDescriptor newMapping: OneToOneMapping) + attributeName: #account; + join: (Join from: (table fieldNamed: 'ACCOUNT_ID') to: (accountTable fieldNamed: 'ID')) +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> tableForACCOUNT: aTable [ + + (aTable createFieldNamed: 'ID' type: platform sequence) bePrimaryKey. + (aTable createFieldNamed: 'NAME' type: (platform varchar: 20)) beNullable: false +] + +{ #category : #accessing } +GlorpTradeDescriptorSystem >> tableForTRADE: aTable [ + + | accountId | + + (aTable createFieldNamed: 'ID' type: platform sequence) bePrimaryKey. + accountId := aTable createFieldNamed: 'ACCOUNT_ID' type: (platform int4). + aTable addForeignKeyFrom: accountId to: ((self tableNamed: 'ACCOUNT') fieldNamed: 'ID') +] diff --git a/Glorp/Descriptor.class.st b/Glorp/Descriptor.class.st index 99ce3619..9f6c907a 100644 --- a/Glorp/Descriptor.class.st +++ b/Glorp/Descriptor.class.st @@ -334,6 +334,14 @@ Descriptor >> isForAssociation [ ^self describedClass == Association ] +{ #category : #testing } +Descriptor >> isPrimaryKeyAutogeneratedFor: anObject [ + "Answer if the primary keys are database-generated" + anObject class == self describedClass + ifFalse: [ self error: 'Wrong descriptor for this object' ]. + ^ self primaryTable primaryKeyFields allSatisfy: [ :field | field type isSerial ] +] + { #category : #testing } Descriptor >> isTypeMappingRoot [ ^self typeResolver isTypeMappingRoot: self diff --git a/Glorp/GlorpSession.class.st b/Glorp/GlorpSession.class.st index b4a328d8..ef54c8a3 100644 --- a/Glorp/GlorpSession.class.st +++ b/Glorp/GlorpSession.class.st @@ -525,13 +525,18 @@ GlorpSession >> isNew: anObject [ | key descriptor | (currentUnitOfWork notNil and: [currentUnitOfWork isRegistered: anObject]) ifTrue: [^false]. descriptor := self descriptorFor: anObject. - descriptor isNil ifTrue: [^false]. + descriptor ifNil: [^false]. "For embedded values we assume that they are not new. This appears to work. I can't really justify it." self needsWork: 'cross your fingers'. descriptor mapsPrimaryKeys ifFalse: [^false]. key := descriptor primaryKeyFor: anObject. - key isNil ifTrue: [^true]. + key + ifNil: [^true] + ifNotNil: [ + " We can assume is not new if the primary keys are set and database-autogenerated " + (descriptor isPrimaryKeyAutogeneratedFor: anObject) ifTrue: [ ^false ] ]. + "If the cache contains the object, but the existing entry is due to be deleted, then count this entry as a new one being added with the same primary key (ick) as the old one" ^[(self cacheContainsObject: anObject key: key) not] on: DuplicatePrimaryKeyException