Fixed some tests. Not all pass, though,
--- a/Make.proto Fri Aug 28 14:04:03 2015 +0100
+++ b/Make.proto Sat Aug 29 10:31:59 2015 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/jv/tea/compiler -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/helpers -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libcompat
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libcompat
# if you need any additional defines for embedded C code,
@@ -102,13 +102,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
cd ../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../refactoryBrowser/helpers && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd $(TOP)/../jv/tea/compiler && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
@@ -153,7 +146,7 @@
$(OUTDIR)RGMetaclassDefinition.$(O) RGMetaclassDefinition.$(H): RGMetaclassDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGBehaviorDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGClassDescriptionDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGGlobalDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)RGMetatraitDefinition.$(O) RGMetatraitDefinition.$(H): RGMetatraitDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGBehaviorDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGGlobalDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGTraitDescriptionDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)RGTraitDefinition.$(O) RGTraitDefinition.$(H): RGTraitDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGBehaviorDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGGlobalDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGTraitDescriptionDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/helpers/RBAbstractClass.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/helpers/RBClass.$(H) $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Class.$(H) $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/CompiledCode.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Method.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/Behavior.$(H) $(INCLUDE_TOP)/stx/libbasic/Class.$(H) $(INCLUDE_TOP)/stx/libbasic/ClassDescription.$(H) $(INCLUDE_TOP)/stx/libbasic/CompiledCode.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Method.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/RGMetaclassDefinition.st Fri Aug 28 14:04:03 2015 +0100
+++ b/RGMetaclassDefinition.st Sat Aug 29 10:31:59 2015 +0100
@@ -12,6 +12,7 @@
RGMetaclassDefinition comment:'RGMetaclassDefinition is a concrete representation of metaclasses of classes (traits are excluded)'
!
+
!RGMetaclassDefinition class methodsFor:'class initialization'!
class: anORClassDefinition
@@ -46,6 +47,8 @@
realClass
^baseClass realClass theMetaClass
+
+ "Modified: / 29-08-2015 / 10:27:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
theMetaClass
@@ -96,3 +99,10 @@
^self theNonMetaClass allSharedPoolNames
! !
+!RGMetaclassDefinition class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/RGMethodDefinition.st Fri Aug 28 14:04:03 2015 +0100
+++ b/RGMethodDefinition.st Sat Aug 29 10:31:59 2015 +0100
@@ -102,7 +102,9 @@
realClass: aClass selector: aString
"Creates a ring method definition from a Smalltalk class and a selector <compiledMethod>"
- ^(aClass>>aString asSymbol) asActiveRingDefinition
+ ^(aClass >> aString asSymbol) asActiveRingDefinition
+
+ "Modified (format): / 29-08-2015 / 10:25:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RGMethodDefinition class methodsFor:'categories'!
@@ -151,12 +153,25 @@
^self
annotationNamed: self class isExtensionKey
ifAbsent: [
- (self parent notNil and:[ self package notNil ])
- ifTrue: [ | value |
- value := self parent package ~= self package.
- self annotationNamed: self class isExtensionKey put: value.
- value ]
- ifFalse: [ | prot | self protocol ifNil:[ false ] ifNotNil:[ prot beginsWith: '*' ] ] ]
+ (self parent notNil and:[ self package notNil ]) ifTrue: [
+ | value |
+
+ value := self parent package ~= self package.
+ self annotationNamed: self class isExtensionKey put: value.
+ value
+ ] ifFalse: [
+ self isActive ifTrue:[
+ | cm |
+
+ cm := self compiledMethod.
+ cm isExtension.
+ ] ifFalse:[
+ false
+ ].
+ ]
+ ]
+
+ "Modified: / 29-08-2015 / 10:23:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isExtension: aBoolean
@@ -188,10 +203,12 @@
protocol
self isActive
- ifTrue: [ ^ self compiledMethod ifNil: [ protocol ] ifNotNil: [ self compiledMethod protocol ]].
+ ifTrue: [ ^ self compiledMethod ifNil: [ protocol ] ifNotNil: [ self compiledMethod category ]].
self isHistorical
- ifTrue: [ ^ self protocolAtPointer ifNil: [ | cm | (cm := self compiledMethod) ifNil: [ protocol ] ifNotNil:[ cm protocol ] ] ].
- ^ protocol
+ ifTrue: [ ^ self protocolAtPointer ifNil: [ | cm | (cm := self compiledMethod) ifNil: [ protocol ] ifNotNil:[ cm category ] ] ].
+ ^ protocol
+
+ "Modified: / 29-08-2015 / 08:20:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
protocol: anObject
@@ -215,9 +232,9 @@
self isActive
ifTrue: [ ^ self compiledMethod ifNil:[ sourceCode ] ifNotNil: [ self compiledMethod sourceCode ]].
- self isHistorical
- ifTrue: [ ^ self sourceCodeAtPointer ifNil:[ | cm | (cm := self compiledMethod) ifNil:[ sourceCode ] ifNotNil:[ cm sourceCode ] ] ].
^ sourceCode
+
+ "Modified: / 29-08-2015 / 08:03:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceCode: anObject
@@ -229,9 +246,9 @@
self isActive
ifTrue: [ ^ self compiledMethod timeStamp ].
- self isHistorical
- ifTrue: [ ^ self stampAtPointer ifNil:[ | cm | (cm := self compiledMethod) ifNil:[ stamp ] ifNotNil:[ cm timeStamp ] ] ].
^ stamp
+
+ "Modified: / 29-08-2015 / 08:03:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stamp: anObject
@@ -346,41 +363,53 @@
!
protocolAtPointer
-
"A RGMethodDefinition that was set as historical will retrieve the protocol using the sourcePointer"
- ^ self sourcePointer notNil
- ifTrue: [ SourceFiles protocolAt: self sourcePointer ]
- ifFalse:[ nil ]
+ self shouldNotImplement. "/ No source pointers in Smalltalk/X
+"/ ^ self sourcePointer notNil
+"/ ifTrue: [ SourceFiles protocolAt: self sourcePointer ]
+"/ ifFalse:[ nil ]
+
+ "Modified: / 29-08-2015 / 08:02:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourceCodeAtPointer
-
"A RGMethodDefinition that was set as historical will retrieve the sourceCode using the sourcePointer"
- ^ self sourcePointer notNil
- ifTrue: [ SourceFiles sourceCodeAt: self sourcePointer ]
- ifFalse:[ nil ]
+ self shouldNotImplement. "/ No source pointers in Smalltalk/X
+"/ ^ self sourcePointer notNil
+"/ ifTrue: [ SourceFiles sourceCodeAt: self sourcePointer ]
+"/ ifFalse:[ nil ]
+
+ "Modified: / 29-08-2015 / 08:02:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourcePointer
"Retrieves the sourcePointer for this definition if exists"
-
- ^self annotationNamed: self class sourcePointerKey
+
+ self shouldNotImplement. "/ No source pointers in Smalltalk/X
+"/ ^self annotationNamed: self class sourcePointerKey
+
+ "Modified: / 29-08-2015 / 08:02:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
sourcePointer: aNumber
- self annotationNamed: self class sourcePointerKey put: aNumber
+ self shouldNotImplement. "/ No source pointers in Smalltalk/X
+"/ self annotationNamed: self class sourcePointerKey put: aNumber
+
+ "Modified: / 29-08-2015 / 08:02:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-stampAtPointer
-
+stampAtPointer
"A RGMethodDefinition that was set as historical will retrieve the stamp using the sourcePointer"
- ^ self sourcePointer notNil
- ifTrue: [ SourceFiles timeStampAt: self sourcePointer ]
- ifFalse:[ nil ]
+ self shouldNotImplement. "/ No source pointers in Smalltalk/X
+"/ ^ self sourcePointer notNil
+"/ ifTrue: [ SourceFiles timeStampAt: self sourcePointer ]
+"/ ifFalse:[ nil ]
+
+ "Modified: / 29-08-2015 / 08:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RGMethodDefinition methodsFor:'stamp values'!
@@ -499,16 +528,17 @@
!
asHistorical
-
"Sets the receiver as historical object, which will allow itself to retrieve its data using the sourcePointer"
self annotationNamed: self class statusKey put: #historical.
- self sourcePointer ifNil:[ | pointer compiledMethod |
- pointer := 0.
+ sourceCode isNil ifTrue:[
+ | compiledMethod |
compiledMethod := self compiledMethod.
compiledMethod notNil ifTrue: [
- pointer := compiledMethod sourcePointer ].
- pointer isZero
- ifFalse:[ self sourcePointer: pointer ] ]
+ sourceCode := compiledMethod sourceCode
+ ].
+ ]
+
+ "Modified: / 29-08-2015 / 08:00:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
asPassive
--- a/bc.mak Fri Aug 28 14:04:03 2015 +0100
+++ b/bc.mak Sat Aug 29 10:31:59 2015 +0100
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\jv\tea\compiler -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\helpers -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libcompat
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libcompat
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -52,13 +52,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
pushd ..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\refactoryBrowser\helpers & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\jv\tea\compiler & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
@@ -100,7 +93,7 @@
$(OUTDIR)RGMetaclassDefinition.$(O) RGMetaclassDefinition.$(H): RGMetaclassDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGBehaviorDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGClassDescriptionDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGGlobalDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)RGMetatraitDefinition.$(O) RGMetatraitDefinition.$(H): RGMetatraitDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGBehaviorDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGGlobalDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGTraitDescriptionDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)RGTraitDefinition.$(O) RGTraitDefinition.$(H): RGTraitDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGBehaviorDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGGlobalDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGTraitDescriptionDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\helpers\RBAbstractClass.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\helpers\RBClass.$(H) $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Class.$(H) $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\CompiledCode.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Method.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\libbasic\Behavior.$(H) $(INCLUDE_TOP)\stx\libbasic\Class.$(H) $(INCLUDE_TOP)\stx\libbasic\ClassDescription.$(H) $(INCLUDE_TOP)\stx\libbasic\CompiledCode.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Method.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/extensions.st Fri Aug 28 14:04:03 2015 +0100
+++ b/extensions.st Sat Aug 29 10:31:59 2015 +0100
@@ -75,13 +75,15 @@
comment: self organization classComment;
stamp: self organization commentStamp;
definitionSource: self definition;
- package: self package asRingDefinition;
+ package: (RGPackage named: self package);
withMetaclass.
ring theMetaClass
traitCompositionSource: self theMetaClass traitCompositionString;
definitionSource: self theMetaClass definition;
addInstanceVariables: self theMetaClass instVarNames.
^ ring
+
+ "Modified: / 28-08-2015 / 18:27:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Class methodsFor:'*Ring-Core-Kernel'!
@@ -193,16 +195,17 @@
parentName: self methodClass name;
isMetaSide: self methodClass isMeta.
- self sourcePointer isZero
+ self sourceCode isNil
ifTrue: [ "this should not happen but sometimes the system looks corrupted"
ring protocol: self category;
sourceCode: self sourceCode;
stamp: self timeStamp ]
ifFalse: [
- ring sourcePointer: self sourcePointer ].
- ring asHistorical.
-
+ ring sourceCode: self sourceCode ].
+ ring asHistorical.
^ ring
+
+ "Modified: / 29-08-2015 / 08:01:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Method methodsFor:'*Ring-Core-Kernel'!
--- a/stx_goodies_ring.st Fri Aug 28 14:04:03 2015 +0100
+++ b/stx_goodies_ring.st Sat Aug 29 10:31:59 2015 +0100
@@ -29,8 +29,7 @@
This method is generated automatically,
by searching along the inheritance chain of all of my classes."
- ^ #(
- #'stx:goodies/refactoryBrowser/helpers' "RBAbstractClass - extended"
+ ^ #(
#'stx:libbasic' "Behavior - extended"
)
!
@@ -117,10 +116,6 @@
Method methodReference
Method realClass
Object isRingObject
- TClass asFullRingDefinition
- TClass asRingDefinition
- TClass asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackageKeys:in:
- TClass asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages:
)
! !
--- a/tests/Make.proto Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/Make.proto Sat Aug 29 10:31:59 2015 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/jv/tea/compiler -I$(INCLUDE_TOP)/stx/goodies/ring -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/ring -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
# if you need any additional defines for embedded C code,
--- a/tests/RGClassDefinitionTest.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/RGClassDefinitionTest.st Sat Aug 29 10:31:59 2015 +0100
@@ -34,7 +34,8 @@
^lastIndex - firstIndex + 1'.
self assert: (newClass hasMethods).
- self assert: (newClass selectors = #(add: size)).
+ self assert: (newClass selectors size == 2).
+ self assert: (newClass selectors includesAll: #(add: size)).
self assert: (newClass includesSelector: #add:).
self assert: ((newClass methodNamed: #add:) = newMethod).
self assert: (newClass methods size = 2).
@@ -46,6 +47,8 @@
self assert: ((newClass compiledMethodNamed: #size) notNil).
self assert: ((newClass compiledMethodNamed: #fakeMethod) isNil)
+
+ "Modified: / 29-08-2015 / 08:04:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsClassDefinition
@@ -66,36 +69,50 @@
testAsClassDefinition2
| newClass |
- newClass:= Trait asRingDefinition.
+ newClass:= Class asRingDefinition.
self assert: (newClass isRingObject).
self assert: (newClass isClass).
- self assert: (newClass name == #Trait).
+ self assert: (newClass name == #Class).
self assert: (newClass category notNil).
self assert: (newClass superclassName notNil).
- self assert: (newClass traitCompositionSource = 'TClass').
+"/ self assert: (newClass traitCompositionSource = 'TClass').
self assert: (newClass theMetaClass isRingObject).
self assert: (newClass theMetaClass isClass).
- self assert: (newClass theMetaClass traitCompositionSource = 'TClass classTrait').
-
+"/ self assert: (newClass theMetaClass traitCompositionSource = 'TClass classTrait').
+
+ "Modified: / 29-08-2015 / 08:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsClassDefinitionSourceDefinition
| newClass |
- newClass:= Trait asRingDefinition.
- self assert: (newClass definitionSource = 'TraitDescription subclass: #Trait
- uses: TClass
- instanceVariableNames: ''name environment classTrait category''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''Traits-Kernel''').
+ newClass:= Class asRingDefinition.
+ self assert: (newClass definitionSource = '"{ Package: ''stx:libbasic'' }"
+
+"{ NameSpace: Smalltalk }"
+
+ClassDescription subclass:#Class
+ instanceVariableNames:''name category classvars comment subclasses classFilename package
+ revision environment signature attributes''
+ classVariableNames:''DefaultCategoryForSTV DefaultCategoryForVAGE
+ DefaultCategoryForDolphin ValidateSourceOnlyOnce ValidatedClasses
+ SubclassCacheSequenceNumber
+ DefaultCategoryForUncategorizedClasses
+ DefaultCategoryForUndeclaredClasses''
+ poolDictionaries:''''
+ category:''Kernel-Classes''
+').
- self assert: (newClass theMetaClass definitionSource = 'Trait class
- uses: TClass classTrait
- instanceVariableNames: ''''').
-
+ self assert: (newClass theMetaClass definitionSource= 'Class class instanceVariableNames:''''
+
+"
+ No other class instance variables are inherited by this class.
+"
+').
+
+ "Modified (format): / 29-08-2015 / 08:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsRingDefinition
@@ -229,27 +246,28 @@
testWithClassInstanceVariables
| newClass metaClass classInstVar |
- newClass:= RGClassDefinition named: #HashTableSizes.
+ newClass:= RGClassDefinition named: #GenericException.
newClass withMetaclass.
metaClass:= newClass theMetaClass.
- metaClass addInstanceVariables: #(sizes).
+ metaClass addInstanceVariables: #(NotifierString).
self assert: (metaClass instanceVariables size = 1).
self assert: (metaClass instVarNames size = 1).
self assert: (metaClass allInstVarNames size = 1).
- classInstVar:= metaClass instanceVariableNamed: #sizes.
+ classInstVar:= metaClass instanceVariableNamed: #NotifierString.
self assert: (classInstVar notNil).
self assert: (classInstVar parent = metaClass).
self assert: (classInstVar isClassInstanceVariable).
self assert: (classInstVar isVariable).
self assert: (classInstVar parentName = metaClass name).
- self assert: (classInstVar realClass = HashTableSizes class).
+ self assert: (classInstVar realClass = GenericException class).
- metaClass removeInstVarNamed: #sizes.
+ metaClass removeInstVarNamed: #NotifierString.
self assert: (metaClass instanceVariables isEmpty).
- self assert: ((metaClass instanceVariableNamed: #sizes) isNil).
-
+ self assert: ((metaClass instanceVariableNamed: #NotifierString) isNil).
+
+ "Modified: / 29-08-2015 / 10:28:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testWithClassVariables
--- a/tests/RGMetatraitDefinitionTest.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/RGMetatraitDefinitionTest.st Sat Aug 29 10:31:59 2015 +0100
@@ -15,13 +15,15 @@
!RGMetatraitDefinitionTest methodsFor:'testing'!
testAsClassTraitfinition
- | rgCTrait cTrait |
- cTrait := TClass classTrait.
- rgCTrait := cTrait asRingDefinition.
- self assert: rgCTrait isRingObject.
- self assert: rgCTrait isTrait.
- self assert: rgCTrait name == #'TClass classTrait'.
- self assert: rgCTrait category == cTrait category.
- self assert: rgCTrait theMetaClass == rgCTrait
+"/ | rgCTrait cTrait |
+"/ cTrait := TClass classTrait.
+"/ rgCTrait := cTrait asRingDefinition.
+"/ self assert: rgCTrait isRingObject.
+"/ self assert: rgCTrait isTrait.
+"/ self assert: rgCTrait name == #'TClass classTrait'.
+"/ self assert: rgCTrait category == cTrait category.
+"/ self assert: rgCTrait theMetaClass == rgCTrait
+
+ "Modified: / 29-08-2015 / 09:46:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/tests/RGMethodDefinitionTest.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/RGMethodDefinitionTest.st Sat Aug 29 10:31:59 2015 +0100
@@ -22,26 +22,27 @@
testAsActive
| newMethod |
- RGMethodDefinitionTest compile: 'foo ^ ''first version'''.
+ RGMethodDefinitionTest compile: 'foo ^ ''first version'''.
newMethod := (RGMethodDefinitionTest >> #foo) asActiveRingDefinition.
- self assert: newMethod isActive.
- self assert: newMethod sourcePointer isNil.
+ self assert: newMethod isActive.
self assert: newMethod sourceCode = newMethod compiledMethod sourceCode.
- RGMethodDefinitionTest compile: 'foo ^ ''second version'''.
+ RGMethodDefinitionTest compile: 'foo ^ ''second version'''.
self assert: newMethod sourceCode = newMethod compiledMethod sourceCode.
- newMethod := (Trait >> #asRingDefinition) asActiveRingDefinition.
+ newMethod := (Class >> #asRingDefinition) asActiveRingDefinition.
newMethod fromActiveToPassive.
self assert: newMethod isPassive.
- self assert: newMethod sourceCode = (Trait >> #asRingDefinition) sourceCode.
+ self assert: newMethod sourceCode = (Class >> #asRingDefinition) sourceCode.
newMethod sourceCode: 'asRingDefinition ^true'.
- self assert: newMethod sourceCode ~= (Trait >> #asRingDefinition) sourceCode.
+ self assert: newMethod sourceCode ~= (Class >> #asRingDefinition) sourceCode.
- newMethod := (Trait >> #asRingDefinition) asActiveRingDefinition.
+ newMethod := (Class >> #asRingDefinition) asActiveRingDefinition.
newMethod fromActiveToHistorical.
self assert: newMethod isHistorical.
- self assert: newMethod sourcePointer notNil.
+ self assert: newMethod sourceCode notNil.
+
+ "Modified: / 29-08-2015 / 08:20:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsHistorical
@@ -81,15 +82,9 @@
| newMethod |
newMethod := (Object >> #printOn:) asRingDefinition.
- self assert: newMethod protocol = 'printing'.
-
- newMethod := (TCloneTest >> #testCopyEmpty) asRingDefinition.
- self assert: newMethod protocol = 'tests - copy - clone'.
+ self assert: newMethod category = #'printing & storing'.
- newMethod := (ArrayTest >> #testCopyEmpty) asRingDefinition.
- self assert: newMethod protocol = 'tests - copy - clone'.
-
- "Modified (format): / 28-08-2015 / 12:18:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 29-08-2015 / 10:26:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsPassive
@@ -134,12 +129,14 @@
self assert: (newMethod sourceCode isNil).
self assert: (newMethod stamp isNil).
- newMethod := RGMethodDefinition realClass: OrderedCollection theMetaClass selector: #arrayType.
+ newMethod := RGMethodDefinition realClass: OrderedCollection theMetaClass selector: #newFrom:.
self assert: (newMethod isMethod).
- self assert: (newMethod selector == #arrayType).
+ self assert: (newMethod selector == #newFrom:).
self assert: (newMethod protocol notNil).
self assert: (newMethod sourceCode notEmpty).
self assert: (newMethod stamp notNil).
+
+ "Modified: / 29-08-2015 / 10:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testDifferentObjectButSameMethodInSet
@@ -232,9 +229,9 @@
self assert: (newMethod protocol isNil).
self assert: (newMethod isExtension).
- newMethod:= (Collection >> #+) asRingDefinition.
+ newMethod:= (Class >> #asRingDefinition) asRingDefinition.
self assert: (newMethod isMethod).
- self assert: (newMethod protocol = '*Collections-arithmetic').
+ self assert: (newMethod protocol = '*Ring-Core-Kernel').
self assert: (newMethod isExtension).
newPackage := RGPackage named: #Package.
@@ -244,6 +241,8 @@
newPackage addClass: newClass.
newMethod package: newPackageExt.
self assert: (newMethod isExtension).
+
+ "Modified: / 29-08-2015 / 10:18:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testMethodEquality
--- a/tests/RGPackageTest.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/RGPackageTest.st Sat Aug 29 10:31:59 2015 +0100
@@ -12,6 +12,7 @@
RGPackageTest comment:'SUnit tests for packages'
!
+
!RGPackageTest methodsFor:'testing'!
testAddingClass
@@ -54,3 +55,10 @@
self assert: (newPackage parent == Smalltalk globals).
! !
+!RGPackageTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/tests/RGTraitDefinitionTest.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/RGTraitDefinitionTest.st Sat Aug 29 10:31:59 2015 +0100
@@ -17,7 +17,7 @@
testAddingMethods
| newMethod newClass |
- newClass:= RGTraitDefinition named: #TSortable.
+ newClass:= RGTraitDefinition named: #SequenceableCollection.
newMethod:= (RGMethodDefinition named: #sort) parent: newClass;
protocol: 'sorting';
sourceCode: 'sort
@@ -33,7 +33,10 @@
^lastIndex - firstIndex + 1'.
self assert: (newClass hasMethods).
- self assert: (newClass selectors = #(sort size)).
+ self assert: (newClass selectors size == 2).
+ self assert: (newClass selectors includes: #sort).
+ self assert: (newClass selectors includes: #size).
+
self assert: (newClass includesSelector: #sort).
self assert: ((newClass methodNamed: #sort) = newMethod).
self assert: (newClass methods size = 2).
@@ -45,58 +48,66 @@
self assert: ((newClass compiledMethodNamed: #sort) notNil).
self assert: ((newClass compiledMethodNamed: #foo) isNil)
+
+ "Modified: / 29-08-2015 / 06:59:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsTraitDefinition
+
+"/ | newTrait |
+"/ newTrait:= TBehavior asRingDefinition.
+"/ self assert: (newTrait isRingObject).
+"/ self assert: (newTrait isTrait).
+"/ self assert: (newTrait name == #TBehavior).
+"/ self assert: (newTrait category notNil).
+"/ self assert: (newTrait superclassName notNil).
+"/
+"/
+"/ self assert: (newTrait theMetaClass isRingObject).
+"/ self assert: (newTrait theMetaClass isTrait).
+"/ self assert: (newTrait theMetaClass traitCompositionSource = '{}').
- | newTrait |
- newTrait:= TBehavior asRingDefinition.
- self assert: (newTrait isRingObject).
- self assert: (newTrait isTrait).
- self assert: (newTrait name == #TBehavior).
- self assert: (newTrait category notNil).
- self assert: (newTrait superclassName notNil).
-
-
- self assert: (newTrait theMetaClass isRingObject).
- self assert: (newTrait theMetaClass isTrait).
- self assert: (newTrait theMetaClass traitCompositionSource = '{}').
+ "Modified: / 29-08-2015 / 07:00:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testAsTraitDefinition2
- | newTrait newClass newSlice |
- newClass := Trait asRingDefinitionWithMethods: false withSuperclasses: false withSubclasses: true withPackages: false.
- newSlice := newClass environment.
- self assert: (newClass allSubclasses size = Smalltalk globals environment allTraits size).
- self assert: newClass traitNames size = 1.
- self assert: newClass traits first = (newSlice traitNamed: #TClass).
-
- newTrait := TBehaviorCategorization asRingDefinitionWithMethods: true withSuperclasses: true withSubclasses: false withPackages: true.
- newSlice := newTrait environment.
- self assert: newTrait superclass = (newSlice classNamed: #Trait).
- self assert: newTrait methods size < newSlice methods size.
- self assert: newTrait category = #'Traits-Kernel-Traits'.
- self assert: newTrait package = (newSlice packageNamed: #Traits).
- self assert: newTrait subclasses isEmpty.
+"/ | newTrait newClass newSlice |
+"/ newClass := Trait asRingDefinitionWithMethods: false withSuperclasses: false withSubclasses: true withPackages: false.
+"/ newSlice := newClass environment.
+"/ self assert: (newClass allSubclasses size = Smalltalk globals environment allTraits size).
+"/ self assert: newClass traitNames size = 1.
+"/ self assert: newClass traits first = (newSlice traitNamed: #TClass).
+"/
+"/ newTrait := TBehaviorCategorization asRingDefinitionWithMethods: true withSuperclasses: true withSubclasses: false withPackages: true.
+"/ newSlice := newTrait environment.
+"/ self assert: newTrait superclass = (newSlice classNamed: #Trait).
+"/ self assert: newTrait methods size < newSlice methods size.
+"/ self assert: newTrait category = #'Traits-Kernel-Traits'.
+"/ self assert: newTrait package = (newSlice packageNamed: #Traits).
+"/ self assert: newTrait subclasses isEmpty.
+
+ "Modified: / 29-08-2015 / 07:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testExistingTrait
- | newClass metaClass |
-
- newClass:= RGTraitDefinition named: #TSortable.
- self assert: (newClass isTrait).
- self assert: (newClass isDefined).
- self assert: (newClass realClass = TSortable).
- self assert: (newClass isMeta not).
-
- newClass withMetaclass.
- self assert: (newClass hasMetaclass).
- metaClass:= newClass theMetaClass.
- self assert: (metaClass isMeta).
- self assert: (metaClass name = 'TSortable classTrait').
- self assert: (metaClass theNonMetaClass = newClass).
- self assert: (metaClass realClass = TSortable theMetaClass).
+"/ | newClass metaClass |
+"/
+"/ newClass:= RGTraitDefinition named: #TSortable.
+"/ self assert: (newClass isTrait).
+"/ self assert: (newClass isDefined).
+"/ self assert: (newClass realClass = TSortable).
+"/ self assert: (newClass isMeta not).
+"/
+"/ newClass withMetaclass.
+"/ self assert: (newClass hasMetaclass).
+"/ metaClass:= newClass theMetaClass.
+"/ self assert: (metaClass isMeta).
+"/ self assert: (metaClass name = 'TSortable classTrait').
+"/ self assert: (metaClass theNonMetaClass = newClass).
+"/ self assert: (metaClass realClass = TSortable theMetaClass).
+
+ "Modified: / 29-08-2015 / 07:00:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testNonExistingClass
@@ -120,10 +131,12 @@
testTraitEquality
| newClass |
- self assert: TSortable asRingDefinition = TSortable asRingDefinition.
+ self assert: SequenceableCollection asRingDefinition = SequenceableCollection asRingDefinition.
- newClass := (TSortable asRingDefinition)
+ newClass := (SequenceableCollection asRingDefinition)
category: #Kernel.
- self assert: (TSortable asRingDefinition = newClass)
+ self assert: (SequenceableCollection asRingDefinition = newClass)
+
+ "Modified: / 29-08-2015 / 07:01:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/tests/bc.mak Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/bc.mak Sat Aug 29 10:31:59 2015 +0100
@@ -35,7 +35,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\jv\tea\compiler -I$(INCLUDE_TOP)\stx\goodies\ring -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\ring -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
--- a/tests/stx_goodies_ring_tests.st Fri Aug 28 14:04:03 2015 +0100
+++ b/tests/stx_goodies_ring_tests.st Sat Aug 29 10:31:59 2015 +0100
@@ -46,7 +46,6 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'jv:tea/compiler' "TClass - referenced by RGMetatraitDefinitionTest>>testAsClassTraitfinition"
#'stx:goodies/ring' "RGClassDefinition - referenced by RGClassDefinitionTest>>testAddingMethods"
#'stx:libbasic2' "Text - referenced by RGClassDefinitionTest>>testWithPoolDictionaries"
)