From 533f720aa4dbd83458234e69765e9660f7075010 Mon Sep 17 00:00:00 2001 From: Irwin Rodriguez Date: Sat, 11 Jul 2026 11:12:14 +0200 Subject: [PATCH] Implement KEYMATCH and LOOKUP functions --- .../XSharp.VFP.Tests/KeyMatchLookupTests.prg | 105 ++++++++++++++++++ .../XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj | 1 + .../XSharp.VFP/Cursors/DbFunctions.prg | 47 ++++++++ src/Runtime/XSharp.VFP/ToDo-KLM.prg | 13 --- 4 files changed, 153 insertions(+), 13 deletions(-) create mode 100644 src/Runtime/XSharp.VFP.Tests/KeyMatchLookupTests.prg diff --git a/src/Runtime/XSharp.VFP.Tests/KeyMatchLookupTests.prg b/src/Runtime/XSharp.VFP.Tests/KeyMatchLookupTests.prg new file mode 100644 index 0000000000..988fd3edd0 --- /dev/null +++ b/src/Runtime/XSharp.VFP.Tests/KeyMatchLookupTests.prg @@ -0,0 +1,105 @@ +// +// 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 System.Collections.Generic +USING System.Text +USING XUnit + +BEGIN NAMESPACE XSharp.VFP.Tests + + CLASS KeyMatchLookupTests + + STATIC CONSTRUCTOR + XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro + END CONSTRUCTOR + + // --- KEYMATCH --- + [Fact, Trait("Category", "KeyMatch")]; + METHOD KeyMatchExistingKeyReturnsTrue AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INSERT INTO curTest VALUES ("A002", "Product 2") + INSERT INTO curTest VALUES ("A003", "Product 3") + INDEX ON pCode TAG pCode + + Assert.True(KEYMATCH("A002")) + END METHOD + + [Fact, Trait("Category", "KeyMatch")]; + METHOD KeyMatchNonExistingKeyReturnsFalse AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INSERT INTO curTest VALUES ("A002", "Product 2") + INDEX ON pCode TAG pCode + + Assert.False(KEYMATCH("B999")) + END METHOD + + [Fact, Trait("Category", "KeyMatch")]; + METHOD KeyMatchPreservesRecordPointer AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INSERT INTO curTest VALUES ("A002", "Product 2") + INSERT INTO curTest VALUES ("A003", "Product 3") + INDEX ON pCode TAG pCode + + GOTO 3 + VAR nRecBefore := RECNO() + VAR lFound := KEYMATCH("A001") + VAR nRecAfter := RECNO() + + Assert.True(lFound) + Assert.Equal(nRecBefore, nRecAfter) + END METHOD + + // --- LOOKUP --- + [Fact, Trait("Category", "Lookup")]; + METHOD LookupFoundReturnsFieldValue AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INSERT INTO curTest VALUES ("A002", "Product 2") + INSERT INTO curTest VALUES ("A003", "Product 3") + INDEX ON pCode TAG pCode + + VAR cResult := LOOKUP("pName", "A002", "pCode", "pCode") + Assert.Equal("Product 2", ALLTRIM(cResult)) + END METHOD + + [Fact, Trait("Category", "Lookup")]; + METHOD LookupNotFoundReturnsEmpty AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INDEX ON pCode TAG pCode + + VAR cResult := LOOKUP("pName", "B999", "pCode", "pCode") + Assert.True(EMPTY(ALLTRIM(cResult))) + END METHOD + + [Fact, Trait("Category", "Lookup")]; + METHOD LookupFoundMovesPointer AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INSERT INTO curTest VALUES ("A002", "Product 2") + INDEX ON pCode TAG pCode + + GOTO 1 + LOOKUP("pName", "A002", "pCode", "pCode") + Assert.Equal("A002", ALLTRIM(FIELDGET(FieldPos("pCode")))) + END METHOD + + [Fact, Trait("Category", "Lookup")]; + METHOD LookupNotFoundEofTrue AS VOID + CREATE CURSOR curTest (pCode C(10), pName C(50)) + INSERT INTO curTest VALUES ("A001", "Product 1") + INDEX ON pCode TAG pCode + + LOOKUP("pName", "B999", "pCode", "pCode") + Assert.True(EOF()) + END METHOD + + END CLASS + +END NAMESPACE diff --git a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj index 90c8be2a15..85e2de6d35 100644 --- a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj +++ b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj @@ -100,6 +100,7 @@ + diff --git a/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg b/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg index 80ee06c265..f4a31b3dda 100644 --- a/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg +++ b/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg @@ -564,3 +564,50 @@ FUNCTION CursorGetProp(cProperty, uArea) AS USUAL CLIPPER FINALLY RuntimeState.CurrentWorkarea := nOldArea END TRY + +/// +[FoxProFunction("KEYMATCH", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.Medium)]; +FUNCTION KeyMatch(eIndexKey , nIndexNumber , uArea) AS LOGIC CLIPPER + RETURN _DoInArea(uArea, { => + VAR nOldRec := RecNo() + VAR cOldOrder := "" + VAR cOldBag := "" + VAR lResult := FALSE + + IF !IsNil(nIndexNumber) + cOldOrder := OrdName() + cOldBag := OrdBagName() + OrdSetFocus(nIndexNumber) + ENDIF + + DbSeek(eIndexKey) + lResult := Found() + + IF !IsNil(nIndexNumber) + OrdSetFocus(cOldOrder, cOldBag) + ENDIF + DbGoto(nOldRec) + + RETURN lResult + }, false, __FUNCTION__, 3) +END FUNCTION + +/// +[FoxProFunction("LOOKUP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.Medium)]; +FUNCTION Lookup( ReturnField, eSearchExpression, SearchedField , cTagName) AS USUAL CLIPPER + IF !IsNil(cTagName) + OrdSetFocus(cTagName) + ENDIF + + DbSeek(eSearchExpression) + + IF Found() + IF IsString(ReturnField) + RETURN FieldGet(FieldPos(ReturnField)) + ELSEIF IsNumeric(ReturnField) + RETURN FieldGet((DWORD)ReturnField) + ENDIF + ENDIF + + RETURN NIL +END FUNCTION diff --git a/src/Runtime/XSharp.VFP/ToDo-KLM.prg b/src/Runtime/XSharp.VFP/ToDo-KLM.prg index a581ad54a4..6208e9fb10 100644 --- a/src/Runtime/XSharp.VFP/ToDo-KLM.prg +++ b/src/Runtime/XSharp.VFP/ToDo-KLM.prg @@ -5,19 +5,6 @@ #pragma options("vo15", on) -/// -- todo -- -/// -[FoxProFunction("KEYMATCH", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)]; -FUNCTION KeyMatch(eIndexKey , nIndexNumber , uArea) AS LOGIC - THROW NotImplementedException{} - // RETURN FALSE - -/// -- todo -- -/// -[FoxProFunction("LOOKUP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)]; -FUNCTION Lookup( ReturnField, eSearchExpression, SearchedField , cTagName) AS USUAL - THROW NotImplementedException{} - // RETURN NIL /// -- todo -- ///