Skip to content

Commit 16e836f

Browse files
Irwin1985Irwin1985
authored
Implement KEYMATCH and LOOKUP functions (#2004)
1 parent 9077ae2 commit 16e836f

4 files changed

Lines changed: 153 additions & 13 deletions

File tree

‎src/Runtime/XSharp.VFP.Tests/KeyMatchLookupTests.prg‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
//
2+
// Copyright (c) XSharp B.V. All Rights Reserved.
3+
// Licensed under the Apache License, Version 2.0.
4+
// See License.txt in the project root for license information.
5+
//
6+
USING System
7+
USING System.Collections.Generic
8+
USING System.Text
9+
USING XUnit
10+
11+
BEGIN NAMESPACE XSharp.VFP.Tests
12+
13+
CLASS KeyMatchLookupTests
14+
15+
STATIC CONSTRUCTOR
16+
XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro
17+
END CONSTRUCTOR
18+
19+
// --- KEYMATCH ---
20+
[Fact, Trait("Category", "KeyMatch")];
21+
METHOD KeyMatchExistingKeyReturnsTrue AS VOID
22+
CREATE CURSOR curTest (pCode C(10), pName C(50))
23+
INSERT INTO curTest VALUES ("A001", "Product 1")
24+
INSERT INTO curTest VALUES ("A002", "Product 2")
25+
INSERT INTO curTest VALUES ("A003", "Product 3")
26+
INDEX ON pCode TAG pCode
27+
28+
Assert.True(KEYMATCH("A002"))
29+
END METHOD
30+
31+
[Fact, Trait("Category", "KeyMatch")];
32+
METHOD KeyMatchNonExistingKeyReturnsFalse AS VOID
33+
CREATE CURSOR curTest (pCode C(10), pName C(50))
34+
INSERT INTO curTest VALUES ("A001", "Product 1")
35+
INSERT INTO curTest VALUES ("A002", "Product 2")
36+
INDEX ON pCode TAG pCode
37+
38+
Assert.False(KEYMATCH("B999"))
39+
END METHOD
40+
41+
[Fact, Trait("Category", "KeyMatch")];
42+
METHOD KeyMatchPreservesRecordPointer AS VOID
43+
CREATE CURSOR curTest (pCode C(10), pName C(50))
44+
INSERT INTO curTest VALUES ("A001", "Product 1")
45+
INSERT INTO curTest VALUES ("A002", "Product 2")
46+
INSERT INTO curTest VALUES ("A003", "Product 3")
47+
INDEX ON pCode TAG pCode
48+
49+
GOTO 3
50+
VAR nRecBefore := RECNO()
51+
VAR lFound := KEYMATCH("A001")
52+
VAR nRecAfter := RECNO()
53+
54+
Assert.True(lFound)
55+
Assert.Equal(nRecBefore, nRecAfter)
56+
END METHOD
57+
58+
// --- LOOKUP ---
59+
[Fact, Trait("Category", "Lookup")];
60+
METHOD LookupFoundReturnsFieldValue AS VOID
61+
CREATE CURSOR curTest (pCode C(10), pName C(50))
62+
INSERT INTO curTest VALUES ("A001", "Product 1")
63+
INSERT INTO curTest VALUES ("A002", "Product 2")
64+
INSERT INTO curTest VALUES ("A003", "Product 3")
65+
INDEX ON pCode TAG pCode
66+
67+
VAR cResult := LOOKUP("pName", "A002", "pCode", "pCode")
68+
Assert.Equal("Product 2", ALLTRIM(cResult))
69+
END METHOD
70+
71+
[Fact, Trait("Category", "Lookup")];
72+
METHOD LookupNotFoundReturnsEmpty AS VOID
73+
CREATE CURSOR curTest (pCode C(10), pName C(50))
74+
INSERT INTO curTest VALUES ("A001", "Product 1")
75+
INDEX ON pCode TAG pCode
76+
77+
VAR cResult := LOOKUP("pName", "B999", "pCode", "pCode")
78+
Assert.True(EMPTY(ALLTRIM(cResult)))
79+
END METHOD
80+
81+
[Fact, Trait("Category", "Lookup")];
82+
METHOD LookupFoundMovesPointer AS VOID
83+
CREATE CURSOR curTest (pCode C(10), pName C(50))
84+
INSERT INTO curTest VALUES ("A001", "Product 1")
85+
INSERT INTO curTest VALUES ("A002", "Product 2")
86+
INDEX ON pCode TAG pCode
87+
88+
GOTO 1
89+
LOOKUP("pName", "A002", "pCode", "pCode")
90+
Assert.Equal("A002", ALLTRIM(FIELDGET(FieldPos("pCode"))))
91+
END METHOD
92+
93+
[Fact, Trait("Category", "Lookup")];
94+
METHOD LookupNotFoundEofTrue AS VOID
95+
CREATE CURSOR curTest (pCode C(10), pName C(50))
96+
INSERT INTO curTest VALUES ("A001", "Product 1")
97+
INDEX ON pCode TAG pCode
98+
99+
LOOKUP("pName", "B999", "pCode", "pCode")
100+
Assert.True(EOF())
101+
END METHOD
102+
103+
END CLASS
104+
105+
END NAMESPACE

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -100,6 +100,7 @@
100100
<Compile Include="FinancialTests.prg" />
101101
<Compile Include="IndexOnTrimTests.prg" />
102102
<Compile Include="IntrospectionTests.prg" />
103+
<Compile Include="KeyMatchLookupTests.prg" />
103104
<Compile Include="SQLStatementTests.prg" />
104105
<Compile Include="StrConvTests.prg" />
105106
<Compile Include="TypeTests.prg" />

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

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -564,3 +564,50 @@ FUNCTION CursorGetProp(cProperty, uArea) AS USUAL CLIPPER
564564
FINALLY
565565
RuntimeState.CurrentWorkarea := nOldArea
566566
END TRY
567+
568+
/// <include file="VFPDocs.xml" path="Runtimefunctions/keymatch/*" />
569+
[FoxProFunction("KEYMATCH", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.Medium)];
570+
FUNCTION KeyMatch(eIndexKey , nIndexNumber , uArea) AS LOGIC CLIPPER
571+
RETURN _DoInArea(uArea, { =>
572+
VAR nOldRec := RecNo()
573+
VAR cOldOrder := ""
574+
VAR cOldBag := ""
575+
VAR lResult := FALSE
576+
577+
IF !IsNil(nIndexNumber)
578+
cOldOrder := OrdName()
579+
cOldBag := OrdBagName()
580+
OrdSetFocus(nIndexNumber)
581+
ENDIF
582+
583+
DbSeek(eIndexKey)
584+
lResult := Found()
585+
586+
IF !IsNil(nIndexNumber)
587+
OrdSetFocus(cOldOrder, cOldBag)
588+
ENDIF
589+
DbGoto(nOldRec)
590+
591+
RETURN lResult
592+
}, false, __FUNCTION__, 3)
593+
END FUNCTION
594+
595+
/// <include file="VFPDocs.xml" path="Runtimefunctions/lookup/*" />
596+
[FoxProFunction("LOOKUP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.Medium)];
597+
FUNCTION Lookup( ReturnField, eSearchExpression, SearchedField , cTagName) AS USUAL CLIPPER
598+
IF !IsNil(cTagName)
599+
OrdSetFocus(cTagName)
600+
ENDIF
601+
602+
DbSeek(eSearchExpression)
603+
604+
IF Found()
605+
IF IsString(ReturnField)
606+
RETURN FieldGet(FieldPos(ReturnField))
607+
ELSEIF IsNumeric(ReturnField)
608+
RETURN FieldGet((DWORD)ReturnField)
609+
ENDIF
610+
ENDIF
611+
612+
RETURN NIL
613+
END FUNCTION

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

Lines changed: 0 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -5,19 +5,6 @@
55

66

77
#pragma options("vo15", on)
8-
/// <summary>-- todo --</summary>
9-
/// <include file="VFPDocs.xml" path="Runtimefunctions/keymatch/*" />
10-
[FoxProFunction("KEYMATCH", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
11-
FUNCTION KeyMatch(eIndexKey , nIndexNumber , uArea) AS LOGIC
12-
THROW NotImplementedException{}
13-
// RETURN FALSE
14-
15-
/// <summary>-- todo --</summary>
16-
/// <include file="VFPDocs.xml" path="Runtimefunctions/lookup/*" />
17-
[FoxProFunction("LOOKUP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.Medium)];
18-
FUNCTION Lookup( ReturnField, eSearchExpression, SearchedField , cTagName) AS USUAL
19-
THROW NotImplementedException{}
20-
// RETURN NIL
218

229
/// <summary>-- todo --</summary>
2310
/// <include file="VFPDocs.xml" path="Runtimefunctions/maketransactable/*" />

0 commit comments

Comments
 (0)