Merge pull request #45 from jvanecek/43-One2One-relations-raises-dupl…

…icated-exception-if-not-transitively-registered

Objects with database auto-generated primary key set are not new

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
+]

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
+			]
+]

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
+]

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')
+]

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

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