Merge pull request #882 from ApptiveGrid/new-visitors-consistency-and-gc

New visitors consistency and gc

src/Soil-Core-Tests/SoilBackupTest.class.st

@@ -159,6 +159,39 @@ SoilBackupTest >> testBackupOldVersion [
 			tx3 abort ].
 ]
 
+{ #category : #tests }
+SoilBackupTest >> testBackupTheBackup [
+	| tx visitor dict secondBackup txn |
+	dict := SoilSkipListDictionary  new
+		keySize: 10;
+		maxLevel: 8;
+		yourself.
+	tx := soil newTransaction.
+	tx root: dict.
+	1 to: 100 do: [ :n | dict at: n put: n asString ].
+	tx commit.
+
+	backupSoil := Soil createOnPath: self path, #backup1.
+	visitor := SoilBackupVisitor new 
+		target: backupSoil;
+		backup: soil.
+
+	backupSoil close; open.
+
+	secondBackup := Soil createOnPath: self path, #backup2.
+	visitor := SoilBackupVisitor new 
+		target: secondBackup;
+		backup: backupSoil.
+	secondBackup open.
+
+	txn := secondBackup newTransaction.
+	self assert: txn root values size equals: 100.
+	txn abort.
+
+	secondBackup close; destroy
+
+]
+
 { #category : #tests }
 SoilBackupTest >> testBackupWithIndex [ 
 	| tx backup tx2 dict object |

src/Soil-Core-Tests/SoilIndexedDictionaryTest.class.st

@@ -420,6 +420,37 @@ SoilIndexedDictionaryTest >> testFlushIndexPages [
 	txn2 abort
 ]
 
+{ #category : #tests }
+SoilIndexedDictionaryTest >> testFreePageAfterReopen [
+	| tx tx2 tx3 blockTx tx4 tx5 |
+	(classToTest = SoilBTreeDictionary) ifTrue: [ self skip ].
+	tx := soil newTransaction.
+	tx root: dict.
+	1 to: 1125 do: [ :n | dict at: n put: n asString ].
+	tx commit.
+
+	"open a second transaction ..."
+	blockTx := soil newTransaction.
+	tx2 := soil newTransaction.
+	224 to: 899 do: [ :n |tx2 root removeKey: n ].
+	tx2 commit.
+	blockTx abort. 
+
+	soil 
+		close; 
+		reopen.
+	tx3 := soil newTransaction.
+	900 to: 905 do: [ :n | tx3 root removeKey: n ].
+	tx3 root index wrapped markAllDirty.
+	tx3 commit.
+	tx4 := soil newTransaction.
+	tx4 root at: 906 put: 906 asString.
+	tx4 root removeKey: 223.
+	tx4 commit.
+	tx5 := soil newTransaction.
+	self deny: (tx5 root index wrapped store headerPage right includes: 2)
+]
+
 { #category : #tests }
 SoilIndexedDictionaryTest >> testFreePageNotSavedRegression [
 	| tx blockTx iterator |
@@ -481,36 +512,6 @@ SoilIndexedDictionaryTest >> testFreePageReuse [
 
 ]
 
-{ #category : #tests }
-SoilIndexedDictionaryTest >> testFreePageReuseExact [
-	| tx tx2 tx3 blockTx tx4 tx5 tx15 |
-	(classToTest = SoilBTreeDictionary) ifTrue: [ self skip ].
-	tx := soil newTransaction.
-	tx root: dict.
-	1 to: 674 do: [ :n | dict at: n put: n asString ].
-	tx commit.
-
-
-	tx15 := soil newTransaction.
-	1 to: 223 do: [ :n | tx15 root removeKey: n ].
-	tx15 commit.
-	"open a second transaction ..."
-	blockTx := soil newTransaction.
-	tx2 := soil newTransaction.
-	224 to: 448 do: [ :n | tx2 root removeKey: n ].
-	tx2 commit.
-	tx3 := soil newTransaction.
-	449 to: 449 do: [ :n | tx3 root removeKey: n ].
-	tx3 commit.
-	blockTx abort.
-	tx4 := soil newTransaction.
-	tx4 root at: 675 put: 675 asString.
-	tx4 root removeKey: 450.
-	tx4 commit.
-	tx5 := soil newTransaction.
-	self deny: (tx5 root index wrapped store headerPage right includes: 2)
-]
-
 { #category : #tests }
 SoilIndexedDictionaryTest >> testFreePages [ 
 	| tx tx2 index indexManager |

src/Soil-Core/AnObsoleteSoilCloneVisitor.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #AnObsoleteSoilCloneVisitor,
+	#superclass : #SoilVisitor,
+	#category : #'Soil-Core'
+}

src/Soil-Core/Soil.class.st

@@ -217,6 +217,13 @@ Soil >> findRecord: aBlock [
 		ensure: [ tx abort ]
 ]
 
+{ #category : #'memory space' }
+Soil >> garbageCollect [
+	SoilGarbageCollectVisitor new 
+		soil: self;
+		run
+]
+
 { #category : #initialization }
 Soil >> initialize [ 
 	super initialize.

src/Soil-Core/SoilBackupVisitor.class.st

@@ -2,30 +2,21 @@ Class {
 	#name : #SoilBackupVisitor,
 	#superclass : #SoilVisitor,
 	#instVars : [
-		'source',
-		'target',
-		'seen',
-		'toBeProcessed',
-		'version'
+		'target'
 	],
 	#category : #'Soil-Core-Visitor'
 }
 
 { #category : #api }
 SoilBackupVisitor >> backup: aSoil [ 
-	| objectId |
-	source := aSoil.
+	soil := aSoil.
 	"if there is no version set we take the actual database version. This 
 	is to create a consistent backup regardless if transactions are committed 
 	while we are doing the backup"
-	version ifNil: [
-		version := aSoil control databaseVersion ]. 
+	databaseVersion ifNil: [
+		databaseVersion := aSoil control databaseVersion ]. 
 
-	self visit: source.
-
-	[ toBeProcessed isEmpty ] whileFalse: [  
-		objectId := toBeProcessed  removeFirst.
-		self visit: (source objectRepository at: objectId version: version) ].
+	self visit: soil.
 	target close
 ]
 
@@ -35,7 +26,7 @@ SoilBackupVisitor >> copyAllClusterVersions: aSoilPersistentClusterVersion [
 	"if there is no previous version is a single copy"
 	aSoilPersistentClusterVersion hasPreviousVersion 
 		ifFalse: [ ^ self copySourceCluster: aSoilPersistentClusterVersion  ].
-	versions := (source objectRepository segmentAt: aSoilPersistentClusterVersion objectId segment)
+	versions := (soil objectRepository segmentAt: aSoilPersistentClusterVersion objectId segment)
 		allVersionsAt: aSoilPersistentClusterVersion objectId index.
 	position := 0.
 	"for multiple versions we need to iterate from oldest to newest to set the
@@ -53,7 +44,7 @@ SoilBackupVisitor >> copyCluster: aSoilPersistentClusterVersion [
 		at: aSoilPersistentClusterVersion objectId
 		putBytes: aSoilPersistentClusterVersion serialize.
 	aSoilPersistentClusterVersion references do: [ :reference |
-		self process: reference ].
+		self processObjectId: reference ].
 	aSoilPersistentClusterVersion indexIds do:[ :indexId |
 		self copyIndexAt: indexId segment: aSoilPersistentClusterVersion segment ].
 	^ position 
@@ -64,7 +55,7 @@ SoilBackupVisitor >> copyCluster: aSoilPersistentClusterVersion [
 SoilBackupVisitor >> copyIndexAt: indexId segment: segmentId [
 	| sourceSegment sourceIndex targetSegment targetIndex iterator assoc |
 
-	sourceSegment := source objectRepository segmentAt: segmentId.
+	sourceSegment := soil objectRepository segmentAt: segmentId.
 	sourceIndex := sourceSegment indexManager 
 		loadIndexWithId: indexId 
 		ifNone: [ ^ self indexNotFound: indexId ].
@@ -82,7 +73,7 @@ SoilBackupVisitor >> copyIndexAt: indexId segment: segmentId [
 		assoc value isRemoved ifFalse: [ 
 			targetIndex basicAt: assoc key put: assoc value.
 			"recurse further into the values of the index"
-			self process: assoc value asSoilObjectId ] ].
+			self processObjectId: assoc value asSoilObjectId ] ].
 	targetIndex
 		flush; 
 		close.
@@ -95,18 +86,17 @@ SoilBackupVisitor >> copySourceCluster: aSoilPersistentClusterVersion [
 	^ self copyCluster: clusterCopy
 ]
 
+{ #category : #accessing }
+SoilBackupVisitor >> databaseVersion: anObject [
+
+	databaseVersion := anObject
+]
+
 { #category : #visiting }
 SoilBackupVisitor >> indexNotFound: indexId [ 
 	 Error signal: 'cannot find index with id ', indexId printString
 ]
 
-{ #category : #initialization }
-SoilBackupVisitor >> initialize [ 
-	super initialize.
-	seen := Set new.
-	toBeProcessed := OrderedCollection new
-]
-
 { #category : #visiting }
 SoilBackupVisitor >> makeCopy: aSoilPersistentClusterVersion [ 
 	^ aSoilPersistentClusterVersion copy
@@ -117,13 +107,10 @@ SoilBackupVisitor >> makeCopy: aSoilPersistentClusterVersion [
 		resetPreviousVersion.
 ]
 
-{ #category : #accessing }
-SoilBackupVisitor >> process: aSoilObjectId [ 
-	"don't continue if the objectId is the behavior description meta object"
-	((aSoilObjectId segment = 0) and: [ aSoilObjectId index = 2 ]) ifTrue: [ ^ self ].
-	(seen includes: aSoilObjectId) ifTrue: [ ^ self ].
-	seen add: aSoilObjectId.
-	toBeProcessed add: aSoilObjectId  
+{ #category : #api }
+SoilBackupVisitor >> processLoop [ 
+	super processLoop.
+	target close
 ]
 
 { #category : #accessing }
@@ -134,7 +121,7 @@ SoilBackupVisitor >> target: aSoil [
 { #category : #accessing }
 SoilBackupVisitor >> version: anObject [
 
-	version := anObject
+	databaseVersion := anObject
 ]
 
 { #category : #visiting }
@@ -167,7 +154,7 @@ SoilBackupVisitor >> visitMetaSegment: aSoilMetaSegment [
 
 { #category : #visiting }
 SoilBackupVisitor >> visitObjectSegment: aSoilObjectSegment [ 
-	self process: SoilObjectId root.
+	self processObjectId: SoilObjectId root.
 	super visitObjectSegment: aSoilObjectSegment.
 ]
 

src/Soil-Core/SoilBasicSkipList.class.st

@@ -19,7 +19,9 @@ SoilBasicSkipList class >> isAbstract [
 
 { #category : #adding }
 SoilBasicSkipList >> addDirtyPage: aPage [ 
-	dirtyPages at: aPage offset put: aPage
+	dirtyPages 
+		at: aPage offset 
+		ifAbsentPut: [ aPage ]
 ]
 
 { #category : #'instance creation' }