Implement COMPOBJ() function

src/Runtime/XSharp.VFP.Tests/CompObjTests.prg

@@ -0,0 +1,138 @@
+//
+// Copyright (c) XSharp B.V.  All Rights Reserved.
+// Licensed under the Apache License, Version 2.0.
+// See License.txt in the project root for license information.
+//
+
+
+USING System
+USING XUnit
+
+BEGIN NAMESPACE XSharp.VFP.Tests
+    CLASS SimpleObj
+        PROPERTY Name AS STRING AUTO
+        PROPERTY Age AS INT AUTO
+    END CLASS
+
+    CLASS NestedObj
+        PROPERTY Title AS STRING AUTO
+        PROPERTY Child AS SimpleObj AUTO
+    END CLASS
+
+    CLASS ExtraPropObj
+        PROPERTY Name AS STRING AUTO
+        PROPERTY Age AS INT AUTO
+        PROPERTY Extra AS STRING AUTO
+    END CLASS
+
+    CLASS WithIndexerObj
+        PROPERTY Name AS STRING AUTO
+        PROPERTY SELF[nIndex AS INT] AS INT
+            GET
+                RETURN nIndex
+            END GET
+        END PROPERTY
+    END CLASS
+
+    CLASS CompObjTests
+        STATIC CONSTRUCTOR
+            XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro
+        END CONSTRUCTOR
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD SameObjReferenceTest AS VOID
+            VAR o := SimpleObj{}
+            o:Name := "Test"
+            o:Age := 42
+            Assert.True(COMPOBJ(o, o))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD IdenticalObjectsTest AS VOID
+            VAR o1 := SimpleObj{}
+            o1:Name := "Test"
+            o1:Age := 42
+
+            VAR o2 := SimpleObj{}
+            o2:Name := "Test"
+            o2:Age := 42
+
+            Assert.True(COMPOBJ(o1, o2))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD DifferentValuesTest AS VOID
+            LOCAL o1, o2 AS SimpleObj
+            o1 := SimpleObj{}
+            o1:Name := "Test"
+            o1:Age := 42
+
+            o2 := SimpleObj{}
+            o2:Name := "Test"
+            o2:Age := 99
+
+            Assert.False(COMPOBJ(o1, o2))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD NestedObjectsEqualTest AS VOID
+            LOCAL o1, o2 AS NestedObj
+
+            o1 := NestedObj{}
+            o1:Title := "A"
+            o1:Child := SimpleObj{}
+            o1:Child:Name := "X"
+            o1:Child:Age := 1
+
+            o2 := NestedObj{}
+            o2:Title := "A"
+            o2:Child := SimpleObj{}
+            o2:Child:Name := "X"
+            o2:Child:Age := 1
+
+            Assert.True(COMPOBJ(o1, o2))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD BothNullTest AS VOID
+            Assert.True(COMPOBJ(NULL_OBJECT, NULL_OBJECT))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD OneNullTest AS VOID
+            VAR o := SimpleObj{}
+
+            Assert.False(COMPOBJ(o, NULL_OBJECT))
+            Assert.False(COMPOBJ(NULL_OBJECT, o))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD ExtraPropertyReturnsFalseTest AS VOID
+            // oExpression2 has an extra "Extra" property not present on oExpression1
+            VAR o1 := SimpleObj{}
+            o1:Name := "Test"
+            o1:Age := 42
+
+            VAR o2 := ExtraPropObj{}
+            o2:Name := "Test"
+            o2:Age := 42
+            o2:Extra := "Extra"
+
+            Assert.False(COMPOBJ(o1, o2))
+            Assert.False(COMPOBJ(o2, o1))
+        END METHOD
+
+        [Fact, Trait("Category", "ClassAndObject")];
+        METHOD IndexedPropertyIgnoredTest AS VOID
+            // Indexed properties must be ignored; only the regular Name property is compared
+            VAR o1 := WithIndexerObj{}
+            o1:Name := "Test"
+
+            VAR o2 := WithIndexerObj{}
+            o2:Name := "Test"
+
+            Assert.True(COMPOBJ(o1, o2))
+        END METHOD
+
+    END CLASS
+END NAMESPACE // XSharp.VFP.Tests

src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj

@@ -94,6 +94,7 @@
     <Compile Include="AMembersTests.prg" />
     <Compile Include="AUsedTests.prg" />
     <Compile Include="CommandTests.prg" />
+    <Compile Include="CompObjTests.prg" />
     <Compile Include="CopyToTests.prg" />
     <Compile Include="FileVersionTests.prg" />
     <Compile Include="FinancialTests.prg" />

src/Runtime/XSharp.VFP/ClassFunctions.prg

@@ -4,6 +4,9 @@
 // See License.txt in the project root for license information.
 //
 
+USING System.Reflection
+USING System.Collections.Generic
+
 /// <include file="VFPRuntimeDocs.xml" path="Runtimefunctions/addproperty/*" />
 [FoxProFunction("ADDPROPERTY", FoxFunctionCategory.ClassAndObject, FoxEngine.LanguageCore, FoxFunctionStatus.Full, FoxCriticality.High)];
 FUNCTION AddProperty (oObjectName AS OBJECT, cPropertyName AS STRING, eNewValue := NIL AS USUAL) AS LOGIC
@@ -34,3 +37,82 @@ FUNCTION GETPEM( uObject as USUAL, cProperty as STRING) as USUAL
     endif
     return IVarGet(uObject, cProperty)
 
+/// <include file="VFPDocs.xml" path="Runtimefunctions/compobj/*" />
+[FoxProFunction("COMPOBJ", FoxFunctionCategory.ClassAndObject, FoxEngine.LanguageCore, FoxFunctionStatus.Full, FoxCriticality.Medium)];
+FUNCTION CompObj (oExpression1 AS OBJECT, oExpression2 AS OBJECT) AS LOGIC
+    RETURN CompObjHelper(oExpression1, oExpression2, 0)
+
+INTERNAL FUNCTION CompObjHelper(oExpression1 AS OBJECT, oExpression2 AS OBJECT, nDepth AS INT) AS LOGIC
+    IF oExpression1 == NULL_OBJECT .AND. oExpression2 == NULL_OBJECT
+        RETURN TRUE
+    ENDIF
+
+    IF oExpression1 == NULL_OBJECT .OR. oExpression2 == NULL_OBJECT
+        RETURN FALSE
+    ENDIF
+
+    // Guard against cyclic object graphs causing infinite recursion.
+    // Returning TRUE (assume equal) at the depth limit mirrors the VFP behaviour of
+    // not recursing indefinitely; real cycles are extremely rare in practice.
+    LOCAL CONST MAX_COMPOBJ_DEPTH := 50 AS INT
+    IF nDepth > MAX_COMPOBJ_DEPTH
+        RETURN TRUE
+    ENDIF
+
+    // Build a name→PropertyInfo map for oExpression2's comparable (readable, non-indexed) properties
+    VAR dict2 := Dictionary<STRING, PropertyInfo>{}
+    FOREACH VAR oP IN oExpression2:GetType():GetProperties(BindingFlags.Public | BindingFlags.Instance)
+        IF oP:CanRead .AND. oP:GetIndexParameters():Length == 0
+            dict2[oP:Name] := oP
+        ENDIF
+    NEXT
+
+    // Iterate oExpression1's comparable properties and compare with O(1) lookup into dict2
+    LOCAL nComparableCount := 0 AS INT
+    FOREACH VAR oProp1 IN oExpression1:GetType():GetProperties(BindingFlags.Public | BindingFlags.Instance)
+        IF !oProp1:CanRead .OR. oProp1:GetIndexParameters():Length > 0
+            LOOP
+        ENDIF
+
+        nComparableCount++
+
+        IF !dict2:ContainsKey(oProp1:Name)
+            RETURN FALSE
+        ENDIF
+
+        VAR oProp2 := dict2[oProp1:Name]
+
+        VAR uVal1 := oProp1:GetValue(oExpression1)
+        VAR uVal2 := oProp2:GetValue(oExpression2)
+
+        IF uVal1 == NULL .AND. uVal2 == NULL
+            LOOP
+        ENDIF
+
+        IF uVal1 == NULL .OR. uVal2 == NULL
+            RETURN FALSE
+        ENDIF
+
+        IF uVal1 IS OBJECT VAR o1 .AND. uVal2 IS OBJECT VAR o2
+            VAR oType := o1:GetType()
+            IF oType:IsValueType .OR. oType == typeof(STRING)
+                IF !uVal1:Equals(uVal2)
+                    RETURN FALSE
+                ENDIF
+            ELSE
+                IF !CompObjHelper(o1, o2, nDepth + 1)
+                    RETURN FALSE
+                ENDIF
+            ENDIF
+        ELSEIF !uVal1:Equals(uVal2)
+            RETURN FALSE
+        ENDIF
+    NEXT
+
+    // If oExpression2 has more comparable properties than oExpression1, they differ
+    IF nComparableCount != dict2:Count
+        RETURN FALSE
+    ENDIF
+
+    RETURN TRUE
+

src/Runtime/XSharp.VFP/ToDo-C.prg

@@ -13,13 +13,6 @@ FUNCTION Candidate (nIndexNumber , uArea)
     THROW NotImplementedException{}
     // RETURN FALSE
 
-/// <summary>-- todo --</summary>
-/// <include file="VFPDocs.xml" path="Runtimefunctions/compobj/*" />
-[FoxProFunction("COMPOBJ", FoxFunctionCategory.ClassAndObject, FoxEngine.LanguageCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
-FUNCTION CompObj (oExpression1, oExpression2)
-    THROW NotImplementedException{}
-    // RETURN FALSE
-
 /// <summary>-- todo --</summary>
 /// <include file="VFPDocs.xml" path="Runtimefunctions/cpconvert/*" />
 [FoxProFunction("CPCONVERT", FoxFunctionCategory.EnvironmentAndSystem, FoxEngine.RuntimeCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)];