diff --git a/src/Runtime/XSharp.VFP.Tests/CommandTests.prg b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg index c967f51e8f..edf90877f9 100644 --- a/src/Runtime/XSharp.VFP.Tests/CommandTests.prg +++ b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg @@ -221,6 +221,73 @@ BEGIN NAMESPACE XSharp.VFP.Tests TRY ; System.IO.Directory.Delete(cTempPath, TRUE) ; CATCH ; END TRY END TRY END METHOD + + [Fact]; + METHOD TestGetFldStateAndSetFldState() AS VOID + VAR cOldDir := System.IO.Directory.GetCurrentDirectory() + VAR oDir := System.IO.Directory.CreateDirectory(Path.Combine(Path.GetTempPath(), ; + "FldStateTest_" + Guid.NewGuid():ToString("N"))) + VAR cTempPath := oDir:FullName + + TRY + SET DEFAULT TO (cTempPath) + + // 3-field table (field count differs from other tests -> fresh state array) + CREATE TABLE FldTest (Id INT, Name C(10), Active L) + INSERT INTO FldTest VALUES (1, "Alice", .T.) + GO TOP + + // Default state: 1 for everything (no buffering active yet) + Assert.Equal(1, (INT) GetFldState(0)) // deletion flag + Assert.Equal(1, (INT) GetFldState(1)) // field 1 by number + Assert.Equal(1, (INT) GetFldState("NAME")) // field by name + Assert.Equal("1111", (STRING) GetFldState(-1)) // all: deletion + 3 fields + + // SETFLDSTATE roundtrip: mark field 1 as modified (2) + Assert.True(SetFldState(1, 2)) + Assert.Equal(2, (INT) GetFldState(1)) + Assert.Equal("1211", (STRING) GetFldState(-1)) + + // SETFLDSTATE by name + Assert.True(SetFldState("ACTIVE", 2)) + Assert.Equal(2, (INT) GetFldState("ACTIVE")) + Assert.Equal(2, (INT) GetFldState(3)) // same field by number + + // Deletion field (0) + Assert.True(SetFldState(0, 2)) + Assert.Equal(2, (INT) GetFldState(0)) + Assert.Equal("2212", (STRING) GetFldState(-1)) // deletion=2, Id=2, Name=1, Active=2 + + // Reset a field back to 1 + Assert.True(SetFldState(1, 1)) + Assert.Equal(1, (INT) GetFldState(1)) + + // Alias and workarea number overloads + Assert.True(SetFldState(2, 2)) + Assert.Equal(2, (INT) GetFldState(2, "FldTest")) + Assert.Equal(2, (INT) GetFldState(2, Select())) + + // Invalid state value -> FALSE + Assert.False(SetFldState(1, 5)) + Assert.False(SetFldState(1, 0)) + + // EOF -> .NULL. (verify as non-NIL, non-numeric — exact NULL type per runtime) + GO BOTTOM + SKIP + Assert.True(Eof()) + VAR vNull := GetFldState(1) + Assert.True((OBJECT) vNull IS System.DBNull) + + // Non-existent alias -> NIL + Assert.True(GetFldState(1, "NoSuchAlias") == NIL) + + FINALLY + XSharp.CoreDb.CloseAll() + SET DEFAULT TO (cOldDir) + System.IO.Directory.SetCurrentDirectory(cOldDir) + TRY ; System.IO.Directory.Delete(cTempPath, TRUE) ; CATCH ; END TRY + END TRY + END METHOD END CLASS END NAMESPACE diff --git a/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg b/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg index dbbaa6c306..ccda527e92 100644 --- a/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg +++ b/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg @@ -195,6 +195,94 @@ FUNCTION Target( nRelationshipNumber , uArea ) AS STRING CLIPPER FUNCTION Unique(uArea ) AS LOGIC CLIPPER RETURN _DoInArea(uArea, { => (LOGIC) DbOrderInfo(DBOI_UNIQUE , NIL, NIL) } , FALSE,__FUNCTION__,1) + +/// +[FoxProFunction("GETFLDSTATE", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Partial, FoxCriticality.High)]; +FUNCTION GetFldState(uField, uArea) AS USUAL CLIPPER + LOCAL nArea := _AreaFromParam(uArea) AS DWORD + IF nArea == 0 + RETURN NIL + ENDIF + VAR nOldArea := RuntimeState.CurrentWorkarea + RuntimeState.CurrentWorkarea := nArea + TRY + IF !Used() + RETURN NIL + ENDIF + IF Eof() + RETURN DBNull.Value + ENDIF + LOCAL nCount := (int)FCount() AS INT + IF IsString(uField) + VAR nFld := CoreDb.CWA(__FUNCTION__):FieldIndex((STRING) uField) + IF nFld == 0 + RETURN NIL + ENDIF + RETURN (INT) _GetFldStateFromCargo(nArea, nFld) + ELSEIF IsNumeric(uField) + LOCAL nFldNum := (INT) uField AS INT + DO CASE + CASE nFldNum == -1 + VAR sb := System.Text.StringBuilder{} + sb:Append(_GetFldStateFromCargo(nArea, 0):ToString()) + FOR VAR j := 1 TO nCount + sb:Append(_GetFldStateFromCargo(nArea, j):ToString()) + NEXT + RETURN sb:ToString() + CASE nFldNum == 0 + RETURN (INT) _GetFldStateFromCargo(nArea, 0) + CASE nFldNum >= 1 .AND. nFldNum <= nCount + RETURN (INT) _GetFldStateFromCargo(nArea, nFldNum) + ENDCASE + ENDIF + RETURN NIL + FINALLY + RuntimeState.CurrentWorkarea := nOldArea + END TRY + +/// +[FoxProFunction("SETFLDSTATE", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Partial, FoxCriticality.High)]; +FUNCTION SetFldState(uField, nFieldState, uArea) AS LOGIC CLIPPER + IF IsNil(nFieldState) + RETURN FALSE + ENDIF + LOCAL nState := (INT) nFieldState AS INT + IF nState < 1 .OR. nState > 4 + RETURN FALSE + ENDIF + LOCAL nArea := _AreaFromParam(uArea) AS DWORD + IF nArea == 0 + RETURN FALSE + ENDIF + VAR nOldArea := RuntimeState.CurrentWorkarea + RuntimeState.CurrentWorkarea := nArea + TRY + IF !Used() + RETURN FALSE + ENDIF + LOCAL nCount := (int)FCount() AS INT + IF IsString(uField) + VAR nFld := CoreDb.CWA(__FUNCTION__):FieldIndex((STRING) uField) + IF nFld == 0 + RETURN FALSE + ENDIF + _SetFldStateInCargo(nArea, nFld, (BYTE) nState) + RETURN TRUE + ELSEIF IsNumeric(uField) + LOCAL nFldNum := (INT) uField AS INT + IF nFldNum == 0 + _SetFldStateInCargo(nArea, 0, (BYTE) nState) + RETURN TRUE + ELSEIF nFldNum >= 1 .AND. nFldNum <= nCount + _SetFldStateInCargo(nArea, nFldNum, (BYTE) nState) + RETURN TRUE + ENDIF + ENDIF + RETURN FALSE + FINALLY + RuntimeState.CurrentWorkarea := nOldArea + END TRY + /// [FoxProFunction("INDEXSEEK", FoxFunctionCategory.Database, FoxEngine.WorkArea, FoxFunctionStatus.Full, FoxCriticality.High)]; FUNCTION IndexSeek( eExpression , lMovePointer , uArea, uIndex) AS LOGIC CLIPPER @@ -265,3 +353,25 @@ INTERNAL FUNCTION _AreaFromParam(uArea AS USUAL) AS DWORD ENDIF RETURN 0 + +INTERNAL FUNCTION _GetFldStateFromCargo(nArea AS DWORD, nField AS INT) AS BYTE + LOCAL cargo AS Dictionary + LOCAL oCargo := RuntimeState.Workareas:GetCargo(nArea) AS OBJECT + IF oCargo IS Dictionary VAR dict + LOCAL b AS BYTE + IF dict:TryGetValue(nField, REF b) + RETURN b + ENDIF + ENDIF + RETURN 1 + +INTERNAL FUNCTION _SetFldStateInCargo(nArea AS DWORD, nField AS INT, nState AS BYTE) AS VOID + LOCAL oCargo := RuntimeState.Workareas:GetCargo(nArea) AS OBJECT + LOCAL dict AS Dictionary + IF oCargo IS Dictionary VAR existing + dict := existing + ELSE + dict := Dictionary{} + RuntimeState.Workareas:SetCargo(nArea, dict) + ENDIF + dict[nField] := nState diff --git a/src/Runtime/XSharp.VFP/ToDo-G.prg b/src/Runtime/XSharp.VFP/ToDo-G.prg index f5e3682308..ce0224390e 100644 --- a/src/Runtime/XSharp.VFP/ToDo-G.prg +++ b/src/Runtime/XSharp.VFP/ToDo-G.prg @@ -25,13 +25,6 @@ FUNCTION GetCursorAdapter( cAlias ) THROW NotImplementedException{} // RETURN NULL -/// -- todo -- -/// -[FoxProFunction("GETFLDSTATE", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)]; -FUNCTION GetFldState( uField , uArea) AS USUAL - THROW NotImplementedException{} - // RETURN NIL - /// -- todo -- /// [FoxProFunction("GETNEXTMODIFIED", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)]; diff --git a/src/Runtime/XSharp.VFP/ToDo-S.prg b/src/Runtime/XSharp.VFP/ToDo-S.prg index cd69cc6c42..6dab9dcd5a 100644 --- a/src/Runtime/XSharp.VFP/ToDo-S.prg +++ b/src/Runtime/XSharp.VFP/ToDo-S.prg @@ -19,13 +19,6 @@ FUNCTION Scheme( nSchemeNumber , nColorPairNumber) AS STRING THROW NotImplementedException{} // RETURN "" -/// -- todo -- -/// -[FoxProFunction("SETFLDSTATE", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)]; -FUNCTION SetFldState( uField, nFieldState , uArea) AS LOGIC - THROW NotImplementedException{} - // RETURN FALSE - /// -- todo -- /// [FoxProFunction("SETRESULTSET", FoxFunctionCategory.SQL, FoxEngine.SQL, FoxFunctionStatus.Stub, FoxCriticality.Medium)];