MCAncestryTest.st
author Claus Gittinger <cg@exept.de>
Mon, 14 May 2018 02:21:18 +0200
changeset 1048 582b3a028cbc
parent 281 af7f40566bc3
permissions -rw-r--r--
#FEATURE by cg class: MCMethodDefinition changed: #postloadOver:
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
258
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/monticello' }"
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
MCTestCase subclass:#MCAncestryTest
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:''
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'Monticello-Tests'
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
!MCAncestryTest methodsFor:'asserting'!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
assertCommonAncestorOf: leftName and: rightName in: options in: tree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	| left right ancestor |
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	left := self versionForName: leftName in: tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	right := self versionForName: rightName in: tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	ancestor := left commonAncestorWith: right.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	self assert: (options includes: ancestor name)
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
assertCommonAncestorOf: leftName and: rightName is: ancestorName in: tree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
	self assertCommonAncestorOf: leftName and: rightName in: (Array with: ancestorName) in: tree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
assertNamesOf: versionInfoCollection are: nameArray
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
	| names |
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
	names := versionInfoCollection collect: [:ea | ea name].
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
	self assert: names asArray = nameArray
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
assertPathTo: aSymbol is: anArray
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
	self
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
		assertNamesOf: (self tree allAncestorsOnPathTo: (self treeFrom: {aSymbol}))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
		are: anArray
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
! !
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
!MCAncestryTest methodsFor:'building'!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
tree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
	^ self treeFrom:
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
		#(c1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
			((e2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
				((e1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
					((a1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
						(('00')))))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
			(a2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
				((a1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
					(('00')))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
			(b3
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
				((b2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
					((b1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
						((b0
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
							(('00')))))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
				(a1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
					(('00')))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
			(d1)))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
twoPersonTree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
	^ self treeFrom:
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
		#(c1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
			((a4
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
				((a1)
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
				(b3
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
					((b2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
						((a1)))))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
			(b5
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
				((b2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
					((a1)))))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
versionForName: name in: tree
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
        (tree name = name) ifTrue: [^ tree].
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
        tree ancestors do: [:ea | (self versionForName: name in: ea) ifNotNil: 
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
                [^ (self versionForName: name in: ea)]].
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
        ^ nil
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
    "Modified: / 26-08-2009 / 13:35:20 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
! !
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
!MCAncestryTest methodsFor:'tests'!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
testCommonAncestors
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
	self assertCommonAncestorOf: #a2 and: #e2 is: #a1 in: self tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
	self assertCommonAncestorOf: #e2 and: #b3 is: #a1 in: self tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
	self assertCommonAncestorOf: #b2 and: #e2 is: #'00' in: self tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
	
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
	self assertCommonAncestorOf: #a4 and: #b5 in: #(b2 a1) in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
	self assertCommonAncestorOf: #b5 and: #b3 is: #b2 in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
	self assertCommonAncestorOf: #b2 and: #a4 is: #b2 in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
	self assertCommonAncestorOf: #b2 and: #b2 is: #b2 in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
	self assertCommonAncestorOf: #b2 and: #a1 is: #a1 in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
	self assertCommonAncestorOf: #a1 and: #b2 is: #a1 in: self twoPersonTree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
testDescendants
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
	| c1 a1 b3 q1 q2 c2 |
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
	c1 := self tree.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
	a1 := self treeFrom: #(a1 (('00'))).
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
	b3 := self treeFrom: #(b3
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
				((b2
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
					((b1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
						((b0
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
							(('00')))))))
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
				(a1
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
					(('00'))))).
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
	q1 := MCWorkingAncestry new addAncestor: a1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
	q2 := MCWorkingAncestry new addAncestor: q1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
	self assert: (q2 commonAncestorWith: b3) = a1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
	self assert: (b3 commonAncestorWith: q2) = a1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
	self assert: (q2 commonAncestorWith: c1) = a1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
	self assert: (c1 commonAncestorWith: q2) = a1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
	q1 addStepChild: c1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
	self assert: (q2 commonAncestorWith: c1) = q1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
	self assert: (c1 commonAncestorWith: q2) = q1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
	c2 := MCWorkingAncestry new addAncestor: c1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
	self assert: (q2 commonAncestorWith: c2) = q1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
	self assert: (c2 commonAncestorWith: q2) = q1.
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
testLinearPath
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
	self assertPathTo: #b1 is: #(b3 b2)
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
testPathToMissingAncestor
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
	self assert: (self tree allAncestorsOnPathTo: MCVersionInfo new) isEmpty
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
! !
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
!MCAncestryTest class methodsFor:'documentation'!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
version
281
af7f40566bc3 initial checkin
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   137
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCAncestryTest.st,v 1.2 2011-08-20 12:04:04 cg Exp $'
258
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
version_CVS
281
af7f40566bc3 initial checkin
Claus Gittinger <cg@exept.de>
parents: 258
diff changeset
   141
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCAncestryTest.st,v 1.2 2011-08-20 12:04:04 cg Exp $'
258
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
!
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
version_SVN
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
    ^ '§Id: MCAncestryTest.st 5 2010-08-29 07:30:29Z vranyj1 §'
95af41644050 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
! !