diff --git a/src/Runtime/XSharp.VFP.Tests/CommandTests.prg b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg index edf90877f9..81266e206f 100644 --- a/src/Runtime/XSharp.VFP.Tests/CommandTests.prg +++ b/src/Runtime/XSharp.VFP.Tests/CommandTests.prg @@ -288,6 +288,66 @@ BEGIN NAMESPACE XSharp.VFP.Tests TRY ; System.IO.Directory.Delete(cTempPath, TRUE) ; CATCH ; END TRY END TRY END METHOD + + [Fact]; + METHOD TestCursorSetPropAndCursorGetProp() AS VOID + VAR cOldDir := System.IO.Directory.GetCurrentDirectory() + VAR oDir := System.IO.Directory.CreateDirectory(Path.Combine(Path.GetTempPath(), ; + "CursorPropTest_" + Guid.NewGuid():ToString("N"))) + VAR cTempPath := oDir:FullName + + TRY + SET DEFAULT TO (cTempPath) + CREATE TABLE TmpX (Id INT, Name C(20), Active L) + INSERT INTO TmpX VALUES (1, "Alice", .T.) + GO TOP + + // Default buffering is 1 (off) + Assert.Equal(1, (INT) CursorGetProp("Buffering")) + Assert.Equal(3, (INT) CursorGetProp("SourceType")) + + // Set buffering to optimistic table (5) + Assert.True(CursorSetProp("Buffering", 5)) + Assert.Equal(5, (INT) CursorGetProp("Buffering")) + + // Set buffering to pessimistic row (2) -- by alias + Assert.True(CursorSetProp("Buffering", 2, "TmpX")) + Assert.Equal(2, (INT) CursorGetProp("Buffering")) + + // Set buffering -- by workarea number + Assert.True(CursorSetProp("Buffering", 3, Select())) + Assert.Equal(3, (INT) CursorGetProp("Buffering")) + + // Invalid buffering value -> FALSE + Assert.False(CursorSetProp("Buffering", 0)) + Assert.False(CursorSetProp("Buffering", 6)) + Assert.False(CursorSetProp("Buffering", "abc")) + + // Invalid alias -> FALSE for SET, NIL for GET + Assert.False(CursorSetProp("Buffering", 2, "NoSuchAlias")) + Assert.False(CursorGetProp("Buffering", "NoSuchAlias")) + + // Read-only properties + VAR cSrc := CursorGetProp("SourceName") + Assert.True(IsString(cSrc)) + Assert.True(((STRING) cSrc):Contains(".DBF")) + Assert.Equal("", (STRING) CursorGetProp("Database")) + Assert.Equal("", (STRING) CursorGetProp("SQL")) + Assert.Equal(0, (INT) CursorGetProp("ConnectHandle")) + + // Cargo cleared on close + Assert.True(CursorSetProp("Buffering", 5)) + XSharp.CoreDb.CloseAll() + DbUseArea(TRUE, "DBFVFP", Path.Combine(cTempPath, "TmpX.dbf"), "TmpX", FALSE, FALSE) + Assert.Equal(1, (INT) CursorGetProp("Buffering")) + + 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 ccda527e92..ff17808999 100644 --- a/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg +++ b/src/Runtime/XSharp.VFP/Cursors/DbFunctions.prg @@ -7,6 +7,7 @@ USING System USING System.Collections.Generic USING System.Text +USING XSharp.RDD INTERNAL FUNCTION _DoInArea(uArea as Usual, action as @@Func, defaultValue as T, cFunction as STRING, nArg as DWORD) as T IF IsNil(uArea) @@ -354,24 +355,212 @@ INTERNAL FUNCTION _AreaFromParam(uArea AS USUAL) AS DWORD RETURN 0 +INTERNAL CLASS _WorkareaCargo + export fldState AS Dictionary + EXPORT cursorProps AS Dictionary + + CONSTRUCTOR() + fldState := Dictionary{} + cursorProps := Dictionary{} + END CONSTRUCTOR +END CLASS + +INTERNAL FUNCTION _GetWorkareaCargo(nArea AS DWORD) AS _WorkareaCargo + VAR oCargo := RuntimeState.Workareas:GetCargo(nArea) + IF oCargo IS _WorkareaCargo VAR cargo + RETURN cargo + ENDIF + VAR newCargo := _WorkareaCargo{} + RuntimeState.Workareas:SetCargo(nArea, newCargo) + RETURN newCargo + 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 + VAR cargo := _GetWorkareaCargo(nArea) + LOCAL b as BYTE + if cargo:fldState:TryGetValue(nField, REF b) + return b 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) + VAR cargo := _GetWorkareaCargo(nArea) + cargo:fldState[nField] := nState + +INTERNAL STATIC CLASS _CursorPropDefaults + INTERNAL STATIC _defaults AS Dictionary + + STATIC CONSTRUCTOR + _defaults := Dictionary{} + _defaults:Add(CursorProperty.Buffering, 1) + _defaults:Add(CursorProperty.AutoIncError, FALSE) + _defaults:Add(CursorProperty.FetchMemo, FALSE) + _defaults:Add(CursorProperty.FetchSize, 100) + _defaults:Add(CursorProperty.MapBinary, FALSE) + _defaults:Add(CursorProperty.MapVarchar, FALSE) + _defaults:Add(CursorProperty.MaxRecords, -1) + _defaults:Add(CursorProperty.Refresh, -2) + _defaults:Add(CursorProperty.CompareMemo, TRUE) + _defaults:Add(CursorProperty.FetchAsNeeded, FALSE) + _defaults:Add(CursorProperty.Prepared, FALSE) + _defaults:Add(CursorProperty.SendUpdates, FALSE) + _defaults:Add(CursorProperty.UpdateType, 1) + _defaults:Add(CursorProperty.WhereType, 3) + _defaults:Add(CursorProperty.UseMemoSize, 255) + _defaults:Add(CursorProperty.BatchUpdateCount, 1) + END CONSTRUCTOR + + INTERNAL STATIC METHOD GetDefault(prop AS CursorProperty) AS OBJECT + LOCAL result AS OBJECT + IF _defaults:TryGetValue(prop, REF result) + return result + ENDIF + RETURN NIL + END METHOD + + INTERNAL STATIC METHOD SetDefault(prop AS CursorProperty, oValue AS OBJECT) AS VOID + _defaults[prop] := oValue + END METHOD +END CLASS + +INTERNAL FUNCTION _GetCursorProp(nArea AS DWORD, prop AS CursorProperty) AS OBJECT + VAR cargo := _GetWorkareaCargo(nArea) + LOCAL result AS OBJECT + if cargo:cursorProps:TryGetValue(prop, REF result) + RETURN result + ENDIF + + RETURN _CursorPropDefaults.GetDefault(prop) + +INTERNAL FUNCTION _SetCursorProp(nArea AS DWORD, prop AS CursorProperty, oValue AS OBJECT) AS VOID + LOCAL cargo AS _WorkareaCargo + cargo := _GetWorkareaCargo(nArea) + cargo:cursorProps[prop] := oValue + + +/// +[FoxProFunction("CURSORSETPROP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Partial, FoxCriticality.High)]; +FUNCTION CursorSetProp(cProperty, eExpression, uArea) AS LOGIC CLIPPER + IF !IsString(cProperty) + RETURN FALSE + ENDIF + VAR cProp := (STRING) cProperty + VAR nProp := GetCursorProperty(cProp) + VAR prop := (CursorProperty) nProp + VAR lSessionDefault := IsNumeric(uArea) .AND. (INT) uArea == 0 + IF lSessionDefault + IF nProp == (LONG) CursorProperty.Buffering + IF IsNumeric(eExpression) + VAR nVal := (INT) eExpression + IF nVal < 1 .OR. nVal > 5 + RETURN FALSE + ENDIF + ELSE + RETURN FALSE + ENDIF + ENDIF + _CursorPropDefaults.SetDefault(prop, eExpression) + RETURN TRUE ENDIF - dict[nField] := nState + VAR nArea := _AreaFromParam(uArea) + IF nArea == 0 + RETURN FALSE + ENDIF + VAR nOldArea := RuntimeState.CurrentWorkarea + RuntimeState.CurrentWorkarea := nArea + TRY + IF !Used() + RETURN FALSE + ENDIF + SWITCH prop + CASE CursorProperty.Buffering + IF !IsNumeric(eExpression) + RETURN FALSE + ENDIF + LOCAL nBuff := (INT) eExpression AS INT + IF nBuff < 1 .OR. nBuff > 5 + RETURN FALSE + ENDIF + _SetCursorProp(nArea, CursorProperty.Buffering, nBuff) + RETURN TRUE + CASE CursorProperty.AutoIncError + IF !IsLogic(eExpression) + RETURN FALSE + ENDIF + _SetCursorProp(nArea, CursorProperty.AutoIncError, eExpression) + RETURN TRUE + CASE CursorProperty.Refresh + IF !IsNumeric(eExpression) + RETURN FALSE + ENDIF + _SetCursorProp(nArea, CursorProperty.Refresh, eExpression) + RETURN TRUE + OTHERWISE + _SetCursorProp(nArea, prop, eExpression) + RETURN TRUE + END SWITCH + FINALLY + RuntimeState.CurrentWorkarea := nOldArea + END TRY + +/// +[FoxProFunction("CURSORGETPROP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Partial, FoxCriticality.High)]; +FUNCTION CursorGetProp(cProperty, uArea) AS USUAL CLIPPER + IF !IsString(cProperty) + RETURN NIL + ENDIF + VAR cProp := (STRING) cProperty + VAR nProp := GetCursorProperty(cProp) + VAR prop := (CursorProperty) nProp + VAR lSessionDefault := IsNumeric(uArea) .AND. (INT) uArea == 0 + IF lSessionDefault + RETURN _CursorPropDefaults.GetDefault(prop) + ENDIF + VAR nArea := _AreaFromParam(uArea) + IF nArea == 0 + RETURN FALSE + ENDIF + VAR nOldArea := RuntimeState.CurrentWorkarea + RuntimeState.CurrentWorkarea := nArea + TRY + IF !Used() + RETURN FALSE + ENDIF + SWITCH prop + CASE CursorProperty.SourceType + RETURN 3 + CASE CursorProperty.SourceName + RETURN DbInfo(DBI_FULLPATH) + CASE CursorProperty.Database + RETURN "" + CASE CursorProperty.SQL + RETURN "" + CASE CursorProperty.ConnectHandle + RETURN 0 + CASE CursorProperty.ConnectName + RETURN "" + CASE CursorProperty.Tables + RETURN "" + CASE CursorProperty.KeyFieldList + RETURN "" + CASE CursorProperty.UpdatableFieldList + RETURN "" + CASE CursorProperty.UpdateNameList + RETURN "" + CASE CursorProperty.ParameterList + RETURN "" + CASE CursorProperty.RecordsFetched + RETURN -1 + CASE CursorProperty.FetchIsComplete + RETURN TRUE + CASE CursorProperty.ADOBookmark + RETURN NIL + CASE CursorProperty.ADOCodePage + RETURN 0 + CASE CursorProperty.ADORecordset + RETURN NIL + OTHERWISE + RETURN _GetCursorProp(nArea, prop) + END SWITCH + FINALLY + RuntimeState.CurrentWorkarea := nOldArea + END TRY diff --git a/src/Runtime/XSharp.VFP/ToDo-C.prg b/src/Runtime/XSharp.VFP/ToDo-C.prg index c9a6b66a42..836fe5c500 100644 --- a/src/Runtime/XSharp.VFP/ToDo-C.prg +++ b/src/Runtime/XSharp.VFP/ToDo-C.prg @@ -44,21 +44,6 @@ FUNCTION CreateOffline (ViewName , cPath) THROW NotImplementedException{} // RETURN FALSE -/// -- todo -- -/// -[FoxProFunction("CURSORGETPROP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)]; -FUNCTION CursorGetProp (cProperty , uArea) - THROW NotImplementedException{} - // RETURN NIL - - -/// -- todo -- -/// -[FoxProFunction("CURSORSETPROP", FoxFunctionCategory.CursorAndTable, FoxEngine.WorkArea, FoxFunctionStatus.Stub, FoxCriticality.High)]; -FUNCTION CursorSetProp (cProperty , eExpression, uArea) - THROW NotImplementedException{} - // RETURN FALSE - /// -- todo -- /// [FoxProFunction("CURSORTOXML", FoxFunctionCategory.General, FoxEngine.RuntimeCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)];