test/MCClassDefinitionTest.st
author Claus Gittinger <cg@exept.de>
Sat, 01 Sep 2018 17:32:13 +0200
changeset 1086 efc5221435a5
parent 805 f01e074c17d9
child 1121 c5661215109c
permissions -rw-r--r--
initial checkin

"{ Package: 'stx:goodies/monticello/test' }"

MCTestCase subclass:#MCClassDefinitionTest
	instanceVariableNames:'previousChangeSet'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-Tests'
!


!MCClassDefinitionTest class methodsFor:'as yet unclassified'!

classAComment
	^ 'This is a mock class. The Monticello tests manipulated it to simulate a developer modifying code in the image.'
!

classACommentStamp
	^  'cwp 8/10/2003 16:43'
!

restoreClassAComment
	Smalltalk 
		at: #MCMockClassA 
		ifPresent: [:a | a classComment: self classAComment stamp: self classACommentStamp]
! !

!MCClassDefinitionTest methodsFor:'as yet unclassified'!

classAComment
	^ self class classAComment
!

creationMessage
	^ MessageSend
		receiver: MCClassDefinition
		selector: #name:superclassName:category:instVarNames:classVarNames:poolDictionaryNames:classInstVarNames:type:comment:commentStamp:
!

tearDown
	Smalltalk at: 'MCMockClassC' ifPresent: [:c | c removeFromSystem]
!

testCannotLoad
        | d |

        Smalltalk removeClassNamed:'MCMockClassC'.
        self deny: (Smalltalk hasClassNamed: 'MCMockClassC').       "/ should not be there initially

        d _  self mockClass: 'MCMockClassC' super: 'NotAnObject'.
        self should: [d load] raise: Error.
        self deny: (Smalltalk hasClassNamed: 'MCMockClassC').
!

testComparison
	| d1 d2 d3 d4 |
	d1 _ self mockClass: 'A' super: 'X'.
	d2 _ self mockClass: 'A' super: 'Y'.
	d3 _ self mockClass: 'B' super: 'X'.
	d4 _ self mockClass: 'B' super: 'X'.
	
	self assert: (d1 isRevisionOf: d2).
	self deny: (d1 isSameRevisionAs: d2).

	self assert: (d3 isRevisionOf: d4).
	self assert: (d3 isSameRevisionAs: d4).
	
	self deny: (d1 isRevisionOf: d3).
	self deny: (d4 isRevisionOf: d2).
!

testCreation
        | d |
        d _  self mockClassA asClassDefinition.
        self assert: d className = #MCMockClassA.
        self assert: d superclassName = #MCMock.
        self assert: d type = #normal.
        self assert: d category = self mockCategoryName.
        self assert: d instVarNames asArray = #('ivar').
        self assert: d classVarNames asArray = #('CVar').
        self assert: d classInstVarNames asArray = #().
        self assert: d comment isString.
        self assert: d comment = self classAComment.
        Smalltalk isSmalltalkX ifTrue:[
            self assert: d commentStamp = d defaultCommentStamp
        ] ifFalse:[
            self assert: d commentStamp = self mockClassA organization commentStamp
        ].
!

testDefinitionString
        | d |
        d _ self mockClassA asClassDefinition.
        Smalltalk isSmalltalkX ifTrue:[
            "/ not true, due to package comment...
            "/ self assert: d definitionString = self mockClassA definition.
        ] ifFalse:[
            self assert: d definitionString = self mockClassA definition.
        ].
!

testEquals
	| a b |
	a _ self mockClass: 'ClassA' super: 'SuperA'.
	b _ self mockClass: 'ClassA' super: 'SuperA'.
	self assert: a = b
!

testEqualsSensitivity
	| message a b defA args defB |
	message _ self creationMessage.
	a _ #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA)
			typeA 'A comment' 'A').
	b _ #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB)
			typeB 'B comment' 'B').
	
	defA _ message valueWithArguments: a.
	1 to: 8 do: [:index |
				args _ a copy.
				args at: index put: (b at: index).
				defB _ message valueWithArguments: args.
				self deny: defA = defB.]
!

testKindOfSubclass
        | classes d |
        Smalltalk isSmalltalkX ifTrue:[
            classes _ {self mockClassA. String. Method. Context. WeakArray. Float}.
        ] ifFalse:[
            classes _ {self mockClassA. String. MethodContext. WeakArray. Float}.
        ].
        classes do: [:c |
                d _  c asClassDefinition.
                self assert: d kindOfSubclass = c kindOfSubclass.
        ].
!

testLoadAndUnload
        | d c |
        d _  self mockClass: 'MCMockClassC' super: 'Object'.
        d load.
        self assert: (Smalltalk hasClassNamed: 'MCMockClassC').
        c _ (Smalltalk classNamed: 'MCMockClassC').
        self assert: (c isKindOf: Class).
        self assert: c superclass = Object.
        self assert: c instVarNames isEmpty.
        self assert: c classVarNames isEmpty.
        self assert: c sharedPools isEmpty.
        self assert: c category = self mockCategoryName.
        Smalltalk isSmalltalkX ifTrue:[
            self assert: c comment = (self commentForClass: 'MCMockClassC').
        ] ifFalse:[
            self assert: c organization classComment = (self commentForClass: 'MCMockClassC').
            self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC').
        ].
        d unload.
        self deny: (Smalltalk hasClassNamed: 'MCMockClassC').
! !

!MCClassDefinitionTest class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/monticello/test/MCClassDefinitionTest.st,v 1.4 2013-05-29 00:00:16 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/monticello/test/MCClassDefinitionTest.st,v 1.4 2013-05-29 00:00:16 vrany Exp $'
! !