diff --git a/src/Common/FoxProCmd.xh b/src/Common/FoxProCmd.xh index cb11c197c5..8255345429 100644 --- a/src/Common/FoxProCmd.xh +++ b/src/Common/FoxProCmd.xh @@ -162,6 +162,42 @@ #command DIR => __VfpDir( "" ) #command DIRECTORY => __VfpDir( "" ) +// COUNT — the VO rule in dbcmd.xh requires the TO clause (it expands to +// " := 0", which leaves a dangling ":=" when TO is omitted) and never +// updates _TALLY. VFP accepts the TO clause both right after COUNT and at the +// end, so both orders need their own rule: an optional clause cannot be matched +// across a mandatory one. +#command COUNT ; + [ALL] ; + [] ; + [NEXT ] ; + [RECORD ] ; + [FOR ] ; + [WHILE ] ; + [] ; + => __VfpCount( <{lfor}>, <{lwhile}>, , , <.rest.>, <.noopt.> ) + +#command COUNT TO ; + [ALL] ; + [] ; + [NEXT ] ; + [RECORD ] ; + [FOR ] ; + [WHILE ] ; + [] ; + => := __VfpCount( <{lfor}>, <{lwhile}>, , , <.rest.>, <.noopt.> ) + +#command COUNT ; + [ALL] ; + [] ; + [NEXT ] ; + [RECORD ] ; + [FOR ] ; + [WHILE ] ; + TO ; + [] ; + => := __VfpCount( <{lfor}>, <{lwhile}>, , , <.rest.>, <.noopt.> ) + // WAIT #xcommand WAIT [ [AT , ]] [] [] [TIMEOUT ] ; => __VfpWait(, <.win.>, , , <.now.>, <.nclr.>, ) diff --git a/src/Runtime/XSharp.VFP.Tests/TallyTests.prg b/src/Runtime/XSharp.VFP.Tests/TallyTests.prg new file mode 100644 index 0000000000..feb55054c6 --- /dev/null +++ b/src/Runtime/XSharp.VFP.Tests/TallyTests.prg @@ -0,0 +1,135 @@ +// +// 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 TallyTests + + STATIC CONSTRUCTOR + XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro + END CONSTRUCTOR + + PRIVATE METHOD CreateTestCursor() AS VOID + CREATE CURSOR curtally (f I) + INSERT INTO curtally VALUES (1) + INSERT INTO curtally VALUES (2) + INSERT INTO curtally VALUES (3) + INSERT INTO curtally VALUES (4) + INSERT INTO curtally VALUES (5) + GO TOP + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountWithoutToClauseSetsTally AS VOID + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT + Assert.Equal(5, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountWithForSetsTally AS VOID + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT FOR curtally->f > 2 + Assert.Equal(3, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountToVariableSetsBothTheVariableAndTally AS VOID + LOCAL n AS USUAL + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT TO n + Assert.Equal(5, (INT) n) + Assert.Equal(5, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountAcceptsToBeforeFor AS VOID + LOCAL n AS USUAL + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT TO n FOR curtally->f > 3 + Assert.Equal(2, (INT) n) + Assert.Equal(2, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountAcceptsToAfterFor AS VOID + LOCAL n AS USUAL + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT FOR curtally->f > 3 TO n + Assert.Equal(2, (INT) n) + Assert.Equal(2, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountAcceptsScopeBeforeFor AS VOID + LOCAL n AS USUAL + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT ALL FOR curtally->f > 2 TO n NOOPTIMIZE + Assert.Equal(3, (INT) n) + Assert.Equal(3, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD CountNextLimitsTheScope AS VOID + LOCAL n AS USUAL + TRY + SELF:CreateTestCursor() + _TALLY := -1 + COUNT NEXT 3 TO n + Assert.Equal(3, (INT) n) + Assert.Equal(3, (INT) _TALLY) + FINALLY + USE + END TRY + END METHOD + + [Fact, Trait("Category", "Tally")]; + METHOD NavigationDoesNotChangeTally AS VOID + TRY + SELF:CreateTestCursor() + COUNT + _TALLY := 99 + GO TOP + Assert.Equal(99, (INT) _TALLY) + FINALLY + USE + END TRY + 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 84d64185fb..37948e305d 100644 --- a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj +++ b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj @@ -108,6 +108,7 @@ + diff --git a/src/Runtime/XSharp.VFP/Commands.prg b/src/Runtime/XSharp.VFP/Commands.prg index 24722379ff..9d5ce11ce8 100644 --- a/src/Runtime/XSharp.VFP/Commands.prg +++ b/src/Runtime/XSharp.VFP/Commands.prg @@ -224,3 +224,10 @@ FUNCTION __VfpWaitForKey(uTimeout AS USUAL) AS STRING function __VfpWaitClear() as void return + +/// +FUNCTION __VfpCount(cbFor, cbWhile, nNext, nRecord, lRest, lNoOpt) AS LONG CLIPPER + LOCAL nCount := 0 AS LONG + DbEval({|| nCount += 1}, cbFor, cbWhile, nNext, nRecord, lRest, lNoOpt) + _TALLY := nCount + RETURN nCount