Implement ObjectPassedAsInterface check

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

@@ -117,6 +117,7 @@ public final class CheckList {
           NilComparisonCheck.class,
           NoSonarCheck.class,
           NonLinearCastCheck.class,
+          ObjectPassedAsInterfaceCheck.class,
           ObjectTypeCheck.class,
           ParsingErrorCheck.class,
           PascalStyleResultCheck.class,

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

@@ -0,0 +1,94 @@
+/*
+ * Sonar Delphi Plugin
+ * Copyright (C) 2025 Integrated Application Development
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 3 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02
+ */
+package au.com.integradev.delphi.checks;
+
+import java.util.Collections;
+import java.util.Set;
+import java.util.stream.Collectors;
+import java.util.stream.IntStream;
+import org.sonar.check.Rule;
+import org.sonar.plugins.communitydelphi.api.ast.ArgumentListNode;
+import org.sonar.plugins.communitydelphi.api.ast.ExpressionNode;
+import org.sonar.plugins.communitydelphi.api.ast.NameReferenceNode;
+import org.sonar.plugins.communitydelphi.api.ast.PrimaryExpressionNode;
+import org.sonar.plugins.communitydelphi.api.check.DelphiCheck;
+import org.sonar.plugins.communitydelphi.api.check.DelphiCheckContext;
+import org.sonar.plugins.communitydelphi.api.symbol.declaration.RoutineNameDeclaration;
+import org.sonar.plugins.communitydelphi.api.symbol.declaration.VariableNameDeclaration;
+
+@Rule(key = "ObjectPassedAsInterface")
+public class ObjectPassedAsInterfaceCheck extends DelphiCheck {
+  private static final String MESSAGE = "Do not pass this object reference as an interface.";
+
+  @Override
+  public DelphiCheckContext visit(ArgumentListNode argumentList, DelphiCheckContext context) {
+    var interfaceIndices = getInterfaceParameterIndices(argumentList);
+    var arguments = argumentList.getArgumentNodes();
+    for (int i = 0; i < arguments.size(); i++) {
+      if (!interfaceIndices.contains(i)) {
+        continue;
+      }
+
+      ExpressionNode expression = arguments.get(i).getExpression();
+
+      if (isVariableWithClassType(expression)) {
+        reportIssue(context, expression, MESSAGE);
+      }
+    }
+
+    return super.visit(argumentList, context);
+  }
+
+  private static boolean isVariableWithClassType(ExpressionNode expression) {
+    expression = expression.skipParentheses();
+
+    if (!(expression instanceof PrimaryExpressionNode)) {
+      return false;
+    }
+
+    var maybeName = expression.getChild(0);
+    if (!(maybeName instanceof NameReferenceNode)) {
+      return false;
+    }
+
+    var declaration = ((NameReferenceNode) maybeName).getNameDeclaration();
+    if (!(declaration instanceof VariableNameDeclaration)) {
+      return false;
+    }
+
+    return ((VariableNameDeclaration) declaration).getType().isClass();
+  }
+
+  private static Set<Integer> getInterfaceParameterIndices(ArgumentListNode argumentList) {
+    var maybeNameReference = argumentList.getParent().getChild(argumentList.getChildIndex() - 1);
+    if (maybeNameReference instanceof NameReferenceNode) {
+      var declaration = ((NameReferenceNode) maybeNameReference).getNameDeclaration();
+      if (declaration instanceof RoutineNameDeclaration) {
+        var routine = (RoutineNameDeclaration) declaration;
+        var parameters = routine.getParameters();
+        return IntStream.range(0, parameters.size())
+            .filter(i -> parameters.get(i).getType().isInterface())
+            .boxed()
+            .collect(Collectors.toSet());
+      }
+    }
+
+    return Collections.emptySet();
+  }
+}

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

@@ -0,0 +1,103 @@
+<h2>Why is this an issue?</h2>
+<p>
+  In other languages, it is common to define a method with interface-type arguments so that
+  it can interact with a concrete object in an encapsulated way. In Delphi, if you
+  <strong>ever</strong> interact with an object through an interface, you should
+  <strong>always</strong> interact with that object through an interface so that reference
+  counting semantics are not unexpectedly violated.
+</p>
+<p>
+  Assigning an object to an interface-type variable in Delphi causes that object to become
+  reference counted (i.e. the object will be automatically destroyed when there are no longer any
+  in-scope references). Only interface-type variables increment and decrement the reference count,
+  so concrete-type variables referencing the object will not be counted. When used carelessly,
+  this can lead to memory issues and access violations. For example:
+</p>
+<pre>
+procedure ReadManualFor(Appliance: IAppliance);
+begin
+  // ...
+end;
+
+procedure Example;
+var
+  TV: TTelevision;
+begin
+  TV := TTelevision.Create;
+  ReadManualFor(TV);
+  WriteLn(TV.Brand); // Access violation!
+end;
+</pre>
+<h2>How to fix it</h2>
+<p>
+  The concrete-typed variable should be changed to an interface type if possible:
+</p>
+<pre data-diff-type="noncompliant" data-diff-id="1">
+procedure ReadManualFor(Appliance: IAppliance);
+
+procedure Example;
+var
+ TV: TTelevision;
+begin
+  TV := TTelevision.Create;
+  TV.ConnectAerial;
+  ReadManualFor(TV);
+  WriteLn(TV.Brand);
+end;
+</pre>
+<pre data-diff-type="compliant" data-diff-id="1">
+procedure ReadManualFor(Appliance: IAppliance);
+
+procedure Example;
+var
+ TV: IAppliance;
+begin
+  TV := TTelevision.Create;
+  TTelevision(TV).ConnectAerial;
+  ReadManualFor(TV);
+  WriteLn(TV.Brand);
+end;
+</pre>
+<p>
+  If keeping the variable the concrete type is really important, cast the variable to make the
+  new semantics clear:
+</p>
+<pre data-diff-type="noncompliant" data-diff-id="2">
+procedure ReadManualFor(Appliance: IAppliance);
+
+procedure Example;
+var
+ TV: TTelevision;
+begin
+  TV := TTelevision.Create;
+  TV.ConnectAerial;
+  ReadManualFor(TV);
+  WriteLn(TV.Brand);
+end;
+</pre>
+<pre data-diff-type="compliant" data-diff-id="2">
+procedure ReadManualFor(Appliance: IAppliance);
+
+procedure Example;
+var
+ TV: TTelevision;
+begin
+  TV := TTelevision.Create;
+  TV.ConnectAerial;
+  ReadManualFor(IAppliance(TV));
+  WriteLn(TV.Brand);
+end;
+</pre>
+<h2>Resources</h2>
+<ul>
+  <li>
+    <a href="https://docwiki.embarcadero.com/RADStudio/en/Memory_Management_of_Interface_Objects">
+      RAD Studio documentation: Memory Management of Interface Objects
+    </a>
+  </li>
+  <li>
+    <a href="https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Using_Reference_Counting">
+      RAD Studio documentation: Using Reference Counting
+    </a>
+  </li>
+</ul>

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

@@ -0,0 +1,19 @@
+{
+  "title": "Concrete-typed variables should not be passed as arguments to interface-typed parameters",
+  "type": "CODE_SMELL",
+  "status": "ready",
+  "remediation": {
+    "func": "Constant/Issue",
+    "constantCost": "5min"
+  },
+  "code": {
+    "attribute": "LOGICAL",
+    "impacts": {
+      "RELIABILITY": "MEDIUM"
+    }
+  },
+  "tags": ["bad-practice"],
+  "defaultSeverity": "Major",
+  "scope": "ALL",
+  "quickfix": "unknown"
+}

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

@@ -61,6 +61,7 @@
     "NilComparison",
     "NoSonar",
     "NonLinearCast",
+    "ObjectPassedAsInterface",
     "ObjectType",
     "PascalStyleResult",
     "PlatformDependentCast",

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

@@ -0,0 +1,135 @@
+/*
+ * Sonar Delphi Plugin
+ * Copyright (C) 2025 Integrated Application Development
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 3 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02
+ */
+package au.com.integradev.delphi.checks;
+
+import au.com.integradev.delphi.builders.DelphiTestUnitBuilder;
+import au.com.integradev.delphi.checks.verifier.CheckVerifier;
+import org.junit.jupiter.api.Test;
+
+class ObjectPassedAsInterfaceCheckTest {
+  @Test
+  void testObjectPassedAsObjectShouldNotAddIssue() {
+    CheckVerifier.newVerifier()
+        .withCheck(new ObjectPassedAsInterfaceCheck())
+        .onFile(
+            new DelphiTestUnitBuilder()
+                .appendDecl("type")
+                .appendDecl("  IFooIntf = interface")
+                .appendDecl("  end;")
+                .appendDecl("  TFooImpl = class(TObject, IFooIntf)")
+                .appendDecl("  end;")
+                .appendDecl("procedure DoThing(Obj: TFooImpl);")
+                .appendImpl("procedure Test;")
+                .appendImpl("var")
+                .appendImpl("  Obj: TFooImpl;")
+                .appendImpl("begin")
+                .appendImpl("  Obj := TFooImpl.Create;")
+                .appendImpl("  DoThing(Obj);")
+                .appendImpl("end;"))
+        .verifyNoIssues();
+  }
+
+  @Test
+  void testObjectPassedAsInterfaceShouldAddIssue() {
+    CheckVerifier.newVerifier()
+        .withCheck(new ObjectPassedAsInterfaceCheck())
+        .onFile(
+            new DelphiTestUnitBuilder()
+                .appendDecl("type")
+                .appendDecl("  IFooIntf = interface")
+                .appendDecl("  end;")
+                .appendDecl("  TFooImpl = class(TObject, IFooIntf)")
+                .appendDecl("  end;")
+                .appendDecl("procedure DoThing(Obj: IFooIntf);")
+                .appendImpl("procedure Test;")
+                .appendImpl("var")
+                .appendImpl("  Obj: TFooImpl;")
+                .appendImpl("begin")
+                .appendImpl("  Obj := TFooImpl.Create;")
+                .appendImpl("  DoThing(Obj); // Noncompliant")
+                .appendImpl("end;"))
+        .verifyIssues();
+  }
+
+  @Test
+  void testObjectCastToInterfaceShouldNotAddIssue() {
+    CheckVerifier.newVerifier()
+        .withCheck(new ObjectPassedAsInterfaceCheck())
+        .onFile(
+            new DelphiTestUnitBuilder()
+                .appendDecl("type")
+                .appendDecl("  IFooIntf = interface")
+                .appendDecl("  end;")
+                .appendDecl("  TFooImpl = class(TObject, IFooIntf)")
+                .appendDecl("  end;")
+                .appendDecl("procedure DoThing(Obj: IFooIntf);")
+                .appendImpl("procedure Test;")
+                .appendImpl("var")
+                .appendImpl("  Obj: TFooImpl;")
+                .appendImpl("begin")
+                .appendImpl("  Obj := TFooImpl.Create;")
+                .appendImpl("  DoThing(IFooIntf(Obj));")
+                .appendImpl("end;"))
+        .verifyNoIssues();
+  }
+
+  @Test
+  void testNewObjectPassedAsInterfaceShouldNotAddIssue() {
+    CheckVerifier.newVerifier()
+        .withCheck(new ObjectPassedAsInterfaceCheck())
+        .onFile(
+            new DelphiTestUnitBuilder()
+                .appendDecl("type")
+                .appendDecl("  IFooIntf = interface")
+                .appendDecl("  end;")
+                .appendDecl("  TFooImpl = class(TObject, IFooIntf)")
+                .appendDecl("  end;")
+                .appendDecl("procedure DoThing(Obj: IFooIntf);")
+                .appendImpl("procedure Test;")
+                .appendImpl("begin")
+                .appendImpl("  DoThing(TFooImpl.Create);")
+                .appendImpl("end;"))
+        .verifyNoIssues();
+  }
+
+  @Test
+  void testObjectPassedAsInterfaceToInheritedShouldAddIssue() {
+    CheckVerifier.newVerifier()
+        .withCheck(new ObjectPassedAsInterfaceCheck())
+        .onFile(
+            new DelphiTestUnitBuilder()
+                .appendDecl("type")
+                .appendDecl("  IFooIntf = interface")
+                .appendDecl("  end;")
+                .appendDecl("  TFooParent = class(TObject)")
+                .appendDecl("    procedure Bar(Foo: IFooIntf); virtual;")
+                .appendDecl("  end;")
+                .appendDecl("  TFooImpl = class(TFooParent, IFooIntf)")
+                .appendDecl("    procedure Bar(Foo: IFooIntf); override;")
+                .appendDecl("  end;")
+                .appendImpl("procedure TFooImpl.Bar(Foo: IFooIntf);")
+                .appendImpl("var")
+                .appendImpl("  Obj: TFooImpl;")
+                .appendImpl("begin")
+                .appendImpl("  Obj := TFooImpl.Create;")
+                .appendImpl("  inherited Bar(Obj); // Noncompliant")
+                .appendImpl("end;"))
+        .verifyIssues();
+  }
+}