Merge pull request #13276 from MarcusDenker/13246-Class-comments-can-…

…get-lost-when-commiting-code Fix #13246 class comments can get lost when commiting code
pharo-project · Apr 4, 2023 · b6d7b7f · b6d7b7f
2 parents e67394d + 719ff32
commit b6d7b7f
Show file tree

Hide file tree

Showing 14 changed files with 60 additions and 25 deletions.
diff --git a/src/CodeImport/ClassCommentChunk.class.st b/src/CodeImport/ClassCommentChunk.class.st
@@ -40,7 +40,7 @@ ClassCommentChunk >> importFor: aRequestor logSource: logSource [
 		ifFalse: [ self error: ('Cannot install comment in unexistent behavior {1}' format: { behaviorName asString } ) ].
 
 	^self targetClass instanceSide
-						classComment: contents
+						comment: contents
 						stamp: stamp
 ]
 

diff --git a/src/Epicea-Tests/EpCodeChangeIntegrationTest.class.st b/src/Epicea-Tests/EpCodeChangeIntegrationTest.class.st
@@ -26,7 +26,7 @@ EpCodeChangeIntegrationTest >> testBehaviorCommentChange [
 	aClass := classFactory newClass.
 	self assert: (self countLogEventsWith: EpBehaviorCommentChange) equals: 0.
 
-	aClass classComment: 'hey!' stamp: DateAndTime now.
+	aClass comment: 'hey!' stamp: DateAndTime now.
 	self assert: (self countLogEventsWith: EpBehaviorCommentChange) equals: 1
 ]
 

diff --git a/src/EpiceaBrowsers-Tests/EpApplyPreviewerTest.class.st b/src/EpiceaBrowsers-Tests/EpApplyPreviewerTest.class.st
@@ -79,9 +79,9 @@ EpApplyPreviewerTest >> testBehaviorCommentChange [
 
 	| aClass |
 	aClass := classFactory newClass.
-	aClass classComment: 'before'.
+	aClass comment: 'before'.
 	self setHeadAsInputEntry.
-	aClass classComment: 'after'.
+	aClass comment: 'after'.
 
 	self assertOutputsAnEventWith: [:output |
 		self assert: output class equals: EpBehaviorCommentChange.
@@ -423,9 +423,9 @@ EpApplyPreviewerTest >> testRedundantBehaviorCommentChange [
 
 	| aClass |
 	aClass := classFactory newClass.
-	aClass classComment: 'before'.
-	aClass classComment: 'after'.
-	aClass classComment: 'before'.
+	aClass comment: 'before'.
+	aClass comment: 'after'.
+	aClass comment: 'before'.
 	self setHeadAsInputEntry.
 
 	self assertEmptyPreviewLog
@@ -436,7 +436,7 @@ EpApplyPreviewerTest >> testRedundantBehaviorCommentChangeWithAbsentBehavior [
 
 	| aClass |
 	aClass := classFactory newClass.
-	aClass classComment: 'before'.
+	aClass comment: 'before'.
 	self setHeadAsInputEntry.
 	aClass removeFromSystem.
 

diff --git a/src/EpiceaBrowsers-Tests/EpRevertTest.class.st b/src/EpiceaBrowsers-Tests/EpRevertTest.class.st
@@ -35,8 +35,8 @@ EpRevertTest >> testBehaviorCommentChange [
 
 	| aClass |
 	aClass := classFactory newClass.
-	aClass classComment: 'before'.
-	aClass classComment: 'after'.
+	aClass comment: 'before'.
+	aClass comment: 'after'.
 	self setHeadAsInputEntry.
 
 	self revertInputEntry.

diff --git a/src/EpiceaBrowsers/EpApplyVisitor.class.st b/src/EpiceaBrowsers/EpApplyVisitor.class.st
@@ -24,7 +24,7 @@ EpApplyVisitor >> visitBehaviorCommentChange: aChange [
 		behaviorNamed: aChange behaviorAffectedName
 		ifPresent: [ :aClass |
 			aClass
-				classComment: aChange newComment
+				comment: aChange newComment
 				stamp: aChange newStamp ]
 ]
 

diff --git a/src/Kernel-Tests-Extended/ClassTest.class.st b/src/Kernel-Tests-Extended/ClassTest.class.st
@@ -224,6 +224,26 @@ ClassTest >> testClassVariableEntanglement [
 			removeFromSystemUnlogged ]
 ]
 
+{ #category : #'tests - accessing - comments' }
+ClassTest >> testComment [
+	self assert: Object comment isNotNil.
+	self assert: Object class comment equals: Object comment
+]
+
+{ #category : #'tests - accessing - comments' }
+ClassTest >> testCommentSourcePointer [
+
+	self
+		assert: Object class commentSourcePointer
+		identicalTo: Object commentSourcePointer isNotNil
+]
+
+{ #category : #'tests - accessing - comments' }
+ClassTest >> testCommentStamp [
+	self assert: Object commentStamp equals: ''.
+	self assert: Object class commentStamp equals: ''.
+]
+
 { #category : #tests }
 ClassTest >> testCommonSuperclassWith [
 	self assert: (OrderedCollection commonSuperclassWith: Array) equals: SequenceableCollection.
@@ -276,6 +296,12 @@ ClassTest >> testHasClassVarNamed [
 	self deny: (Object hasClassVarNamed: #CompilerClass)
 ]
 
+{ #category : #'tests - accessing - comments' }
+ClassTest >> testHasComments [
+	self assert: Object hasComment.
+	self assert: Object class hasComment
+]
+
 { #category : #'tests - access' }
 ClassTest >> testHasPoolVarNamed [
 

diff --git a/src/Kernel/ClassDescription.class.st b/src/Kernel/ClassDescription.class.st
@@ -173,7 +173,7 @@ ClassDescription >> basicOrganization: aClassOrg [
 { #category : #'accessing - comment' }
 ClassDescription >> classComment: aString [
 	"Store the comment, aString or Text or RemoteString, associated with the class we are orgainzing.  Empty string gets stored only if had a non-empty one before."
-	^ self classComment: aString stamp: '<historical>'
+	^ self comment: aString stamp: '<historical>'
 ]
 
 { #category : #'accessing - comment' }
@@ -186,7 +186,7 @@ ClassDescription >> classComment: aString stamp: aStamp [
 
 	aString string = oldComment string ifTrue: [ ^ self ].
 
-	pointer := self commentSourcePointer ifNil: [0].
+	pointer := self instanceSide commentSourcePointer ifNil: [0].
 
 
 	preamble := String streamContents: [ :file |
@@ -203,7 +203,7 @@ ClassDescription >> classComment: aString stamp: aStamp [
 		writeSource: aString
 		preamble: preamble
 		onSuccess: [ :newSourcePointer |
-			self commentSourcePointer: newSourcePointer]
+			self instanceSide commentSourcePointer: newSourcePointer]
 		onFail: [ "ignore" ].
 
 	SystemAnnouncer uniqueInstance
@@ -307,7 +307,7 @@ ClassDescription >> classVariablesString [
 
 { #category : #'accessing - comment' }
 ClassDescription >> comment [
-    ^ commentSourcePointer
+    ^ self instanceSide commentSourcePointer
 		  ifNil: [ '' ]
 		  ifNotNil: [ :ptr | SourceFiles sourceCodeAt: ptr ]
 ]
@@ -339,7 +339,7 @@ ClassDescription >> commentSourcePointer: anObject [
 { #category : #'accessing - comment' }
 ClassDescription >> commentStamp [
 
-	^ commentSourcePointer
+	^ self instanceSide commentSourcePointer
 		  ifNil: [ '' ]
 		  ifNotNil: [ SourceFiles commentTimeStampAt: commentSourcePointer]
 ]
@@ -528,7 +528,7 @@ ClassDescription >> hasClassSide [
 { #category : #'accessing - comment' }
 ClassDescription >> hasComment [
 	"Return whether this class truly has a comment other than the default"
-	^ self commentSourcePointer isNotNil
+	^ self instanceSide commentSourcePointer isNotNil
 ]
 
 { #category : #'instance variables' }

diff --git a/src/Kernel/Metaclass.class.st b/src/Kernel/Metaclass.class.st
@@ -120,6 +120,16 @@ Metaclass >> classVariables [
 		ifNotNil: [ :class | class classVariables ]
 ]
 
+{ #category : #'accessing - comment' }
+Metaclass >> commentSourcePointer [
+	^ self instanceSide commentSourcePointer
+]
+
+{ #category : #'accessing - comment' }
+Metaclass >> commentSourcePointer: anObject [
+	^ self instanceSide commentSourcePointer: anObject
+]
+
 { #category : #fileout }
 Metaclass >> definitionStringFor: aConfiguredPrinter [
 

diff --git a/src/Monticello-Tests/MCClassDefinitionTest.class.st b/src/Monticello-Tests/MCClassDefinitionTest.class.st
@@ -21,7 +21,7 @@ MCClassDefinitionTest class >> restoreClassAComment [
 
 	self environment
 		at: #MCMockClassA
-		ifPresent: [ :a | a classComment: self classAComment stamp: self classACommentStamp ]
+		ifPresent: [ :a | a comment: self classAComment stamp: self classACommentStamp ]
 ]
 
 { #category : #private }

diff --git a/src/Monticello/MCTraitDefinition.class.st b/src/Monticello/MCTraitDefinition.class.st
@@ -86,7 +86,7 @@ MCTraitDefinition >> createClass [
 
 
 	trait ifNotNil: [
-		trait classComment: comment stamp: commentStamp.
+		trait comment: comment stamp: commentStamp.
 		self classInstanceVariables ifNotEmpty: [
 			trait classSide slots: self classInstanceVariables ]].
 	^trait

diff --git a/src/Refactoring-Changes/RBCommentChange.class.st b/src/Refactoring-Changes/RBCommentChange.class.st
@@ -57,7 +57,7 @@ RBCommentChange >> comment: aString [
 { #category : #private }
 RBCommentChange >> primitiveExecute [
 
-	self changeClass classComment: comment stamp: self changeStamp.
+	self changeClass comment: comment stamp: self changeStamp.
 	SystemAnnouncer uniqueInstance classCommented: self changeClass
 ]
 

diff --git a/src/Shift-ClassBuilder-Tests/ShModifyClassTest.class.st b/src/Shift-ClassBuilder-Tests/ShModifyClassTest.class.st
@@ -11,7 +11,8 @@ ShModifyClassTest >> testEmptyClass [
 
 	self validateResult.
 	self validateSuperclass: Object.
-	self validateMethods: #()
+	self validateMethods: #().
+	self assert: result hasComment.
 ]
 
 { #category : #tests }

diff --git a/src/Shift-ClassBuilder/ShiftClassBuilder.class.st b/src/Shift-ClassBuilder/ShiftClassBuilder.class.st
@@ -94,12 +94,10 @@ ShiftClassBuilder >> build [
 	self oldClass ifNotNil: [
 			self newClass basicCategory: self oldClass basicCategory.
 			self copyOrganization.
+			self newClass commentSourcePointer: self oldClass commentSourcePointer.
 			self builderEnhancer compileMethodsFor: self. ].
 
 	self builderEnhancer afterMethodsCompiled: self.
-
-
-
 	^ newClass
 ]
 

diff --git a/src/Shift-ClassInstaller/ShiftClassInstaller.class.st b/src/Shift-ClassInstaller/ShiftClassInstaller.class.st
@@ -64,7 +64,7 @@ ShiftClassInstaller >> builder [
 
 { #category : #accessing }
 ShiftClassInstaller >> comment: newClass [
-	builder comment ifNotNil: [ newClass classComment: builder comment stamp: builder commentStamp ]
+	builder comment ifNotNil: [ newClass comment: builder comment stamp: builder commentStamp ]
 ]
 
 { #category : #building }