diff --git a/src/Runtime/XSharp.VFP.Tests/CompObjTests.prg b/src/Runtime/XSharp.VFP.Tests/CompObjTests.prg new file mode 100644 index 0000000000..07d7b8ffc8 --- /dev/null +++ b/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 diff --git a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj index 846b21cb8c..1f6ed65acf 100644 --- a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj +++ b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj @@ -94,6 +94,7 @@ + diff --git a/src/Runtime/XSharp.VFP/ClassFunctions.prg b/src/Runtime/XSharp.VFP/ClassFunctions.prg index 69c4e0bf6c..8edf5b6661 100644 --- a/src/Runtime/XSharp.VFP/ClassFunctions.prg +++ b/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 + /// [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) +/// +[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{} + 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 + diff --git a/src/Runtime/XSharp.VFP/ToDo-C.prg b/src/Runtime/XSharp.VFP/ToDo-C.prg index 5d020d9538..c9a6b66a42 100644 --- a/src/Runtime/XSharp.VFP/ToDo-C.prg +++ b/src/Runtime/XSharp.VFP/ToDo-C.prg @@ -13,13 +13,6 @@ FUNCTION Candidate (nIndexNumber , uArea) THROW NotImplementedException{} // RETURN FALSE -/// -- todo -- -/// -[FoxProFunction("COMPOBJ", FoxFunctionCategory.ClassAndObject, FoxEngine.LanguageCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)]; -FUNCTION CompObj (oExpression1, oExpression2) - THROW NotImplementedException{} - // RETURN FALSE - /// -- todo -- /// [FoxProFunction("CPCONVERT", FoxFunctionCategory.EnvironmentAndSystem, FoxEngine.RuntimeCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)];