Skip to content

Commit 32db218

Browse files
fourlsfourls
committed
Implement ObjectPassedAsInterface check
1 parent a3938fc commit 32db218

File tree

6 files changed

+352
-0
lines changed

6 files changed

+352
-0
lines changed

‎delphi-checks/src/main/java/au/com/integradev/delphi/checks/CheckList.java‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,7 @@ public final class CheckList {
117117
NilComparisonCheck.class,
118118
NoSonarCheck.class,
119119
NonLinearCastCheck.class,
120+
ObjectPassedAsInterfaceCheck.class,
120121
ObjectTypeCheck.class,
121122
ParsingErrorCheck.class,
122123
PascalStyleResultCheck.class,

‎delphi-checks/src/main/java/au/com/integradev/delphi/checks/ObjectPassedAsInterfaceCheck.java‎

Lines changed: 94 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
/*
2+
* Sonar Delphi Plugin
3+
* Copyright (C) 2025 Integrated Application Development
4+
*
5+
* This program is free software; you can redistribute it and/or
6+
* modify it under the terms of the GNU Lesser General Public
7+
* License as published by the Free Software Foundation; either
8+
* version 3 of the License, or (at your option) any later version.
9+
*
10+
* This program is distributed in the hope that it will be useful,
11+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13+
* Lesser General Public License for more details.
14+
*
15+
* You should have received a copy of the GNU Lesser General Public
16+
* License along with this program; if not, write to the Free Software
17+
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02
18+
*/
19+
package au.com.integradev.delphi.checks;
20+
21+
import java.util.Collections;
22+
import java.util.Set;
23+
import java.util.stream.Collectors;
24+
import java.util.stream.IntStream;
25+
import org.sonar.check.Rule;
26+
import org.sonar.plugins.communitydelphi.api.ast.ArgumentListNode;
27+
import org.sonar.plugins.communitydelphi.api.ast.ExpressionNode;
28+
import org.sonar.plugins.communitydelphi.api.ast.NameReferenceNode;
29+
import org.sonar.plugins.communitydelphi.api.ast.PrimaryExpressionNode;
30+
import org.sonar.plugins.communitydelphi.api.check.DelphiCheck;
31+
import org.sonar.plugins.communitydelphi.api.check.DelphiCheckContext;
32+
import org.sonar.plugins.communitydelphi.api.symbol.declaration.RoutineNameDeclaration;
33+
import org.sonar.plugins.communitydelphi.api.symbol.declaration.VariableNameDeclaration;
34+
35+
@Rule(key = "ObjectPassedAsInterface")
36+
public class ObjectPassedAsInterfaceCheck extends DelphiCheck {
37+
private static final String MESSAGE = "Do not pass this object reference as an interface.";
38+
39+
@Override
40+
public DelphiCheckContext visit(ArgumentListNode argumentList, DelphiCheckContext context) {
41+
var interfaceIndices = getInterfaceParameterIndices(argumentList);
42+
var arguments = argumentList.getArgumentNodes();
43+
for (int i = 0; i < arguments.size(); i++) {
44+
if (!interfaceIndices.contains(i)) {
45+
continue;
46+
}
47+
48+
ExpressionNode expression = arguments.get(i).getExpression();
49+
50+
if (isVariableWithClassType(expression)) {
51+
reportIssue(context, expression, MESSAGE);
52+
}
53+
}
54+
55+
return super.visit(argumentList, context);
56+
}
57+
58+
private static boolean isVariableWithClassType(ExpressionNode expression) {
59+
expression = expression.skipParentheses();
60+
61+
if (!(expression instanceof PrimaryExpressionNode)) {
62+
return false;
63+
}
64+
65+
var maybeName = expression.getChild(0);
66+
if (!(maybeName instanceof NameReferenceNode)) {
67+
return false;
68+
}
69+
70+
var declaration = ((NameReferenceNode) maybeName).getNameDeclaration();
71+
if (!(declaration instanceof VariableNameDeclaration)) {
72+
return false;
73+
}
74+
75+
return ((VariableNameDeclaration) declaration).getType().isClass();
76+
}
77+
78+
private static Set<Integer> getInterfaceParameterIndices(ArgumentListNode argumentList) {
79+
var maybeNameReference = argumentList.getParent().getChild(argumentList.getChildIndex() - 1);
80+
if (maybeNameReference instanceof NameReferenceNode) {
81+
var declaration = ((NameReferenceNode) maybeNameReference).getNameDeclaration();
82+
if (declaration instanceof RoutineNameDeclaration) {
83+
var routine = (RoutineNameDeclaration) declaration;
84+
var parameters = routine.getParameters();
85+
return IntStream.range(0, parameters.size())
86+
.filter(i -> parameters.get(i).getType().isInterface())
87+
.boxed()
88+
.collect(Collectors.toSet());
89+
}
90+
}
91+
92+
return Collections.emptySet();
93+
}
94+
}

‎delphi-checks/src/main/resources/org/sonar/l10n/delphi/rules/community-delphi/ObjectPassedAsInterface.html‎

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
<h2>Why is this an issue?</h2>
2+
<p>
3+
In other languages, it is common to define a method with interface-type arguments so that
4+
it can interact with a concrete object in an encapsulated way. In Delphi, if you
5+
<strong>ever</strong> interact with an object through an interface, you should
6+
<strong>always</strong> interact with that object through an interface so that reference
7+
counting semantics are not unexpectedly violated.
8+
</p>
9+
<p>
10+
Assigning an object reference to an interface-type variable in Delphi causes that object to become
11+
reference counted (i.e. the object will be automatically destroyed when there are no longer any
12+
in-scope references). Only references through interface-type variables increment and decrement the
13+
reference count, so direct object references will not be counted.
14+
hen used carelessly, this can lead to memory issues and access violations. For example:
15+
</p>
16+
<pre>
17+
procedure ReadManualFor(Appliance: IAppliance);
18+
begin
19+
// ...
20+
end;
21+
22+
procedure Example;
23+
var
24+
TV: TTelevision;
25+
begin
26+
TV := TTelevision.Create;
27+
ReadManualFor(TV);
28+
WriteLn(TV.Brand); // Access violation!
29+
end;
30+
</pre>
31+
<h2>How to fix it</h2>
32+
<p>
33+
The concrete-typed variable should be changed to an interface type if possible:
34+
</p>
35+
<pre data-diff-type="noncompliant" data-diff-id="1">
36+
procedure ReadManualFor(Appliance: IAppliance);
37+
38+
procedure Example;
39+
var
40+
TV: TTelevision;
41+
begin
42+
TV := TTelevision.Create;
43+
TV.ConnectAerial;
44+
ReadManualFor(TV);
45+
WriteLn(TV.Brand);
46+
end;
47+
</pre>
48+
<pre data-diff-type="compliant" data-diff-id="1">
49+
procedure ReadManualFor(Appliance: IAppliance);
50+
51+
procedure Example;
52+
var
53+
TV: IAppliance;
54+
begin
55+
TV := TTelevision.Create;
56+
TTelevision(TV).ConnectAerial;
57+
ReadManualFor(TV);
58+
WriteLn(TV.Brand);
59+
end;
60+
</pre>
61+
<p>
62+
If keeping a direct object reference is really important, cast the variable to make the new semantics clear:
63+
</p>
64+
<pre data-diff-type="noncompliant" data-diff-id="2">
65+
procedure ReadManualFor(Appliance: IAppliance);
66+
67+
procedure Example;
68+
var
69+
TV: TTelevision;
70+
begin
71+
TV := TTelevision.Create;
72+
TV.ConnectAerial;
73+
ReadManualFor(TV);
74+
WriteLn(TV.Brand);
75+
end;
76+
</pre>
77+
<pre data-diff-type="compliant" data-diff-id="2">
78+
procedure ReadManualFor(Appliance: IAppliance);
79+
80+
procedure Example;
81+
var
82+
TV: TTelevision;
83+
begin
84+
TV := TTelevision.Create;
85+
TV.ConnectAerial;
86+
ReadManualFor(IAppliance(TV));
87+
WriteLn(TV.Brand);
88+
end;
89+
</pre>
90+
<h2>Resources</h2>
91+
<ul>
92+
<li>
93+
<a href="https://docwiki.embarcadero.com/RADStudio/en/Memory_Management_of_Interface_Objects">
94+
RAD Studio documentation: Memory Management of Interface Objects
95+
</a>
96+
</li>
97+
<li>
98+
<a href="https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Using_Reference_Counting">
99+
RAD Studio documentation: Using Reference Counting
100+
</a>
101+
</li>
102+
</ul>

‎delphi-checks/src/main/resources/org/sonar/l10n/delphi/rules/community-delphi/ObjectPassedAsInterface.json‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
{
2+
"title": "Object references should not be passed as interfaces",
3+
"type": "CODE_SMELL",
4+
"status": "ready",
5+
"remediation": {
6+
"func": "Constant/Issue",
7+
"constantCost": "5min"
8+
},
9+
"code": {
10+
"attribute": "LOGICAL",
11+
"impacts": {
12+
"RELIABILITY": "MEDIUM"
13+
}
14+
},
15+
"tags": ["bad-practice"],
16+
"defaultSeverity": "Major",
17+
"scope": "ALL",
18+
"quickfix": "unknown"
19+
}

‎delphi-checks/src/main/resources/org/sonar/l10n/delphi/rules/community-delphi/Sonar_way_profile.json‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@
6161
"NilComparison",
6262
"NoSonar",
6363
"NonLinearCast",
64+
"ObjectPassedAsInterface",
6465
"ObjectType",
6566
"PascalStyleResult",
6667
"PlatformDependentCast",

‎delphi-checks/src/test/java/au/com/integradev/delphi/checks/ObjectPassedAsInterfaceCheckTest.java‎

Lines changed: 135 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,135 @@
1+
/*
2+
* Sonar Delphi Plugin
3+
* Copyright (C) 2025 Integrated Application Development
4+
*
5+
* This program is free software; you can redistribute it and/or
6+
* modify it under the terms of the GNU Lesser General Public
7+
* License as published by the Free Software Foundation; either
8+
* version 3 of the License, or (at your option) any later version.
9+
*
10+
* This program is distributed in the hope that it will be useful,
11+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13+
* Lesser General Public License for more details.
14+
*
15+
* You should have received a copy of the GNU Lesser General Public
16+
* License along with this program; if not, write to the Free Software
17+
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02
18+
*/
19+
package au.com.integradev.delphi.checks;
20+
21+
import au.com.integradev.delphi.builders.DelphiTestUnitBuilder;
22+
import au.com.integradev.delphi.checks.verifier.CheckVerifier;
23+
import org.junit.jupiter.api.Test;
24+
25+
class ObjectPassedAsInterfaceCheckTest {
26+
@Test
27+
void testObjectPassedAsObjectShouldNotAddIssue() {
28+
CheckVerifier.newVerifier()
29+
.withCheck(new ObjectPassedAsInterfaceCheck())
30+
.onFile(
31+
new DelphiTestUnitBuilder()
32+
.appendDecl("type")
33+
.appendDecl(" IFooIntf = interface")
34+
.appendDecl(" end;")
35+
.appendDecl(" TFooImpl = class(TObject, IFooIntf)")
36+
.appendDecl(" end;")
37+
.appendDecl("procedure DoThing(Obj: TFooImpl);")
38+
.appendImpl("procedure Test;")
39+
.appendImpl("var")
40+
.appendImpl(" Obj: TFooImpl;")
41+
.appendImpl("begin")
42+
.appendImpl(" Obj := TFooImpl.Create;")
43+
.appendImpl(" DoThing(Obj);")
44+
.appendImpl("end;"))
45+
.verifyNoIssues();
46+
}
47+
48+
@Test
49+
void testObjectPassedAsInterfaceShouldAddIssue() {
50+
CheckVerifier.newVerifier()
51+
.withCheck(new ObjectPassedAsInterfaceCheck())
52+
.onFile(
53+
new DelphiTestUnitBuilder()
54+
.appendDecl("type")
55+
.appendDecl(" IFooIntf = interface")
56+
.appendDecl(" end;")
57+
.appendDecl(" TFooImpl = class(TObject, IFooIntf)")
58+
.appendDecl(" end;")
59+
.appendDecl("procedure DoThing(Obj: IFooIntf);")
60+
.appendImpl("procedure Test;")
61+
.appendImpl("var")
62+
.appendImpl(" Obj: TFooImpl;")
63+
.appendImpl("begin")
64+
.appendImpl(" Obj := TFooImpl.Create;")
65+
.appendImpl(" DoThing(Obj); // Noncompliant")
66+
.appendImpl("end;"))
67+
.verifyIssues();
68+
}
69+
70+
@Test
71+
void testObjectCastToInterfaceShouldNotAddIssue() {
72+
CheckVerifier.newVerifier()
73+
.withCheck(new ObjectPassedAsInterfaceCheck())
74+
.onFile(
75+
new DelphiTestUnitBuilder()
76+
.appendDecl("type")
77+
.appendDecl(" IFooIntf = interface")
78+
.appendDecl(" end;")
79+
.appendDecl(" TFooImpl = class(TObject, IFooIntf)")
80+
.appendDecl(" end;")
81+
.appendDecl("procedure DoThing(Obj: IFooIntf);")
82+
.appendImpl("procedure Test;")
83+
.appendImpl("var")
84+
.appendImpl(" Obj: TFooImpl;")
85+
.appendImpl("begin")
86+
.appendImpl(" Obj := TFooImpl.Create;")
87+
.appendImpl(" DoThing(IFooIntf(Obj));")
88+
.appendImpl("end;"))
89+
.verifyNoIssues();
90+
}
91+
92+
@Test
93+
void testNewObjectPassedAsInterfaceShouldNotAddIssue() {
94+
CheckVerifier.newVerifier()
95+
.withCheck(new ObjectPassedAsInterfaceCheck())
96+
.onFile(
97+
new DelphiTestUnitBuilder()
98+
.appendDecl("type")
99+
.appendDecl(" IFooIntf = interface")
100+
.appendDecl(" end;")
101+
.appendDecl(" TFooImpl = class(TObject, IFooIntf)")
102+
.appendDecl(" end;")
103+
.appendDecl("procedure DoThing(Obj: IFooIntf);")
104+
.appendImpl("procedure Test;")
105+
.appendImpl("begin")
106+
.appendImpl(" DoThing(TFooImpl.Create);")
107+
.appendImpl("end;"))
108+
.verifyNoIssues();
109+
}
110+
111+
@Test
112+
void testObjectPassedAsInterfaceToInheritedShouldAddIssue() {
113+
CheckVerifier.newVerifier()
114+
.withCheck(new ObjectPassedAsInterfaceCheck())
115+
.onFile(
116+
new DelphiTestUnitBuilder()
117+
.appendDecl("type")
118+
.appendDecl(" IFooIntf = interface")
119+
.appendDecl(" end;")
120+
.appendDecl(" TFooParent = class(TObject)")
121+
.appendDecl(" procedure Bar(Foo: IFooIntf); virtual;")
122+
.appendDecl(" end;")
123+
.appendDecl(" TFooImpl = class(TFooParent, IFooIntf)")
124+
.appendDecl(" procedure Bar(Foo: IFooIntf); override;")
125+
.appendDecl(" end;")
126+
.appendImpl("procedure TFooImpl.Bar(Foo: IFooIntf);")
127+
.appendImpl("var")
128+
.appendImpl(" Obj: TFooImpl;")
129+
.appendImpl("begin")
130+
.appendImpl(" Obj := TFooImpl.Create;")
131+
.appendImpl(" inherited Bar(Obj); // Noncompliant")
132+
.appendImpl("end;"))
133+
.verifyIssues();
134+
}
135+
}

0 commit comments

Comments
 (0)