Implement KEYMATCH and LOOKUP functions

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

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

@@ -100,6 +100,7 @@
     <Compile Include="FinancialTests.prg" />
     <Compile Include="IndexOnTrimTests.prg" />
     <Compile Include="IntrospectionTests.prg" />
+    <Compile Include="KeyMatchLookupTests.prg" />
     <Compile Include="SQLStatementTests.prg" />
     <Compile Include="StrConvTests.prg" />
     <Compile Include="TypeTests.prg" />

src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg

@@ -564,3 +564,50 @@ FUNCTION CursorGetProp(cProperty, uArea) AS USUAL CLIPPER
     FINALLY
         RuntimeState.CurrentWorkarea := nOldArea
     END TRY
+
+/// <include file="VFPDocs.xml" path="Runtimefunctions/keymatch/*" />
+[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
+
+/// <include file="VFPDocs.xml" path="Runtimefunctions/lookup/*" />
+[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

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

@@ -5,19 +5,6 @@
 
 
 #pragma options("vo15", on)
-/// <summary>-- todo --</summary>
-/// <include file="VFPDocs.xml" path="Runtimefunctions/keymatch/*" />
-[FoxProFunction("KEYMATCH", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
-FUNCTION KeyMatch(eIndexKey , nIndexNumber , uArea)  AS LOGIC
-    THROW NotImplementedException{}
-    // RETURN FALSE
-
-/// <summary>-- todo --</summary>
-/// <include file="VFPDocs.xml" path="Runtimefunctions/lookup/*" />
-[FoxProFunction("LOOKUP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
-FUNCTION Lookup( ReturnField, eSearchExpression, SearchedField , cTagName) AS USUAL
-    THROW NotImplementedException{}
-    // RETURN NIL
 
 /// <summary>-- todo --</summary>
 /// <include file="VFPDocs.xml" path="Runtimefunctions/maketransactable/*" />