Merge pull request #843 from RenaudFondeur/fixunusedExpressionHandleC…

…omment

small change in dead code elimination to considers a method with only comments empty

smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st

@@ -27,6 +27,66 @@ SLDeadCodeEliminationTest >> setUp [
 
 ]
 
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentNoSendInReceiver [
+	"currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process"
+
+	| translation tMethod |
+	tMethod := ccg methodNamed: #conditionalWithOnlyCommentNoSendInReceiver.
+
+	ccg doBasicInlining: true.
+	ccg currentMethod: tMethod.
+
+	sLDeadCodeEliminationVisitor visit: tMethod parseTree.
+
+	translation := self translate: tMethod.
+	translation := translation trimBoth.
+
+	self
+		assert: translation
+		equals:
+			'/* SLDeadCodeEliminationTestClass>>#conditionalWithOnlyCommentNoSendInReceiver */
+static void
+conditionalWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentNoSendInReceiver)
+{
+	{
+		return;
+	}
+}'
+]
+
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentSendInReceiver [
+	"currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process"
+
+	| translation tMethod |
+	tMethod := ccg methodNamed:
+		           #conditionalWithOnlyCommentSendInReceiver.
+
+	ccg doBasicInlining: true.
+	ccg currentMethod: tMethod.
+
+	sLDeadCodeEliminationVisitor visit: tMethod parseTree.
+
+	translation := self translate: tMethod.
+	translation := translation trimBoth.
+
+	self
+		assert: translation
+		equals:
+			'/* SLDeadCodeEliminationTestClass>>#conditionalWithOnlyCommentSendInReceiver */
+static void
+conditionalWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentSendInReceiver)
+{
+	{
+		method(self_in_conditionalWithOnlyCommentSendInReceiver, method(self_in_conditionalWithOnlyCommentSendInReceiver));
+	}
+	{
+		return;
+	}
+}'
+]
+
 { #category : 'method-in-c-coerce' }
 SLDeadCodeEliminationTest >> testMethodAddingCallInCoerce [
 
@@ -1053,6 +1113,34 @@ methodWithInstanceVariableInReturn(SLDeadCodeEliminationTestClass * self_in_meth
 }'
 ]
 
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTest >> testMethodWithOnlyComment [
+	"currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process"
+
+	| translation tMethod |
+	tMethod := ccg methodNamed: #methodWithOnlyComment.
+	ccg doBasicInlining: true.
+	ccg currentMethod: tMethod.
+	sLDeadCodeEliminationVisitor visit: tMethod parseTree.
+
+	translation := self translate: tMethod.
+	translation := translation trimBoth.
+
+	self
+		assert: translation
+		equals:
+			'/* SLDeadCodeEliminationTestClass>>#methodWithOnlyComment */
+static void
+methodWithOnlyComment(SLDeadCodeEliminationTestClass * self_in_methodWithOnlyComment)
+{
+	/* begin method */
+	/* end method */
+	{
+		return;
+	}
+}'
+]
+
 { #category : 'unused-leaf' }
 SLDeadCodeEliminationTest >> testMethodWithUnusedConstant [
 
@@ -3705,6 +3793,63 @@ methodWithVariableInReturn(SLDeadCodeEliminationTestClass * self_in_methodWithVa
 }'
 ]
 
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentNoSendInReceiver [
+	"currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process"
+
+	| translation tMethod |
+	tMethod := ccg methodNamed: #switchWithOnlyCommentNoSendInReceiver:.
+	tMethod prepareMethodIn: ccg.
+	ccg doBasicInlining: true.
+	ccg currentMethod: tMethod.
+	sLDeadCodeEliminationVisitor visit: tMethod parseTree.
+
+	translation := self translate: tMethod.
+	translation := translation trimBoth.
+
+	self
+		assert: translation
+		equals:
+			'/* SLDeadCodeEliminationTestClass>>#switchWithOnlyCommentNoSendInReceiver: */
+static void
+switchWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentNoSendInReceiver, sqInt anInt)
+{
+	{
+		return;
+	}
+}'
+]
+
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentSendInReceiver [
+	"currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process"
+
+	| translation tMethod |
+	tMethod := ccg methodNamed: #switchWithOnlyCommentSendInReceiver.
+	tMethod prepareMethodIn: ccg.
+	ccg doBasicInlining: true.
+	ccg currentMethod: tMethod.
+	sLDeadCodeEliminationVisitor visit: tMethod parseTree.
+
+	translation := self translate: tMethod.
+	translation := translation trimBoth.
+
+	self
+		assert: translation
+		equals:
+			'/* SLDeadCodeEliminationTestClass>>#switchWithOnlyCommentSendInReceiver */
+static void
+switchWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentSendInReceiver)
+{
+	{
+		method(self_in_switchWithOnlyCommentSendInReceiver, method(self_in_switchWithOnlyCommentSendInReceiver));
+	}
+	{
+		return;
+	}
+}'
+]
+
 { #category : 'helpers' }
 SLDeadCodeEliminationTest >> translate: tast [
 

smalltalksrc/Slang-Tests/SLDeadCodeEliminationTestClass.class.st

@@ -17,13 +17,34 @@ SLDeadCodeEliminationTestClass class >> instVarNamesAndTypesForTranslationDo: aB
 				 otherwise: [ #sqInt ]) ]
 ]
 
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTestClass >> conditionalWithOnlyCommentNoSendInReceiver [
+
+	<returnTypeC: #void>
+	true
+		ifTrue: [ self method ]
+		ifFalse: [ self method ]
+]
+
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTestClass >> conditionalWithOnlyCommentSendInReceiver [
+
+	<returnTypeC: #void>
+	(self method: self method)
+		ifTrue: [ self method ]
+		ifFalse: [ self method ]
+]
+
 { #category : 'accessing' }
 SLDeadCodeEliminationTestClass >> instancesVariable [
 	^ instancesVariable
 ]
 
 { #category : 'helpers' }
 SLDeadCodeEliminationTestClass >> method [
+
+	<inline: true>
+
 ]
 
 { #category : 'helpers' }
@@ -332,6 +353,13 @@ SLDeadCodeEliminationTestClass >> methodWithInstanceVariableInReturn [
 	^ instancesVariable
 ]
 
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTestClass >> methodWithOnlyComment [
+
+	<returnTypeC: #void>
+	self method
+]
+
 { #category : 'unused-leaf' }
 SLDeadCodeEliminationTestClass >> methodWithUnusedConstant [
 
@@ -1123,3 +1151,25 @@ SLDeadCodeEliminationTestClass >> methodWithVariableInReturn [
 	i.
 	^ i
 ]
+
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTestClass >> switchWithOnlyCommentNoSendInReceiver: anInt [
+
+	<returnTypeC: #void>
+	anInt
+		caseOf: {
+				([ 5 ] -> [ self method ]).
+				([ 6 ] -> [ self method ]) }
+		otherwise: [ self method ]
+]
+
+{ #category : 'only-comment' }
+SLDeadCodeEliminationTestClass >> switchWithOnlyCommentSendInReceiver [
+
+	<returnTypeC: #void>
+	(self method: self method)
+		caseOf: {
+				([ 5 ] -> [ self method ]).
+				([ 6 ] -> [ self method ]) }
+		otherwise: [ self method ]
+]

smalltalksrc/Slang/SlangReturnTypeConflictException.class.st

@@ -1,10 +1,11 @@
 Class {
-	#name : #SlangReturnTypeConflictException,
-	#superclass : #SlangTyperException,
-	#category : #Slang
+	#name : 'SlangReturnTypeConflictException',
+	#superclass : 'SlangTyperException',
+	#category : 'Slang',
+	#package : 'Slang'
 }
 
-{ #category : #exceptions }
+{ #category : 'exceptions' }
 SlangReturnTypeConflictException class >> signalConflictIn: aMethod with: aCollectionOfType [
 
 	| message |

smalltalksrc/Slang/SlangTyperException.class.st

@@ -1,5 +1,6 @@
 Class {
-	#name : #SlangTyperException,
-	#superclass : #Error,
-	#category : #Slang
+	#name : 'SlangTyperException',
+	#superclass : 'Error',
+	#category : 'Slang',
+	#package : 'Slang'
 }

smalltalksrc/Slang/TParseNode.class.st

@@ -201,6 +201,13 @@ TParseNode >> hasExplicitReturn [
 	^false
 ]
 
+{ #category : 'testing' }
+TParseNode >> hasNothingButComments [
+	"an alternative to isEmpty related to inlining"
+
+	^ self children allSatisfy: [ :child | child isComment ]
+]
+
 { #category : 'testing' }
 TParseNode >> hasSideEffect [
 	"Answer if the parse tree rooted at this node has a side-effect or not.  By default assume it has.  Nodes that don't override."
@@ -452,7 +459,7 @@ TParseNode >> removeUnusedNodesInBranch: aChild [
 	"this method should be only called when cleaning an AST tree after an unused expression was found"
 
 	self children remove: aChild.
-	self children isEmpty ifTrue: [
+	(self children isEmpty or: [ self hasNothingButComments ]) ifTrue: [
 		self parent removeUnusedNodesInBranch: self ]
 ]
 

smalltalksrc/Slang/TSendNode.class.st

@@ -76,6 +76,13 @@ TSendNode >> argumentsForInliningCodeGenerator: aCodeGen [
 		ifFalse: [arguments]
 ]
 
+{ #category : 'testing' }
+TSendNode >> argumentsHasNothingButComments [
+	"related to dead code elimination and inlining, see if the cases has nothing but comment meaning they are empty"
+
+	^ arguments allSatisfy: [ :arg | arg isComment ]
+]
+
 { #category : 'tranforming' }
 TSendNode >> asCASTAsFieldReferenceIn: aCodeGen [
 
@@ -569,7 +576,7 @@ TSendNode >> removeUnusedNodesInBranch: aChild [
 	| branchIndex |
 	branchIndex := arguments indexOf: aChild.
 	arguments := arguments select: [ :e | e ~= aChild ].
-	arguments isEmpty
+	(arguments isEmpty or: [ self argumentsHasNothingButComments ])
 		ifTrue: [
 			self transformReceiverAfterEmptyArguments.
 			self parent removeUnusedNodesInBranch: self ]

smalltalksrc/Slang/TStatementListNode.class.st

@@ -429,11 +429,17 @@ TStatementListNode >> initialize [
 	arguments := #()
 ]
 
+{ #category : 'testing' }
+TStatementListNode >> isComment [
+
+	^ self hasNothingButComments
+]
+
 { #category : 'testing' }
 TStatementListNode >> isEmptyStmtListNode [
-	"return true if the statement node is empty or has just a nil in it"
+	"return true if the statement node is empty orContains only comments"
 
-	statements isEmpty ifTrue: [ ^ true ].
+	(statements isEmpty or: [ self isComment ]) ifTrue: [ ^ true ].
 	^ false
 ]
 
@@ -580,22 +586,22 @@ TStatementListNode >> removeAssertions [
 	self setStatements: newStatements asArray
 ]
 
+{ #category : 'transformations' }
+TStatementListNode >> removeLast [
+	"the last statement can be a comment if the TStatementList has been through inlining, remove the actual last statement"
+
+	statements := self allButLastNonCommentStatement
+]
+
 { #category : 'dead-code-elimination' }
 TStatementListNode >> removeUnusedNodesInBranch: aChild [
 	"this method should be only called when cleaning an AST tree after an unused expression was found, remove aChild from the list of statements"
 
 	statements := statements select: [ :stmt | stmt ~~ aChild ].
-	statements isEmpty ifTrue: [
+	(statements isEmpty or: [ self hasNothingButComments ]) ifTrue: [
 		self parent removeUnusedNodesInBranch: self ]
 ]
 
-{ #category : 'transformations' }
-TStatementListNode >> removeLast [
-	"the last statement can be a comment if the TStatementList has been through inlining, remove the actual last statement"
-
-	statements := self allButLastNonCommentStatement
-]
-
 { #category : 'inlining support' }
 TStatementListNode >> renameLabelsForInliningInto: aTMethod [
 	"TMethod already has a method for this; hijack it..."

smalltalksrc/Slang/TSwitchStmtNode.class.st

@@ -244,6 +244,13 @@ TSwitchStmtNode >> cases: anObject [
 	cases := anObject
 ]
 
+{ #category : 'testing' }
+TSwitchStmtNode >> casesHasNothingButComments [
+	"related to dead code elimination and inlining, see if the cases has nothing but comment meaning they are empty"
+
+	^ cases allSatisfy: [ :case | case second isComment ]
+]
+
 { #category : 'accessing' }
 TSwitchStmtNode >> children [
 
@@ -453,9 +460,10 @@ TSwitchStmtNode >> removeAssertions [
 { #category : 'dead-code-elimination' }
 TSwitchStmtNode >> removeUnusedNodesInBranch: aChild [
 	"when removing a node from a switch, we have to be careful of if it comes from a caseOf: or a caseOf:otherwise:. if it comes from a caseOf:, otherwise is nil and must be kept it will be translated as a no case found error. To indicate that otherwise does nothing Slang use an empty TStatementListNode, hence the following code"
-	
+
 	cases := cases select: [ :each | each second ~~ aChild ].
-	self cases isEmpty ifFalse: [ ^ self ].
+	(cases isEmpty or: [ self casesHasNothingButComments ]) ifFalse: [
+		^ self ].
 	"we're from a caseOf: so we keep the node"
 	otherwiseOrNil ifNil: [ ^ self ].
 	"otherwiseOrNil may have been empty from the start or during the cleaning process, either way the node is now completely empty so we can supress it"