diff --git a/src/CompilerTests/Applications/R870/Prg/R870.prg b/src/CompilerTests/Applications/R870/Prg/R870.prg index 41628efb1f..71091580d3 100644 --- a/src/CompilerTests/Applications/R870/Prg/R870.prg +++ b/src/CompilerTests/Applications/R870/Prg/R870.prg @@ -9,12 +9,13 @@ c := "a" +; ? c ? StackFrame{true}:GetFileLineNumber() -xAssert(StackFrame{true}:GetFileLineNumber() == 12) -PROC xAssert(l AS LOGIC) AS VOID - IF l +xAssert(StackFrame{true}:GetFileLineNumber() , 12) + +PROC xAssert(nResult AS INT, nExpected AS INT) AS VOID + IF nExpected == nResult ? "Assertion passed" ELSE - THROW Exception{"Incorrect result"} + THROW Exception{ System.String.Format("Incorrect result, expected {0}, returned {1}", nExpected, nResult)} END IF RETURN diff --git a/src/CompilerTests/Applications/RuntimeTests/Prg/RuntimeTests.prg b/src/CompilerTests/Applications/RuntimeTests/Prg/RuntimeTests.prg index 84769fad68..94b8ac6354 100644 --- a/src/CompilerTests/Applications/RuntimeTests/Prg/RuntimeTests.prg +++ b/src/CompilerTests/Applications/RuntimeTests/Prg/RuntimeTests.prg @@ -17,7 +17,7 @@ FUNCTION Start() AS INT "C427", "C433", "C434", "C435", "C437", "C441", "C444", "C445", "C446", "C448", ; "C450", "C452", "C457", "C460", /*"C475",*/ "C478", "C479", "C484", "C499", "C504", ; "C505", "C506", "C507", "C508", "C509", "C515", "C519", "C520", "C521", "C527", ; - "C528", "C536", "C538", /*"C541",*/ "C542", "C543", "C548", "C552", "C557", "C558", ; + "C528", "C536", "C538", /*"C541",*/ "C542", "C543", "C552", "C557", "C558", ; "C560", "C564", "C567", "C573", "C578", "C579", "C582", "C588", "C590", "C591", ; "C599", "C602", "C604", "C606", "C607", "C609", "C610", "C611", "C612", "C613", "C615", ; "C616", "C617", "C618", "C621", "C628", "C629", "C630", "C631", "C632", "C635", ; @@ -42,7 +42,7 @@ FUNCTION Start() AS INT "R711", "R712", "R725", "R729", "R730", "R732","R735", "R736","R741","R742","R743",; "R750", "R751", "R752", "R753", "R754", "R755","R756", "R757","R759","R763", "R765",; "R771", "R772", "R773", "R774", "R776", "R777", "R779","R780","R782", "R784", "R787", ; - "R788", "R789", "R790", "R791", "R793", "R795", "R796", "R799", "R800","R803", ; + /*"R788", */"R789", "R790", "R791", "R793", "R795", "R796", "R799", "R800","R803", ; "R820", "R821", /*"R822",*/ "R823", "R824", "R827", "R828", "R829", "R830", "R831","R832",; "R835", "R836", "R839", "R840", "R842", "R848", "R849", "R850", "R855", "R856", "R858",; "R861", "R862", "R863", "R864", "R865", "R868", "R870", "R871", "R872", "R873", ; @@ -62,10 +62,13 @@ FUNCTION Start() AS INT aTests:Remove("C418") aTests:Remove("C479") aTests:Remove("C521") + + // uses StackFrame to get the line of code, but automated tests are running in release mode an this is not available + aTests:Remove("R870") #endif - #warning Removed C729 because it uses macrocompiler substitution which fails in the the tests - aTests:Remove("C729") + aTests:Remove("C729") // Removed C729 because it uses macrocompiler substitution which fails in the the tests + aTests:Add( "C548" ) // Added C548 at the end because for some reason causes several tests following it to fail // TODO Must fail: "C135" diff --git a/src/CompilerTests/Automated/CompilerTests.prg b/src/CompilerTests/Automated/CompilerTests.prg index 80807dd452..f1ec22a665 100644 --- a/src/CompilerTests/Automated/CompilerTests.prg +++ b/src/CompilerTests/Automated/CompilerTests.prg @@ -41,9 +41,8 @@ FUNCTION Start() AS VOID gcCompilerFilename := "C:\Program Files (x86)\XSharp\Bin\xsc.exe" cProjectFile := "C:\xSharp\Dev\src\CompilerTests\xSharp Tests30.viproj" - gcRuntimeFolder := "C:\xSharp\Dev\Artifacts\Release\net46" -// gcNetCoreRuntimeFolder := "C:\xSharp\Dev\Artifacts\Release" - gcNetCoreRuntimeFolder := "C:\Program Files (x86)\XSharp\Redist\net8.0" + gcRuntimeFolder := "C:\xSharp\Dev\src\CompilerTests\Runtime" + gcNetCoreRuntimeFolder := gcRuntimeFolder + "Net8" cTestTheFixedOnes := "TRUE" cConfigName := "DEBUG" cLogFilename := "C:\xSharp\Dev\src\CompilerTests\Automated\log.txt" @@ -53,7 +52,7 @@ FUNCTION Start() AS VOID gcCompilerFilename := Environment.GetEnvironmentVariable("XSCOMPILER")?:Trim() cProjectFile := Environment.GetEnvironmentVariable("XSTESTPROJECT")?:Trim() gcRuntimeFolder := Environment.GetEnvironmentVariable("XSRUNTIMEFOLDER")?:Trim() - gcNetCoreRuntimeFolder := Environment.GetEnvironmentVariable("XSRUNTIMEFOLDER")?:Trim() + gcNetCoreRuntimeFolder := gcRuntimeFolder + "Net8" cTestTheFixedOnes := Environment.GetEnvironmentVariable("XSFIXEDTESTS")?:Trim() cConfigName := Environment.GetEnvironmentVariable("XSCONFIG")?:Trim() cLogFilename := Environment.GetEnvironmentVariable("XSLOGFILE")?:Trim() diff --git a/src/CompilerTests/Runtime/XSharp.Harbour.dll b/src/CompilerTests/Runtime/XSharp.Harbour.dll index b68c11c164..46e56143a0 100644 Binary files a/src/CompilerTests/Runtime/XSharp.Harbour.dll and b/src/CompilerTests/Runtime/XSharp.Harbour.dll differ diff --git a/src/CompilerTests/Runtime/XSharp.RT.dll b/src/CompilerTests/Runtime/XSharp.RT.dll index f5ca1556f6..cd5b670f46 100644 Binary files a/src/CompilerTests/Runtime/XSharp.RT.dll and b/src/CompilerTests/Runtime/XSharp.RT.dll differ diff --git a/src/CompilerTests/Runtime/XSharp.VFP.dll b/src/CompilerTests/Runtime/XSharp.VFP.dll index cfb01a5a13..77df38c6c0 100644 Binary files a/src/CompilerTests/Runtime/XSharp.VFP.dll and b/src/CompilerTests/Runtime/XSharp.VFP.dll differ diff --git a/src/CompilerTests/Runtime/XSharp.VO.dll b/src/CompilerTests/Runtime/XSharp.VO.dll index a0b1db32e3..0943da8254 100644 Binary files a/src/CompilerTests/Runtime/XSharp.VO.dll and b/src/CompilerTests/Runtime/XSharp.VO.dll differ diff --git a/src/CompilerTests/Runtime/XSharp.XPP.dll b/src/CompilerTests/Runtime/XSharp.XPP.dll index f38f112fbd..ca49aaa6c5 100644 Binary files a/src/CompilerTests/Runtime/XSharp.XPP.dll and b/src/CompilerTests/Runtime/XSharp.XPP.dll differ diff --git a/src/CompilerTests/xSharp Tests30.viproj b/src/CompilerTests/xSharp Tests30.viproj index 7990b0ba15..e88badaca2 100644 --- a/src/CompilerTests/xSharp Tests30.viproj +++ b/src/CompilerTests/xSharp Tests30.viproj @@ -146894,7 +146894,7 @@ AppConfig = Release,22222222-2222-2222-2222-222222222222 Optimize=0 ENDApplication = D002 - Primary Constructor VO Dialect -ApplicationGroup = B9CFE839-D401-428D-94E9-E9D21E9F772D +ApplicationGroup = 70E3DAB7-5F3E-45A2-B617-437A91064B55 ; ************** APPLICATION D003 - Primary Constructor NetCore VO Dialect ************* Application = D003 - Primary Constructor NetCore VO Dialect IDEVersion = 1.06 diff --git a/src/Runtime/XSharp.Core/Language/Generic.resx b/src/Runtime/XSharp.Core/Language/Generic.resx index b2cb96f518..b15d5862c3 100644 --- a/src/Runtime/XSharp.Core/Language/Generic.resx +++ b/src/Runtime/XSharp.Core/Language/Generic.resx @@ -2831,19 +2831,11 @@ Keysort on {0} is not supported for collections ordered by {1} - - - - - - - - - - - - + + XML Parse error: {0} + + + Unable to infer XML schema. + - - \ No newline at end of file diff --git a/src/Runtime/XSharp.Data/FoxPro/Enums.prg b/src/Runtime/XSharp.Data/FoxPro/Enums.prg index d797a7995b..a678899c5e 100644 --- a/src/Runtime/XSharp.Data/FoxPro/Enums.prg +++ b/src/Runtime/XSharp.Data/FoxPro/Enums.prg @@ -43,4 +43,6 @@ ENUM XSharp.VFPErrors MEMBER VFP_INVALID_PARAMETER MEMBER VFP_FOR_CONDITION_MUST_BE_LOGIC MEMBER VFP_INVALID_DATE_SETTING + MEMBER VFP_XML_PARSE_ERROR + MEMBER VFP_XML_NOSCHEMA END ENUM diff --git a/src/Runtime/XSharp.RT.Debugger/Xsharp.RT.Debugger.Next.xsproj b/src/Runtime/XSharp.RT.Debugger/Xsharp.RT.Debugger.Next.xsproj index 0faf852603..50c22ab7dd 100644 --- a/src/Runtime/XSharp.RT.Debugger/Xsharp.RT.Debugger.Next.xsproj +++ b/src/Runtime/XSharp.RT.Debugger/Xsharp.RT.Debugger.Next.xsproj @@ -1,7 +1,7 @@ - XSharp + XSharp.Debugger XSharp.RT.Debugger true Core diff --git a/src/Runtime/XSharp.RT/XSharp.RT.Next.xsproj b/src/Runtime/XSharp.RT/XSharp.RT.Next.xsproj index 765a533400..a28499a198 100644 --- a/src/Runtime/XSharp.RT/XSharp.RT.Next.xsproj +++ b/src/Runtime/XSharp.RT/XSharp.RT.Next.xsproj @@ -2,7 +2,7 @@ Library - XSharp + XSharp.RT XSharp.RT VO True diff --git a/src/Runtime/XSharp.VFP.Tests/OOPTests.prg b/src/Runtime/XSharp.VFP.Tests/OOPTests.prg new file mode 100644 index 0000000000..ae31a131d3 --- /dev/null +++ b/src/Runtime/XSharp.VFP.Tests/OOPTests.prg @@ -0,0 +1,39 @@ +// +// 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 OOPTests + static constructor + XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro + end constructor + + [Fact, Trait("Category", "OOP")]; + method NumericPropertyIsUsableInArithmetic as void + local oCircle := Circle{} as Circle + oCircle:Ratio := 5 + Assert.Equal(31.4, (real8)oCircle:Perimeter(), 2) + end method + + [Fact, Trait("Category", "OOP")]; + method NumericPropertyRoundTripsThroughLateBoundAccess as void + local oCircle := Circle{} as Usual + oCircle:Ratio := 5 + Assert.Equal(10, (int)(oCircle:Ratio * 2)) + end method + end class + + define class Circle as Custom + ratio = 0 + + procedure Perimeter() + return 2 * 3.14 * this.ratio + endproc + enddefine +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 37948e305d..55f3f9c0ea 100644 --- a/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj +++ b/src/Runtime/XSharp.VFP.Tests/XSharp.VFP.Tests.xsproj @@ -104,6 +104,7 @@ + @@ -122,6 +123,7 @@ + diff --git a/src/Runtime/XSharp.VFP.Tests/XmlToCursorTests.prg b/src/Runtime/XSharp.VFP.Tests/XmlToCursorTests.prg new file mode 100644 index 0000000000..ab36183d1a --- /dev/null +++ b/src/Runtime/XSharp.VFP.Tests/XmlToCursorTests.prg @@ -0,0 +1,554 @@ +// +// 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.IO +USING XUnit + +BEGIN NAMESPACE XSharp.VFP.Tests + + CLASS XmlToCursorTests + + STATIC CONSTRUCTOR + XSharp.RuntimeState.Dialect := XSharpDialect.FoxPro + END CONSTRUCTOR + + #region helpers + PRIVATE METHOD Stru(cAlias AS STRING) AS STRING + LOCAL aStru AS ARRAY + LOCAL cResult AS STRING + LOCAL n AS DWORD + DbSelectArea(cAlias) + aStru := DbStruct() + cResult := "" + FOR n := 1 UPTO ALen(aStru) + cResult += Upper(AllTrim(aStru[n, 1])) + " " + Upper(aStru[n, 2]) + ; + "(" + AllTrim(Str(aStru[n, 3])) + "," + AllTrim(Str(aStru[n, 4])) + ") " + NEXT + RETURN AllTrim(cResult) + END METHOD + + PRIVATE METHOD Close(cAlias AS STRING) AS VOID + IF Used(cAlias) + DbCloseArea(cAlias) + ENDIF + END METHOD + + PRIVATE METHOD Doc(cRows AS STRING) AS STRING + RETURN "" + cRows + "" + END METHOD + + PRIVATE METHOD OneCol(cValues AS STRING) AS STRING + LOCAL cResult AS STRING + cResult := "" + FOREACH cValue AS STRING IN cValues:Split(c'|') + cResult += "" + cValue + "" + NEXT + RETURN SELF:Doc(cResult) + END METHOD + + PRIVATE METHOD Infer(cValues AS STRING) AS STRING + LOCAL cAlias AS STRING + LOCAL cResult AS STRING + cAlias := "inf" + Right(Guid.NewGuid():ToString("N"), 6) + XmlToCursor(SELF:OneCol(cValues), cAlias, 0) + cResult := SELF:Stru(cAlias) + SELF:Close(cAlias) + RETURN cResult + END METHOD + + // The XML VFP 9 itself produces for a cursor holding one row of each + // interesting type plus one empty row. It is embedded verbatim rather than + // regenerated with CursorToXml(): our own writer emits every column as + // xs:string, so a round trip through it would prove nothing about the + // types XmlToCursor() is supposed to rebuild. + PRIVATE METHOD TypesXml(lSchema AS LOGIC) AS STRING + IF lSchema + RETURN SELF:VfpXmlWithSchema() + ENDIF + RETURN SELF:VfpXmlNoSchema() + END METHOD + + // Captured verbatim from VFP 9: one row of each type plus one empty row, with the inline schema + PRIVATE METHOD VfpXmlWithSchema() AS STRING + LOCAL oSb AS System.Text.StringBuilder + oSb := System.Text.StringBuilder{} + oSb:AppendLine("") + oSb:AppendLine("") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" hello") + oSb:AppendLine(" 123.45") + oSb:AppendLine(" true") + oSb:AppendLine(" 2024-01-15") + oSb:AppendLine(" 2024-01-15T10:30:45") + oSb:AppendLine(" 99.9999") + oSb:AppendLine(" 42") + oSb:AppendLine(" memo text") + oSb:AppendLine(" 3.142") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.00") + oSb:AppendLine(" false") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.0000") + oSb:AppendLine(" 0") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.000") + oSb:AppendLine(" ") + oSb:AppendLine("") + RETURN oSb:ToString() + END METHOD + + // The same cursor, written by VFP 9 without a schema + PRIVATE METHOD VfpXmlNoSchema() AS STRING + LOCAL oSb AS System.Text.StringBuilder + oSb := System.Text.StringBuilder{} + oSb:AppendLine("") + oSb:AppendLine("") + oSb:AppendLine(" ") + oSb:AppendLine(" hello") + oSb:AppendLine(" 123.45") + oSb:AppendLine(" true") + oSb:AppendLine(" 2024-01-15") + oSb:AppendLine(" 2024-01-15T10:30:45") + oSb:AppendLine(" 99.9999") + oSb:AppendLine(" 42") + oSb:AppendLine(" memo text") + oSb:AppendLine(" 3.142") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.00") + oSb:AppendLine(" false") + oSb:AppendLine(" ") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.0000") + oSb:AppendLine(" 0") + oSb:AppendLine(" ") + oSb:AppendLine(" 0.000") + oSb:AppendLine(" ") + oSb:AppendLine("") + RETURN oSb:ToString() + END METHOD + #endregion + + #region round trip through the inline schema + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD SchemaRebuildsEveryFieldType AS VOID + VAR cXml := SELF:TypesXml(TRUE) + SELF:Close("dst") + Assert.Equal(2, (INT) XmlToCursor(cXml, "dst", 0)) + Assert.Equal("CCHAR C(10,0) NNUM N(8,2) LLOG L(1,0) DDATE D(8,0) TTIME T(8,0) " + ; + "YCUR N(20,4) IINT I(4,0) MMEMO M(4,0) BDBL B(8,0)", SELF:Stru("dst")) + SELF:Close("dst") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD Flag2048RebuildsCurrency AS VOID + VAR cXml := SELF:TypesXml(TRUE) + SELF:Close("dst") + XmlToCursor(cXml, "dst", 2048) + DbSelectArea("dst") + Assert.Equal("Y", DbFieldInfo(DBS_TYPE, FieldPos("ycur"))) + SELF:Close("dst") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD SchemaRoundTripKeepsValues AS VOID + VAR cXml := SELF:TypesXml(TRUE) + SELF:Close("dst") + XmlToCursor(cXml, "dst", 0) + DbSelectArea("dst") + DbGoTop() + Assert.Equal("hello", AllTrim(dst->cchar)) + Assert.Equal(123.45, (REAL8) dst->nnum, 2) + Assert.True(dst->llog) + Assert.Equal(2024, (INT) Year(dst->ddate)) + Assert.Equal(42, (INT) dst->iint) + Assert.Equal("memo text", AllTrim(dst->mmemo)) + SELF:Close("dst") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD SchemaHandlesTheEmptyDateVfpWrites AS VOID + VAR cXml := SELF:TypesXml(TRUE) + SELF:Close("dst") + Assert.Equal(2, (INT) XmlToCursor(cXml, "dst", 0)) + DbSelectArea("dst") + DbGoBottom() + Assert.True(Empty(dst->ddate)) + SELF:Close("dst") + END METHOD + + #endregion + #region inference when there is no schema + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD NoSchemaInfersFromTheValues AS VOID + VAR cXml := SELF:TypesXml(FALSE) + SELF:Close("dst") + Assert.Equal(2, (INT) XmlToCursor(cXml, "dst", 0)) + Assert.Equal("CCHAR C(5,0) NNUM N(6,2) LLOG L(1,0) DDATE C(10,0) TTIME C(19,0) " + ; + "YCUR N(7,4) IINT N(2,0) MMEMO C(9,0) BDBL N(5,3)", SELF:Stru("dst")) + SELF:Close("dst") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD WidthIsTheLongestValueSeen AS VOID + Assert.Equal("V C(10,0)", SELF:Infer("abc|abcdefghij")) + Assert.Equal("V N(7,3)", SELF:Infer("1|333.456")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD BooleanValuesBecomeLogical AS VOID + Assert.Equal("V L(1,0)", SELF:Infer("true|false")) + Assert.Equal("V L(1,0)", SELF:Infer("TRUE|FALSE")) + Assert.Equal("V L(1,0)", SELF:Infer("1|0")) + Assert.Equal("V L(1,0)", SELF:Infer("1|true")) + Assert.Equal("V C(4,0)", SELF:Infer("true|xyz")) + Assert.Equal("V N(1,0)", SELF:Infer("1|2")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD DatesAndDateTimesAreInferred AS VOID + Assert.Equal("V D(8,0)", SELF:Infer("2024-01-15|2024-02-20")) + Assert.Equal("V T(8,0)", SELF:Infer("2024-01-15T10:30:45")) + Assert.Equal("V C(19,0)", SELF:Infer("2024-01-15|2024-01-15T10:30:45")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD LongTextBecomesMemo AS VOID + Assert.Equal("V C(254,0)", SELF:Infer(Replicate("y", 254))) + Assert.Equal("V M(4,0)", SELF:Infer(Replicate("z", 255))) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD EmptyColumnBecomesCharacterOfOne AS VOID + Assert.Equal("V C(1,0)", SELF:Infer("|")) + END METHOD + + #endregion + + #region inference quirks reproduced from VFP on purpose + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD SignedNumbersAreInferredAsCharacter AS VOID + Assert.Equal("V C(2,0)", SELF:Infer("-5")) + Assert.Equal("V C(2,0)", SELF:Infer("+5")) + Assert.Equal("V C(7,0)", SELF:Infer("-123.45")) + Assert.Equal("V C(4,0)", SELF:Infer("-5|1234")) + Assert.Equal("V N(4,0)", SELF:Infer("1234")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD ExponentsAreInferredAsCharacter AS VOID + Assert.Equal("V C(3,0)", SELF:Infer("1e3|25")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD LeadingAndTrailingDotsAreStillNumeric AS VOID + Assert.Equal("V N(2,1)", SELF:Infer(".5|.7")) + Assert.Equal("V N(2,0)", SELF:Infer("5.|7.")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AnEmptyValueRulesOutLogicalButNotNumeric AS VOID + Assert.Equal("V N(1,0)", SELF:Infer("1|0|")) + Assert.Equal("V C(4,0)", SELF:Infer("true|")) + Assert.Equal("V N(4,1)", SELF:Infer("12.5|")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AnEmptyValueRulesOutDate AS VOID + Assert.Equal("V C(10,0)", SELF:Infer("2024-01-15|")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD InferredWidthCanOverflow AS VOID + Assert.Equal("V N(5,1)", SELF:Infer("99999|0.1")) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD LeadingZerosAreLost AS VOID + Assert.Equal("V N(3,0)", SELF:Infer("007|12")) + Assert.Equal("V C(3,0)", SELF:Infer("007|ab")) + END METHOD + + #endregion + #region cursor name, work area and return value + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD MissingNameCreatesXmlResult AS VOID + SELF:Close("XMLRESULT") + Assert.Equal(1, (INT) XmlToCursor(SELF:Doc("1"))) + Assert.True(Used("XMLRESULT")) + Assert.Equal("XMLRESULT", Alias()) + SELF:Close("XMLRESULT") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD EmptyNameCreatesXmlResult AS VOID + SELF:Close("XMLRESULT") + XmlToCursor(SELF:Doc("1"), "", 0) + Assert.True(Used("XMLRESULT")) + SELF:Close("XMLRESULT") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD TheNewCursorBecomesTheCurrentArea AS VOID + SELF:Close("parked") + SELF:Close("landed") + CREATE CURSOR parked (zz C(3)) + DbSelectArea("parked") + XmlToCursor(SELF:Doc("1"), "landed", 0) + Assert.Equal("LANDED", Alias()) + Assert.Equal(1, (INT) RecNo()) + SELF:Close("landed") + SELF:Close("parked") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AnExistingCursorIsReplaced AS VOID + SELF:Close("reuse") + CREATE CURSOR reuse (zz C(3)) + INSERT INTO reuse VALUES ("aaa") + XmlToCursor(SELF:Doc("1"), "reuse", 0) + // "1" on its own is Logical, not Numeric: it is inside {0,1,true,false} + Assert.Equal("A L(1,0)", SELF:Stru("reuse")) + SELF:Close("reuse") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD EmptyDocumentCreatesNoCursor AS VOID + SELF:Close("nothing") + SELF:Close("norecords") + // the return is RecCount() of the current area, so it has to be a known one + CREATE CURSOR norecords (zz C(1)) + DbSelectArea("norecords") + Assert.Equal(0, (INT) XmlToCursor("", "nothing", 0)) + Assert.False(Used("nothing")) + SELF:Close("norecords") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD ReturnIsRecCountOfTheCurrentArea AS VOID + SELF:Close("target") + SELF:Close("parked") + CREATE CURSOR target (cchar C(20)) + INSERT INTO target VALUES ("pre1") + INSERT INTO target VALUES ("pre2") + CREATE CURSOR parked (zz C(3)) + DbSelectArea("parked") + Assert.Equal(0, (INT) XmlToCursor(SELF:Doc("ab"), "target", 8192)) + Assert.Equal("PARKED", Alias()) + Assert.Equal(4, (INT) RecCount("target")) + SELF:Close("target") + SELF:Close("parked") + END METHOD + + #endregion + + #region append mode + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendAddsRowsAndKeepsTheStructure AS VOID + SELF:Close("tgt") + CREATE CURSOR tgt (cchar C(20), nnum N(10,2), zzz C(5)) + INSERT INTO tgt VALUES ("preexisting", 9.99, "keep") + DbSelectArea("tgt") + Assert.Equal(3, (INT) XmlToCursor(SELF:TypesXml(TRUE), "tgt", 8192)) + Assert.Equal("CCHAR C(20,0) NNUM N(10,2) ZZZ C(5,0)", SELF:Stru("tgt")) + DbSelectArea("tgt") + DbGoTop() + Assert.Equal("preexisting", AllTrim(tgt->cchar)) + DbSkip(1) + Assert.Equal("hello", AllTrim(tgt->cchar)) + Assert.Equal(123.45, (REAL8) tgt->nnum, 2) + Assert.Equal("", AllTrim(tgt->zzz)) + SELF:Close("tgt") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendMatchesFieldNamesCaseInsensitively AS VOID + SELF:Close("tgt6") + CREATE CURSOR tgt6 (myfield C(5)) + DbSelectArea("tgt6") + XmlToCursor(SELF:Doc("up"), "tgt6", 8192) + DbSelectArea("tgt6") + DbGoTop() + Assert.Equal("up", AllTrim(tgt6->myfield)) + SELF:Close("tgt6") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendWithNoMatchingColumnStillAddsBlankRows AS VOID + SELF:Close("tgt2") + CREATE CURSOR tgt2 (qqq C(5)) + DbSelectArea("tgt2") + Assert.Equal(2, (INT) XmlToCursor(SELF:Doc("12"), "tgt2", 8192)) + Assert.Equal(2, (INT) RecCount("tgt2")) + SELF:Close("tgt2") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendCoercesToTheTargetFieldType AS VOID + SELF:Close("tgt4") + CREATE CURSOR tgt4 (ddate D, llog L, nnum N(6,2), cchar C(4)) + DbSelectArea("tgt4") + XmlToCursor(SELF:Doc("2024-01-15true" + ; + "12.3456abcdefgh"), "tgt4", 8192) + DbSelectArea("tgt4") + DbGoTop() + Assert.Equal(2024, (INT) Year(tgt4->ddate)) + Assert.Equal(1, (INT) Month(tgt4->ddate)) + Assert.True(tgt4->llog) + Assert.Equal(12.35, (REAL8) tgt4->nnum, 2) // rounded to the field scale + Assert.Equal("abcd", tgt4->cchar) // truncated to the field width + SELF:Close("tgt4") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendWithEmptyNameUsesTheCurrentArea AS VOID + SELF:Close("cur3") + CREATE CURSOR cur3 (cchar C(20)) + DbSelectArea("cur3") + Assert.Equal(2, (INT) XmlToCursor(SELF:Doc("ab"), "", 8192)) + Assert.Equal(2, (INT) RecCount("cur3")) + SELF:Close("cur3") + END METHOD + + #endregion + + #region source flavours + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD Flag512ReadsFromAFile AS VOID + VAR cFile := Path.Combine(Path.GetTempPath(), "X2CIN_" + Guid.NewGuid():ToString("N") + ".xml") + File.WriteAllText(cFile, SELF:TypesXml(TRUE)) + SELF:Close("fromfile") + Assert.Equal(2, (INT) XmlToCursor(cFile, "fromfile", 512)) + SELF:Close("fromfile") + File.Delete(cFile) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AttributeFormatIsRead AS VOID + SELF:Close("attr") + Assert.Equal(1, (INT) XmlToCursor(SELF:Doc(""), "attr", 0)) + Assert.Equal("CC C(2,0) NN N(3,1)", SELF:Stru("attr")) + SELF:Close("attr") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AttributesAreDroppedWhenTheRowAlsoHasElements AS VOID + SELF:Close("mix") + XmlToCursor(SELF:Doc("x"), "mix", 0) + Assert.Equal("B C(1,0)", SELF:Stru("mix")) + SELF:Close("mix") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD Flag65536CreatesVarChar AS VOID + SELF:Close("vc") + XmlToCursor(SELF:TypesXml(TRUE), "vc", 65536) + DbSelectArea("vc") + Assert.Equal("V", DbFieldInfo(DBS_TYPE, FieldPos("cchar"))) + SELF:Close("vc") + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD EntitiesAndAccentsSurvive AS VOID + SELF:Close("ent") + XmlToCursor(SELF:Doc("a&bniño"), "ent", 0) + DbSelectArea("ent") + DbGoTop() + Assert.Equal("a&b", AllTrim(ent->a)) + Assert.Equal("ni" + Chr(241) + "o", AllTrim(ent->b)) + SELF:Close("ent") + END METHOD + + #endregion + + #region errors + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD InvalidXmlThrows AS VOID + Assert.ThrowsAny({ => XmlToCursor("this is not xml", "bad1", 0) }) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD MissingFileThrows AS VOID + VAR cFile := Path.Combine(Path.GetTempPath(), "X2CMISSING_" + Guid.NewGuid():ToString("N") + ".xml") + Assert.ThrowsAny({ => XmlToCursor(cFile, "bad2", 512) }) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD DocumentWithoutARowLevelThrows AS VOID + Assert.ThrowsAny({ => XmlToCursor("12", "bad3", 0) }) + END METHOD + + [Fact, Trait("Category", "XmlToCursor")]; + METHOD AppendToAnUnknownAliasThrows AS VOID + Assert.ThrowsAny({ => XmlToCursor(SELF:Doc("1"), "nosuchalias", 8192) }) + END METHOD + + #endregion + + END CLASS + +END NAMESPACE diff --git a/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg b/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg index 8b92ab9972..16dfdb88a0 100644 --- a/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg +++ b/src/Runtime/XSharp.VFP.UI/VfpUIProvider.prg @@ -54,46 +54,40 @@ BEGIN NAMESPACE XSharp.VFP.UI PUBLIC METHOD SysMetric(nScreenElement AS LONG) AS LONG SWITCH nScreenElement - CASE 1 // SYSMETRIC_SCREENWIDTH - LOCAL hDC := VfpWin32UI.GetDC(IntPtr.Zero) AS IntPtr - LOCAL nRes := VfpWin32UI.GetDeviceCaps(hDC, VfpWin32UI.DESKTOP_HORZRES) AS LONG - VfpWin32UI.ReleaseDC(IntPtr.Zero, hDC) - RETURN nRes - CASE 2 // SYSMETRIC_SCREENHEIGHT - LOCAL hDC := VfpWin32UI.GetDC(IntPtr.Zero) AS IntPtr - LOCAL nRes := VfpWin32UI.GetDeviceCaps(hDC, VfpWin32UI.DESKTOP_VERTRES) AS LONG - VfpWin32UI.ReleaseDC(IntPtr.Zero, hDC) - RETURN nRes - CASE 3; RETURN SystemInformation.MinimizedWindowSpacingSize.Width - CASE 4; RETURN SystemInformation.MinimizedWindowSpacingSize.Height - CASE 5; RETURN SystemInformation.VerticalScrollBarWidth - CASE 6; RETURN SystemInformation.VerticalScrollBarArrowHeight - CASE 7; RETURN SystemInformation.HorizontalScrollBarArrowWidth - CASE 8; RETURN SystemInformation.HorizontalScrollBarHeight - CASE 9; RETURN SystemInformation.CaptionHeight - CASE 10; RETURN SystemInformation.FixedFrameBorderSize.Width - CASE 11; RETURN SystemInformation.FixedFrameBorderSize.Height - CASE 12; RETURN SystemInformation.FrameBorderSize.Width - CASE 13; RETURN SystemInformation.FrameBorderSize.Height - CASE 14; RETURN SystemInformation.HorizontalScrollBarThumbWidth - CASE 15; RETURN SystemInformation.VerticalScrollBarWidth - CASE 16; RETURN SystemInformation.IconSize.Width - CASE 17; RETURN SystemInformation.IconSize.Height - CASE 18; RETURN 0 - CASE 19; RETURN 0 - CASE 20; RETURN SystemInformation.MenuHeight - CASE 21; RETURN SystemInformation.MaxWindowTrackSize.Width - CASE 22; RETURN SystemInformation.MaxWindowTrackSize.Height - CASE 23; RETURN SystemInformation.KanjiWindowHeight - CASE 24; RETURN SystemInformation.MinWindowTrackSize.Width - CASE 25; RETURN SystemInformation.MinWindowTrackSize.Height - CASE 26; RETURN SystemInformation.MinimumWindowSize.Width - CASE 27; RETURN SystemInformation.MinimumWindowSize.Height - CASE 30; RETURN iif(SystemInformation.MousePresent == TRUE, 1, 0) - CASE 31; RETURN iif(SystemInformation.DebugOS == TRUE , 1, 0) - CASE 32; RETURN iif(SystemInformation.MouseButtonsSwapped == TRUE, 1, 0) - CASE 33; RETURN SystemInformation.ToolWindowCaptionButtonSize.Width - CASE 34; RETURN SystemInformation.ToolWindowCaptionHeight + CASE 1; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXSCREEN) + CASE 2; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYSCREEN) + CASE 3; RETURN SystemInformation.MinimizedWindowSpacingSize.Width + CASE 4; RETURN SystemInformation.MinimizedWindowSpacingSize.Height + CASE 5; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXVSCROLL) + CASE 6; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYVSCROLL) + CASE 7; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXHSCROLL) + CASE 8; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYHSCROLL) + CASE 9; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYCAPTION) + CASE 10; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXBORDER) + CASE 11; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYBORDER) + CASE 12; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXDLGFRAME) + CASE 13; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYDLGFRAME) + CASE 14; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXHTHUMB) + CASE 15; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYVTHUMB) + CASE 16; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXICON) + CASE 17; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYICON) + CASE 18; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXCURSOR) + CASE 19; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYCURSOR) + CASE 20; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYMENU) + CASE 21; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXFULLSCREEN) + CASE 22; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYFULLSCREEN) + CASE 23; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYKANJIWINDOW) + CASE 24; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXMINTRACK) + CASE 25; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYMINTRACK) + CASE 26; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXMIN) + CASE 27; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYMIN) + CASE 28; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXSIZE) + CASE 29; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYSIZE) + CASE 30; RETURN IIF(VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_MOUSEPRESENT) != 0, 1, 0) + CASE 31; RETURN IIF(VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_DEBUG) != 0, 1, 0) + CASE 32; RETURN IIF(VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_SWAPBUTTON) != 0, 1, 0) + CASE 33; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CXSMSIZE) + CASE 34; RETURN VfpWin32UI.GetSystemMetrics(VfpWin32UI.SM_CYSMSIZE) END SWITCH RETURN 0 END METHOD diff --git a/src/Runtime/XSharp.VFP.UI/Win32UI.prg b/src/Runtime/XSharp.VFP.UI/Win32UI.prg index 6a996afc49..239f7fd3f5 100644 --- a/src/Runtime/XSharp.VFP.UI/Win32UI.prg +++ b/src/Runtime/XSharp.VFP.UI/Win32UI.prg @@ -14,6 +14,41 @@ BEGIN NAMESPACE XSharp.VFP.UI PUBLIC CONST DESKTOP_HORZRES := 117 AS INT PUBLIC CONST DESKTOP_VERTRES := 118 AS INT PUBLIC CONST PD_PRINTSETUP := 0x40U AS DWORD + + // SYSMETRIC(): the VFP help points at GetSystemMetrics() + PUBLIC CONST SM_CXSCREEN := 0 AS INT + PUBLIC CONST SM_CYSCREEN := 1 AS INT + PUBLIC CONST SM_CXVSCROLL := 2 AS INT + PUBLIC CONST SM_CYHSCROLL := 3 AS INT + PUBLIC CONST SM_CYCAPTION := 4 AS INT + PUBLIC CONST SM_CXBORDER := 5 AS INT + PUBLIC CONST SM_CYBORDER := 6 AS INT + PUBLIC CONST SM_CXDLGFRAME := 7 AS INT + PUBLIC CONST SM_CYDLGFRAME := 8 AS INT + PUBLIC CONST SM_CYVTHUMB := 9 AS INT + PUBLIC CONST SM_CXHTHUMB := 10 AS INT + PUBLIC CONST SM_CXICON := 11 AS INT + PUBLIC CONST SM_CYICON := 12 AS INT + PUBLIC CONST SM_CXCURSOR := 13 AS INT + PUBLIC CONST SM_CYCURSOR := 14 AS INT + PUBLIC CONST SM_CYMENU := 15 AS INT + PUBLIC CONST SM_CXFULLSCREEN := 16 AS INT + PUBLIC CONST SM_CYFULLSCREEN := 17 AS INT + PUBLIC CONST SM_CYKANJIWINDOW := 18 AS INT + PUBLIC CONST SM_MOUSEPRESENT := 19 AS INT + PUBLIC CONST SM_CYVSCROLL := 20 AS INT + PUBLIC CONST SM_CXHSCROLL := 21 AS INT + PUBLIC CONST SM_DEBUG := 22 AS INT + PUBLIC CONST SM_SWAPBUTTON := 23 AS INT + PUBLIC CONST SM_CXMIN := 28 AS INT + PUBLIC CONST SM_CYMIN := 29 AS INT + PUBLIC CONST SM_CXSIZE := 30 AS INT + PUBLIC CONST SM_CYSIZE := 31 AS INT + PUBLIC CONST SM_CXMINTRACK := 34 AS INT + PUBLIC CONST SM_CYMINTRACK := 35 AS INT + PUBLIC CONST SM_CXSMSIZE := 52 AS INT + PUBLIC CONST SM_CYSMSIZE := 53 AS INT + [StructLayout(LayoutKind.Sequential, CharSet := CharSet.Unicode)]; PUBLIC STRUCT PRINTDLGW PUBLIC lStructSize AS DWORD @@ -84,6 +119,9 @@ BEGIN NAMESPACE XSharp.VFP.UI [DllImport("gdi32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)]; STATIC EXTERN METHOD GetDeviceCaps(hDC AS IntPtr, nIndex AS INT) AS INT + [DllImport("user32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)]; + STATIC EXTERN METHOD GetSystemMetrics(nIndex AS INT) AS INT + [DllImport("user32.dll", CharSet := CharSet.Auto, SetLastError := TRUE, ExactSpelling := TRUE)]; STATIC EXTERN METHOD GetDC(hWnd AS IntPtr) AS IntPtr diff --git a/src/Runtime/XSharp.VFP/Cursors/Xml.prg b/src/Runtime/XSharp.VFP/Cursors/Xml.prg index dd79c6006f..1518894f5a 100644 --- a/src/Runtime/XSharp.VFP/Cursors/Xml.prg +++ b/src/Runtime/XSharp.VFP/Cursors/Xml.prg @@ -8,16 +8,13 @@ using System using System.IO using System.Data using System.Text +using System.Collections.Generic using System.Xml using XSharp.RDD +using XSharp.RDD.Enums using XSharp.RDD.Support using System.Globalization -// nFlags values for CursorToXml(). Only the ones implemented are listed here: -DEFINE C2X_FLAG_CONTINUOUS := 1 // Produce unformatted XML as one continuous string -DEFINE C2X_FLAG_TOFILE := 512 // Send the output to the file name in cOutput - - /// [FoxProFunction("CURSORTOXML", FoxFunctionCategory.General, FoxEngine.RuntimeCore, FoxFunctionStatus.Partial, FoxCriticality.Medium)]; FUNCTION CursorToXML (uArea, cOutput, nOutputFormat, nFlags, nRecords, cSchemaName, cSchemaLocation, cNameSpace ) AS USUAL CLIPPER @@ -56,12 +53,12 @@ FUNCTION CursorToXML (uArea, cOutput, nOutputFormat, nFlags, nRecords, cSchemaNa var nOldArea := RuntimeState.CurrentWorkarea RuntimeState.CurrentWorkarea := nArea try - cXml := __FoxCursorToXmlString(nRecs, cSchema, cNs, nFlagsInt) + cXml := FoxXml.WriteToString(nRecs, cSchema, cNs, nFlagsInt) finally RuntimeState.CurrentWorkarea := nOldArea end try - if _AND(nFlagsInt, C2X_FLAG_TOFILE) != 0 + if _AND(nFlagsInt, FoxXml.C2X_FLAG_TOFILE) != 0 File.WriteAllText(cTarget, cXml, UTF8Encoding{FALSE}) return (long) FileInfo{cTarget}:Length endif @@ -70,153 +67,702 @@ FUNCTION CursorToXML (uArea, cOutput, nOutputFormat, nFlags, nRecords, cSchemaNa XSharp.MemVar.Put(cTarget, cXml) RETURN Encoding.UTF8:GetByteCount(cXml) -/// Builds the XML for the cursor in the current work area. -INTERNAL FUNCTION __FoxCursorToXmlString(nRecs as long, cSchema as string, cNs as string, nFlags as long) as string - local nMode as XmlWriteMode - var oData := __FoxCursorDataTable(nRecs) +/// +[FoxProFunction("XMLTOCURSOR", FoxFunctionCategory.General, FoxEngine.RuntimeCore, FoxFunctionStatus.Partial, FoxCriticality.High)]; +FUNCTION XmlToCursor( eExpression, cCursorName, nFlags ) AS USUAL CLIPPER + local cAlias as string + local nFlagsInt as long - // VFP always names the root element VFPData, whatever the output format is - var oSet := DataSet{"VFPData"} - if !String.IsNullOrEmpty(cNs) - oSet:Namespace := cNs + if !IsString(eExpression) + throw Error.VoDbError(EG_ARG, EDB_PARAM, __FUNCTION__, nameof(eExpression), 1, {eExpression}) endif - oSet:Tables:Add(oData) - - // cSchemaName: "" = no schema, "1" = inline schema, anything else = external .xsd - nMode := XmlWriteMode.IgnoreSchema - if cSchema == "1" - nMode := XmlWriteMode.WriteSchema - elseif !String.IsNullOrEmpty(cSchema) - var cSchemaFile := cSchema - if String.IsNullOrEmpty(Path.GetExtension(cSchemaFile)) - cSchemaFile += ".xsd" - endif - oSet:WriteXmlSchema(cSchemaFile) + + nFlagsInt := (long) iif(IsNumeric(nFlags), nFlags, 0) + cAlias := (string) iif(IsString(cCursorName), cCursorName, "") + + var oDoc := FoxXml.Load((string) eExpression, _AND(nFlagsInt, FoxXml.X2C_FLAG_FROMFILE) != 0) + var oSchema := FoxXml.SchemaTypes(oDoc) + var oTable := FoxXml.ReadRows(oDoc) + + if oTable != NULL + if _AND(nFlagsInt, FoxXml.X2C_FLAG_APPEND) != 0 + FoxXml.AppendRows(oTable, cAlias) + else + FoxXml.BuildCursor(oTable, oSchema, ; + iif(String.IsNullOrEmpty(cAlias), FoxXml.X2C_DEFAULTCURSOR, cAlias), nFlagsInt) + endif endif - var oSettings := XmlWriterSettings{} - oSettings:Indent := _AND(nFlags, C2X_FLAG_CONTINUOUS) == 0 - oSettings:Encoding := UTF8Encoding{FALSE} + return FoxXml.CurrentRecCount() + +/// One field of the cursor XmlToCursor() is about to build. +INTERNAL CLASS FoxXmlColumn + INTERNAL Name AS STRING + INTERNAL FldType AS STRING + INTERNAL Len AS LONG + INTERNAL Dec AS LONG + INTERNAL Flags AS LONG + /// Set for a decimal(19,4), which nFlags 2048 turns into Currency. + INTERNAL IsCurrency AS LOGIC + + INTERNAL CONSTRUCTOR(cName as string, cType as string, nLen as long, nDec as long) + SELF:Name := cName + SELF:FldType := cType + SELF:Len := nLen + SELF:Dec := nDec + SELF:Flags := 0 + SELF:IsCurrency := FALSE + END CONSTRUCTOR + + /// The schema dictionary is reused, so the flags are applied to a copy. + INTERNAL METHOD Clone() as FoxXmlColumn + var oResult := FoxXmlColumn{SELF:Name, SELF:FldType, SELF:Len, SELF:Dec} + oResult:Flags := SELF:Flags + oResult:IsCurrency := SELF:IsCurrency + return oResult + END METHOD +END CLASS + +INTERNAL STATIC CLASS FoxXml + // nFlags values for CursorToXml(). Only the ones implemented are listed here: + INTERNAL CONST C2X_FLAG_CONTINUOUS := 1 AS LONG // Produce unformatted XML as one continuous string + INTERNAL CONST C2X_FLAG_TOFILE := 512 AS LONG // Send the output to the file name in cOutput + + // nFlags values for XmlToCursor(). Only the ones implemented are listed here: + INTERNAL CONST X2C_FLAG_FROMFILE := 512 AS LONG // The first parameter is a file name, not XML text + INTERNAL CONST X2C_FLAG_NOCPTRANS := 1024 AS LONG // Character and Memo fields get the NOCPTRANS flag + INTERNAL CONST X2C_FLAG_CURRENCY := 2048 AS LONG // decimal(19,4) becomes Currency instead of Numeric + INTERNAL CONST X2C_FLAG_APPEND := 8192 AS LONG // cCursorName names an existing cursor to append to + INTERNAL CONST X2C_FLAG_VARCHAR := 65536 AS LONG // Character fields become VarChar + + // VFP names the cursor XMLRESULT when the caller does not name one + INTERNAL CONST X2C_DEFAULTCURSOR := "XMLRESULT" AS STRING + // Anything wider than this becomes a Memo instead of a Character field + INTERNAL CONST X2C_MAXCHARLEN := 254 AS LONG + INTERNAL CONST X2C_XSDNAMESPACE := "http://www.w3.org/2001/XMLSchema" AS STRING + + // Internal functions + /// Builds the XML for the cursor in the current work area. + INTERNAL STATIC METHOD WriteToString(nRecs as long, cSchema as string, cNs as string, nFlags as long) as string + local nMode as XmlWriteMode + + var oData := CursorToTable(nRecs) + + // VFP always names the root element VFPData, whatever the output format is + var oSet := DataSet{"VFPData"} + if !String.IsNullOrEmpty(cNs) + oSet:Namespace := cNs + endif + oSet:Tables:Add(oData) + + // cSchemaName: "" = no schema, "1" = inline schema, anything else = external .xsd + nMode := XmlWriteMode.IgnoreSchema + if cSchema == "1" + nMode := XmlWriteMode.WriteSchema + elseif !String.IsNullOrEmpty(cSchema) + var cSchemaFile := cSchema + if String.IsNullOrEmpty(Path.GetExtension(cSchemaFile)) + cSchemaFile += ".xsd" + endif + oSet:WriteXmlSchema(cSchemaFile) + endif - var oStream := MemoryStream{} - var oWriter := XmlWriter.Create(oStream, oSettings) - oSet:WriteXml(oWriter, nMode) - oWriter:Flush() - oWriter:Close() + var oSettings := XmlWriterSettings{} + oSettings:Indent := _AND(nFlags, FoxXml.C2X_FLAG_CONTINUOUS) == 0 + oSettings:Encoding := UTF8Encoding{FALSE} - return Encoding.UTF8:GetString(oStream:ToArray()) + var oStream := MemoryStream{} + var oWriter := XmlWriter.Create(oStream, oSettings) + oSet:WriteXml(oWriter, nMode) + oWriter:Flush() + oWriter:Close() + return Encoding.UTF8:GetString(oStream:ToArray()) -/// Reads the cursor in the current work area into a table of preformatted values. -INTERNAL FUNCTION __FoxCursorDataTable(nRecs as long) as DataTable - local oResult := NULL as object - if !CoreDb.Info(DBI_RDD_OBJECT, REF oResult) - throw Error.VoDbError(EG_NOTABLE, EDB_NOTABLE, __FUNCTION__, "uArea", 1, {}) - endif - var oRDD := (IRdd) oResult - var nFields := oRDD:FieldCount - var oTable := DataTable{oRDD:Alias:ToLower()} - - // Every column is written as text: that is the only way to reproduce the - // field width and decimal scale that VFP puts in the XML. - local aTypes as string[] - local aDecs as long[] - aTypes := string[]{nFields} - aDecs := long[]{nFields} - for var nI := 1 to nFields - var cName := ((string) oRDD:FieldInfo(nI, DBS_ALIAS, NULL)):ToLower() - aTypes[nI] := ((string) oRDD:FieldInfo(nI, DBS_TYPE, NULL)):ToUpper() - aDecs[nI] := (long) oRDD:FieldInfo(nI, DBS_DEC, NULL) - oTable:Columns:Add(cName, typeof(string)) - next - - // The record order and any active filter are honoured because we simply - // walk the work area from top to bottom. - var nWritten := 0 - oRDD:GoTop() - do while !oRDD:EoF - local oRow as object[] - oRow := object[]{nFields} + /// Reads the cursor in the current work area into a table of preformatted values. + INTERNAL STATIC METHOD CursorToTable(nRecs as long) as DataTable + local oResult := NULL as object + + if !CoreDb.Info(DBI_RDD_OBJECT, REF oResult) + throw Error.VoDbError(EG_NOTABLE, EDB_NOTABLE, __FUNCTION__, "uArea", 1, {}) + endif + var oRDD := (IRdd) oResult + var nFields := oRDD:FieldCount + var oTable := DataTable{oRDD:Alias:ToLower()} + + // Every column is written as text: that is the only way to reproduce the + // field width and decimal scale that VFP puts in the XML. + local aTypes as string[] + local aDecs as long[] + aTypes := string[]{nFields} + aDecs := long[]{nFields} for var nI := 1 to nFields - oRow[nI] := __FoxXmlValue(oRDD:GetValue(nI), aTypes[nI], aDecs[nI]) + var cName := ((string) oRDD:FieldInfo(nI, DBS_ALIAS, NULL)):ToLower() + aTypes[nI] := ((string) oRDD:FieldInfo(nI, DBS_TYPE, NULL)):ToUpper() + aDecs[nI] := (long) oRDD:FieldInfo(nI, DBS_DEC, NULL) + oTable:Columns:Add(cName, typeof(string)) next - oTable:Rows:Add(oRow) - nWritten++ - // VFP does not restore the record pointer: it ends up at EOF when every - // record was written, or on the last record written when nRecords limits it - if nRecs > 0 .AND. nWritten >= nRecs - exit - endif - oRDD:Skip(1) - enddo - oTable:AcceptChanges() - return oTable - - -/// Formats one field value the way the VFP CursorToXml() output does. -INTERNAL FUNCTION __FoxXmlValue(oValue as object, cType as string, nDec as long) as object - local r8 as real8 - - // VFP leaves the element out altogether for a NULL field - if oValue == NULL .OR. oValue == DBNull.Value - return DBNull.Value - endif - - switch cType - case "L" - return iif((logic) oValue, "true", "false") - case "D" - if oValue IS XSharp.IDate VAR dVal - // an empty date becomes an empty element, not a missing one - return iif(dVal:Month == 0, "", dVal:Value:ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)) + // The record order and any active filter are honoured because we simply + // walk the work area from top to bottom. + var nWritten := 0 + oRDD:GoTop() + do while !oRDD:EoF + local oRow as object[] + oRow := object[]{nFields} + for var nI := 1 to nFields + oRow[nI] := FormatValue(oRDD:GetValue(nI), aTypes[nI], aDecs[nI]) + next + oTable:Rows:Add(oRow) + nWritten++ + // VFP does not restore the record pointer: it ends up at EOF when every + // record was written, or on the last record written when nRecords limits it + if nRecs > 0 .AND. nWritten >= nRecs + exit + endif + oRDD:Skip(1) + enddo + oTable:AcceptChanges() + return oTable + + + /// Formats one field value the way the VFP CursorToXml() output does. + INTERNAL STATIC METHOD FormatValue(oValue as object, cType as string, nDec as long) as object + local r8 as real8 + + // VFP leaves the element out altogether for a NULL field + if oValue == NULL .OR. oValue == DBNull.Value + return DBNull.Value endif - return oValue:ToString() - case "T" - local dtVal as DateTime - if oValue IS XSharp.IDate VAR dtSrc - dtVal := dtSrc:Value - else - dtVal := Convert.ToDateTime(oValue, CultureInfo.InvariantCulture) - endif - // "s" gives the ISO layout VFP uses: 2024-01-15T10:30:45 - return iif(dtVal:Year <= 1, "", dtVal:ToString("s", CultureInfo.InvariantCulture)) - - case "Y" - // VFP always writes currency with 4 decimals - r8 := __FoxXmlNumber(oValue) - return r8:ToString("F4", CultureInfo.InvariantCulture) - - case "I" - r8 := __FoxXmlNumber(oValue) - return r8:ToString("F0", CultureInfo.InvariantCulture) - - case "N" - case "F" - r8 := __FoxXmlNumber(oValue) - return r8:ToString("F" + nDec:ToString(), CultureInfo.InvariantCulture) - - case "B" - // The RDD does not report the scale of Double fields, so I cannot - // reproduce the fixed decimals VFP writes; emit the full value instead - // of truncating it. - r8 := __FoxXmlNumber(oValue) - if nDec > 0 + switch cType + case "L" + return iif((logic) oValue, "true", "false") + + case "D" + if oValue IS XSharp.IDate VAR dVal + // an empty date becomes an empty element, not a missing one + return iif(dVal:Month == 0, "", dVal:Value:ToString("yyyy-MM-dd", CultureInfo.InvariantCulture)) + endif + return oValue:ToString() + + case "T" + local dtVal as DateTime + if oValue IS XSharp.IDate VAR dtSrc + dtVal := dtSrc:Value + else + dtVal := Convert.ToDateTime(oValue, CultureInfo.InvariantCulture) + endif + // "s" gives the ISO layout VFP uses: 2024-01-15T10:30:45 + return iif(dtVal:Year <= 1, "", dtVal:ToString("s", CultureInfo.InvariantCulture)) + + case "Y" + // VFP always writes currency with 4 decimals + r8 := ToDouble(oValue) + return r8:ToString("F4", CultureInfo.InvariantCulture) + + case "I" + r8 := ToDouble(oValue) + return r8:ToString("F0", CultureInfo.InvariantCulture) + + case "N" + case "F" + r8 := ToDouble(oValue) return r8:ToString("F" + nDec:ToString(), CultureInfo.InvariantCulture) + + case "B" + // The RDD does not report the scale of Double fields, so I cannot + // reproduce the fixed decimals VFP writes; emit the full value instead + // of truncating it. + r8 := ToDouble(oValue) + if nDec > 0 + return r8:ToString("F" + nDec:ToString(), CultureInfo.InvariantCulture) + endif + return r8:ToString("R", CultureInfo.InvariantCulture) + end switch + + // C, M, V and anything else: VFP strips the padding blanks + return oValue:ToString():TrimEnd() + + + /// Unwraps the numeric types the RDD layer hands out. + INTERNAL STATIC METHOD ToDouble(oValue as object) as real8 + if oValue IS XSharp.IFloat VAR fVal + return fVal:Value + endif + return Convert.ToDouble(oValue, CultureInfo.InvariantCulture) + + /// Parses the XML once, from a string or from a file. + INTERNAL STATIC METHOD Load(cSource as string, lFromFile as logic) as XmlDocument + var oDoc := XmlDocument{} + oDoc:XmlResolver := NULL + try + if lFromFile + if !File.Exists(cSource) + // VFP reports a file it cannot open as a parse error, not a file error + throw FileNotFoundException{cSource} + endif + oDoc:Load(cSource) + else + oDoc:LoadXml(cSource) + endif + catch e as Exception + throw Exception{ __VfpStr(VFPErrors.VFP_XML_PARSE_ERROR, e:Message) } + end try + return oDoc + + /// Reads the rows as a table of strings, whatever the document declares. + INTERNAL STATIC METHOD ReadRows(oDoc as XmlDocument) as DataTable + var oSet := DataSet{} + oSet:Locale := CultureInfo.InvariantCulture + try + using var oReader := XmlNodeReader{oDoc} + oSet:ReadXml(oReader, XmlReadMode.InferSchema) + catch e as Exception + throw Exception{ __VfpStr(VFPErrors.VFP_XML_PARSE_ERROR, e:Message) } + end try + + if oSet:Tables:Count == 0 + return NULL + endif + + if oSet:DataSetName == "NewDataSet" + throw Exception{ __VfpStr(VFPErrors.VFP_XML_NOSCHEMA) } endif - return r8:ToString("R", CultureInfo.InvariantCulture) - end switch - // C, M, V and anything else: VFP strips the padding blanks - return oValue:ToString():TrimEnd() + return oSet:Tables[0] + /// The columns that carry data, in document order. + INTERNAL STATIC METHOD DataColumns(oTable as DataTable) as List + local lHasElements := FALSE as logic + var oResult := List{} -/// Unwraps the numeric types the RDD layer hands out. -INTERNAL FUNCTION __FoxXmlNumber(oValue as object) as real8 - if oValue IS XSharp.IFloat VAR fVal - return fVal:Value - endif - return Convert.ToDouble(oValue, CultureInfo.InvariantCulture) + foreach oColumn as DataColumn in oTable:Columns + if oColumn:ColumnMapping == MappingType.Element + lHasElements := TRUE + exit + endif + next + + foreach oColumn as DataColumn in oTable:Columns + switch oColumn:ColumnMapping + case MappingType.Element + oResult:Add(oColumn) + case MappingType.Attribute + if !lHasElements + oResult:Add(oColumn) + endif + end switch + next + return oResult + + /// + /// Maps element name to the field its inline xsd type calls for. The schema is + /// read out of the document text rather than through XmlSchemaSet:Compile(), + /// because the object model only exposes the facets we need through the + /// post-schema-compilation infoset. + /// + INTERNAL STATIC METHOD SchemaTypes(oDoc as XmlDocument) as Dictionary + var oResult := Dictionary{StringComparer.OrdinalIgnoreCase} + + var oNs := XmlNamespaceManager{oDoc:NameTable} + oNs:AddNamespace("xsd", FoxXml.X2C_XSDNAMESPACE) + var oNodes := oDoc:SelectNodes("//xsd:schema//xsd:element[@name]", oNs) + if oNodes == NULL + return oResult + endif + foreach oNode as XmlNode in oNodes + if oNode is XmlElement var oElement + // the dataset and the row element carry a complexType: not fields + if oElement:SelectSingleNode("xsd:complexType", oNs) == NULL + SchemaField(oElement, oNs, oResult) + endif + endif + next + return oResult + + /// Reads one field declaration out of the inline schema. + INTERNAL STATIC METHOD SchemaField(oElement as XmlElement, oNs as XmlNamespaceManager, ; + oResult as Dictionary) as void + local cBase as string + local nMaxLen := 0 as long + local nTotal := 0 as long + local nFraction := 0 as long + + var cName := oElement:GetAttribute("name") + if String.IsNullOrEmpty(cName) .or. oResult:ContainsKey(cName) + return + endif + + cBase := oElement:GetAttribute("type") + if oElement:SelectSingleNode("xsd:simpleType/xsd:restriction", oNs) is XmlElement var oRestriction + cBase := oRestriction:GetAttribute("base") + foreach oFacet as XmlNode in oRestriction:ChildNodes + if oFacet is XmlElement var oFacetElement + var nValue := FacetValue(oFacetElement:GetAttribute("value")) + switch oFacetElement:LocalName + case "maxLength" + nMaxLen := nValue + case "totalDigits" + nTotal := nValue + case "fractionDigits" + nFraction := nValue + end switch + endif + next + endif + + oResult:Add(cName, ColumnFromType(cName, LocalName(cBase), nMaxLen, nTotal, nFraction)) + return + + /// Drops the namespace prefix from an xsd type name: "xsd:decimal" gives "decimal". + INTERNAL STATIC METHOD LocalName(cType as string) as string + if String.IsNullOrEmpty(cType) + return "" + endif + var nPos := cType:IndexOf(c':') + if nPos < 0 + return cType + endif + return cType:Substring(nPos + 1) + + /// Turns one xsd type into the field VFP 9 builds from it. + INTERNAL STATIC METHOD ColumnFromType(cName as string, cBase as string, ; + nMaxLen as long, nTotal as long, nFraction as long) as FoxXmlColumn + + switch cBase + case "boolean" + return FoxXmlColumn{cName, "L", 1, 0} + case "date" + return FoxXmlColumn{cName, "D", 8, 0} + case "dateTime" + return FoxXmlColumn{cName, "T", 8, 0} + case "int" + case "integer" + case "short" + case "long" + case "unsignedInt" + case "unsignedShort" + return FoxXmlColumn{cName, "I", 4, 0} + case "double" + case "float" + return FoxXmlColumn{cName, "B", 8, 8} + case "decimal" + var oDecimal := FoxXmlColumn{cName, "N", nTotal + iif(nFraction > 0, 1, 0), nFraction} + oDecimal:IsCurrency := (nTotal == 19 .and. nFraction == 4) + return oDecimal + end switch + + if nMaxLen <= 0 .or. nMaxLen > FoxXml.X2C_MAXCHARLEN + return FoxXmlColumn{cName, "M", 4, 0} + endif + return FoxXmlColumn{cName, "C", nMaxLen, 0} + + /// Reads one xsd facet, which the schema object model hands over as a string. + INTERNAL STATIC METHOD FacetValue(cValue as string) as long + local nResult as long + if Int32.TryParse(cValue, NumberStyles.Integer, CultureInfo.InvariantCulture, out nResult) + return nResult + endif + return 0 + + /// Infers the field for one column from its values, the way VFP 9 does. + INTERNAL STATIC METHOD InferColumn(cName as string, oTable as DataTable, oColumn as DataColumn) as FoxXmlColumn + local lHasEmpty := FALSE as logic + local lAnyValue := FALSE as logic + local lAllBool := TRUE as logic + local lAllNum := TRUE as logic + local lAllDate := TRUE as logic + local lAllTime := TRUE as logic + local nMaxLen := 0 as long + local nMaxDec := 0 as long + + foreach oRow as DataRow in oTable:Rows + var cValue := CellText(oRow, oColumn) + if cValue:Length == 0 + lHasEmpty := TRUE + loop + endif + lAnyValue := TRUE + nMaxLen := Math.Max(nMaxLen, cValue:Length) + if !IsBool(cValue) + lAllBool := FALSE + endif + var nDec := Decimals(cValue) + if nDec < 0 + lAllNum := FALSE + else + nMaxDec := Math.Max(nMaxDec, nDec) + endif + if !IsDate(cValue) + lAllDate := FALSE + endif + if !IsDateTime(cValue) + lAllTime := FALSE + endif + next + + do case + case !lAnyValue + return FoxXmlColumn{cName, "C", 1, 0} + case lAllBool .and. !lHasEmpty + return FoxXmlColumn{cName, "L", 1, 0} + case lAllNum + return FoxXmlColumn{cName, "N", nMaxLen, nMaxDec} + case lAllDate .and. !lHasEmpty + return FoxXmlColumn{cName, "D", 8, 0} + case lAllTime .and. !lHasEmpty + return FoxXmlColumn{cName, "T", 8, 0} + case nMaxLen > FoxXml.X2C_MAXCHARLEN + return FoxXmlColumn{cName, "M", 4, 0} + endcase + return FoxXmlColumn{cName, "C", nMaxLen, 0} + + /// The values VFP reads back as Logical. + INTERNAL STATIC METHOD IsBool(cValue as string) as logic + switch cValue:ToLowerInvariant() + case "0" + case "1" + case "true" + case "false" + return TRUE + end switch + return FALSE + + /// + /// Number of decimals when the value is one VFP infers as Numeric, -1 otherwise. + /// A sign is deliberately rejected: VFP infers Character for "-5" and for "+5", + /// and Character for "1e3" as well. That is almost certainly a bug in the parser + /// VFP infers with, but migrated code sees the resulting structure, so it is + /// reproduced here. A leading or trailing dot is accepted, matching VFP: ".5" + /// gives N(2,1) and "5." gives N(2,0). + /// + INTERNAL STATIC METHOD Decimals(cValue as string) as long + local nDot := -1 as long + local lAnyDigit := FALSE as logic + + for var nI := 0 upto cValue:Length - 1 + var cChar := cValue[nI] + if cChar == c'.' + if nDot >= 0 + return -1 + endif + nDot := nI + elseif Char.IsDigit(cChar) + lAnyDigit := TRUE + else + return -1 + endif + next + if !lAnyDigit + return -1 + endif + if nDot < 0 + return 0 + endif + return cValue:Length - nDot - 1 + + /// True when the value is an xsd date, the only date layout VFP infers. + INTERNAL STATIC METHOD IsDate(cValue as string) as logic + local dValue as DateTime + return DateTime.TryParseExact(cValue, "yyyy-MM-dd", CultureInfo.InvariantCulture, ; + DateTimeStyles.None, out dValue) + + /// True when the value is an xsd dateTime. + INTERNAL STATIC METHOD IsDateTime(cValue as string) as logic + local dValue as DateTime + local aFormats as string[] + aFormats := {"yyyy-MM-ddTHH:mm:ss", "yyyy-MM-ddTHH:mm:ss.FFFFFFF"} + return DateTime.TryParseExact(cValue, aFormats, CultureInfo.InvariantCulture, ; + DateTimeStyles.None, out dValue) + + /// The text of one cell, trimmed the way VFP trims it. + INTERNAL STATIC METHOD CellText(oRow as DataRow, oColumn as DataColumn) as string + if oRow:IsNull(oColumn) + return "" + endif + // VFP strips the surrounding blanks unless nFlags 4 asks it not to; that flag + // is not implemented, so the values are always trimmed + var cValue := oRow[oColumn]:ToString() + if cValue == NULL + return "" + endif + return cValue:Trim() + + /// Applies the flags that change the type of a whole column. + INTERNAL STATIC METHOD ApplyFlags(oColumn as FoxXmlColumn, nFlags as long) as void + if oColumn:IsCurrency .and. _AND(nFlags, FoxXml.X2C_FLAG_CURRENCY) != 0 + oColumn:FldType := "Y" + oColumn:Len := 8 + oColumn:Dec := 4 + endif + if _AND(nFlags, FoxXml.X2C_FLAG_NOCPTRANS) != 0 + if oColumn:FldType == "C" .or. oColumn:FldType == "M" + oColumn:Flags := _OR(oColumn:Flags, (long) DBFFieldFlags.Binary) + // VFP doubles the width of a Character field read with NOCPTRANS + if oColumn:FldType == "C" + oColumn:Len := Math.Min(oColumn:Len * 2, FoxXml.X2C_MAXCHARLEN) + endif + endif + endif + if _AND(nFlags, FoxXml.X2C_FLAG_VARCHAR) != 0 .and. oColumn:FldType == "C" + oColumn:FldType := "V" + endif + return + + /// Creates the cursor, selects it and fills it. + INTERNAL STATIC METHOD BuildCursor(oTable as DataTable, oSchema as Dictionary, ; + cAlias as string, nFlags as long) as void + local oColumn as FoxXmlColumn + var aColumns := List{} + + var aSource := DataColumns(oTable) + foreach oSrc as DataColumn in aSource + if oSchema:ContainsKey(oSrc:ColumnName) + oColumn := oSchema[oSrc:ColumnName]:Clone() + else + oColumn := InferColumn(oSrc:ColumnName, oTable, oSrc) + endif + ApplyFlags(oColumn, nFlags) + aColumns:Add(oColumn) + next + + if aColumns:Count == 0 + return + endif + + var aStruct := {} + foreach oCol as FoxXmlColumn in aColumns + AAdd(aStruct, {oCol:Name, oCol:FldType, oCol:Len, oCol:Dec, oCol:Name, oCol:Flags}) + next + + if RuntimeState.Workareas:FindAlias(cAlias) != 0 + DbCloseArea(cAlias) + endif + DbCreate(Path.GetTempFileName(), aStruct, "DBFVFP", TRUE, cAlias) + DbSelectArea(cAlias) + + FillCursor(oTable, aSource, aColumns) + return + + /// Writes the rows into the cursor selected in the current work area. + INTERNAL STATIC METHOD FillCursor(oTable as DataTable, aSource as List, ; + aColumns as List) as void + local oResult := NULL as object + + if !CoreDb.Info(DBI_RDD_OBJECT, REF oResult) + throw Error.VoDbError(EG_NOTABLE, EDB_NOTABLE, __FUNCTION__, "cCursorName", 2, {}) + endif + var oRDD := (IRdd) oResult + + foreach oRow as DataRow in oTable:Rows + oRDD:Append(TRUE) + for var nI := 0 upto aColumns:Count - 1 + Put(oRDD, nI + 1, ToField(CellText(oRow, aSource[nI]), aColumns[nI]:FldType)) + next + next + oRDD:GoTop() // VFP leaves the pointer on the first row + return + + /// Appends the rows to a cursor that already exists, matching fields by name. + INTERNAL STATIC METHOD AppendRows(oTable as DataTable, cAlias as string) as void + local oResult := NULL as object + var nArea := iif(String.IsNullOrEmpty(cAlias), RuntimeState.CurrentWorkarea, ; + RuntimeState.Workareas:FindAlias(cAlias)) + if nArea == 0 + throw Error.VoDbError(EG_ARG, EDB_BADALIAS, __FUNCTION__, "cCursorName", 2, {cAlias}) + endif + + var nOldArea := RuntimeState.CurrentWorkarea + RuntimeState.CurrentWorkarea := nArea + try + if !CoreDb.Info(DBI_RDD_OBJECT, REF oResult) + throw Error.VoDbError(EG_NOTABLE, EDB_NOTABLE, __FUNCTION__, "cCursorName", 2, {cAlias}) + endif + var oRDD := (IRdd) oResult + + var aSource := DataColumns(oTable) + var aTarget := List{} + var aTypes := List{} + foreach oColumn as DataColumn in aSource + var nField := oRDD:FieldIndex(oColumn:ColumnName) + aTarget:Add(nField) + aTypes:Add(iif(nField > 0, ((string) oRDD:FieldInfo(nField, DBS_TYPE, NULL)):ToUpper(), "")) + next + + foreach oRow as DataRow in oTable:Rows + oRDD:Append(TRUE) + for var nI := 0 upto aTarget:Count - 1 + if aTarget[nI] > 0 + Put(oRDD, aTarget[nI], ToField(CellText(oRow, aSource[nI]), aTypes[nI])) + endif + next + next + oRDD:GoTop() + finally + RuntimeState.CurrentWorkarea := nOldArea + end try + return + + /// + /// Writes one value, swallowing the error when it does not fit its field. The + /// inferred width is the longest value seen and VFP never reconciles it with the + /// decimals it infers alongside, so a column holding 99999 and 0.1 becomes N(5,1) + /// and the 99999 no longer fits. VFP parks its numeric overflow marker there; our + /// RDD refuses the value outright. The structure is still the one VFP builds, so + /// the field is left blank rather than failing the whole import. + /// + INTERNAL STATIC METHOD Put(oRDD as IRdd, nField as long, oValue as object) as void + try + oRDD:PutValue(nField, oValue) + catch + // the field keeps its blank value + end try + return + + /// Converts one XML text value to the type of the field it goes into. + INTERNAL STATIC METHOD ToField(cValue as string, cType as string) as object + local dValue as DateTime + local r8Value as real8 + local nValue as long + + switch cType + case "L" + switch cValue:ToLowerInvariant() + case "1" + case "true" + return TRUE + end switch + return FALSE + case "D" + case "T" + if DateTime.TryParse(cValue, CultureInfo.InvariantCulture, DateTimeStyles.None, out dValue) + return dValue + endif + return DateTime.MinValue + case "N" + case "F" + case "Y" + case "B" + if System.Double.TryParse(cValue, NumberStyles.Float, CultureInfo.InvariantCulture, out r8Value) + return r8Value + endif + return 0.0 + case "I" + if Int32.TryParse(cValue, NumberStyles.Integer, CultureInfo.InvariantCulture, out nValue) + return nValue + endif + return 0 + end switch + return cValue + + /// RecCount() of the work area currently selected, 0 when there is none. + INTERNAL STATIC METHOD CurrentRecCount() as long + local oResult := NULL as object + if !CoreDb.Info(DBI_RDD_OBJECT, REF oResult) + return 0 + endif + return (long) ((IRdd) oResult):RecCount +END CLASS diff --git a/src/Runtime/XSharp.VFP/ToDo-TUVWX.prg b/src/Runtime/XSharp.VFP/ToDo-TUVWX.prg index 4ee80ded1c..0ff27d8921 100644 --- a/src/Runtime/XSharp.VFP/ToDo-TUVWX.prg +++ b/src/Runtime/XSharp.VFP/ToDo-TUVWX.prg @@ -26,15 +26,6 @@ FUNCTION TxtWidth( cExpression , cFontName, nFontSize , cFontStyle) AS FLOAT THROW NotImplementedException{} // RETURN 0 - - -/// -- todo -- -/// -[FoxProFunction("XMLTOCURSOR", FoxFunctionCategory.General, FoxEngine.RuntimeCore, FoxFunctionStatus.Stub, FoxCriticality.High)]; -FUNCTION XmlToCursor( eExpression , cCursorName , nFlags ) AS LONG - THROW NotImplementedException{} - // RETURN 0 - /// -- todo -- /// [FoxProFunction("XMLUPDATEGRAM", FoxFunctionCategory.General, FoxEngine.RuntimeCore, FoxFunctionStatus.Stub, FoxCriticality.Medium)]; diff --git a/src/Runtime/XSharp.VO/XSharp.VO.Next.xsproj b/src/Runtime/XSharp.VO/XSharp.VO.Next.xsproj index 7c4a73d4ee..cd443e3974 100644 --- a/src/Runtime/XSharp.VO/XSharp.VO.Next.xsproj +++ b/src/Runtime/XSharp.VO/XSharp.VO.Next.xsproj @@ -2,7 +2,7 @@ Library - XSharp + XSharp.VO XSharp.VO VO True diff --git a/src/VisualStudio/CodeDomProvider/XSharpCodeGenerator.cs b/src/VisualStudio/CodeDomProvider/XSharpCodeGenerator.cs index 0554ff9078..0cac38dc6a 100644 --- a/src/VisualStudio/CodeDomProvider/XSharpCodeGenerator.cs +++ b/src/VisualStudio/CodeDomProvider/XSharpCodeGenerator.cs @@ -1745,6 +1745,26 @@ protected override void GeneratePrimitiveExpression(CodePrimitiveExpression e) } else { + if (e.Value is System.Single fl) + { + GenerateSingleFloatValue(fl); + Output.Write("s"); + return; + + } + else if (e.Value is System.Double db) + { + GenerateDoubleValue(db); + Output.Write("d"); + return; + } + else if (e.Value is System.Decimal dec) + { + GenerateDecimalValue(dec); + Output.Write("m"); + return; + } + else if (e.Value is uint || e.Value is ulong) { var tmp = Convert.ToDouble(e.Value); diff --git a/src/VisualStudio/CodeDomProvider/XSharpTreeDiscoverBase.cs b/src/VisualStudio/CodeDomProvider/XSharpTreeDiscoverBase.cs index 0dd642aff8..528949fdcf 100644 --- a/src/VisualStudio/CodeDomProvider/XSharpTreeDiscoverBase.cs +++ b/src/VisualStudio/CodeDomProvider/XSharpTreeDiscoverBase.cs @@ -1346,7 +1346,7 @@ protected void FillCodeDomDesignerData(CodeObject newElement, int line, int col) { if (asm.GetName().Name == designerDLL) { - designType = asm.GetType(designerdataClassname); + designType = asm.GetType(designerdataClassname); break; } } @@ -1557,15 +1557,32 @@ protected object GetNumericValue(XSharpParser.LiteralValueContext context) } else { + var suffix = ""; if (value.EndsWith("m", StringComparison.OrdinalIgnoreCase) || // money value.EndsWith("s", StringComparison.OrdinalIgnoreCase) || // single value.EndsWith("d", StringComparison.OrdinalIgnoreCase)) // double { + suffix = value.Substring(value.Length - 1); value = value.Substring(0, value.Length - 1); } try { - ret = double.Parse(value, System.Globalization.CultureInfo.InvariantCulture); + switch (suffix) + { + case "s": + case "S": + ret = float.Parse(value, System.Globalization.CultureInfo.InvariantCulture); + break; + case "m": + case "M": + ret = decimal.Parse(value, System.Globalization.CultureInfo.InvariantCulture); + break; + case "d": + case "D": + default: + ret = double.Parse(value, System.Globalization.CultureInfo.InvariantCulture); + break; + } } catch (Exception) { diff --git a/src/VisualStudio/ProjectPackage/Commands/CommandSyncDesignerChanges.cs b/src/VisualStudio/ProjectPackage/Commands/CommandSyncDesignerChanges.cs new file mode 100644 index 0000000000..e03c6133ba --- /dev/null +++ b/src/VisualStudio/ProjectPackage/Commands/CommandSyncDesignerChanges.cs @@ -0,0 +1,96 @@ +// +// 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 Community.VisualStudio.Toolkit; + +using Microsoft.VisualStudio.Shell; + +using System; +using System.Linq; +using System.Threading.Tasks; + +using XSharp.Project.ShadowDesigner; +using XSharpModel; + +namespace XSharp.Project +{ + /// + /// File-context-menu command for the shadow-designer bridge: after editing properties or + /// adding/removing/reordering controls in the shadow Designer, run this to fully + /// regenerate the real Form1.Designer.prg from the companion project's current state. + /// Visible only for a SDK-style project's .prg file that already has an open shadow + /// companion project. + /// + [Command(PackageIds.idSyncDesignerChanges)] + internal sealed class CommandSyncDesignerChanges : BaseCommand + { + private XSharpFileNode _currentFile; + + protected override void BeforeQueryStatus(EventArgs e) + { + base.BeforeQueryStatus(e); + _currentFile = null; + ThreadHelper.JoinableTaskFactory.Run(CheckAvailabilityAsync); + } + + private async Task CheckAvailabilityAsync() + { + bool visible = false; + var items = await VS.Solutions.GetActiveItemsAsync(); + foreach (var item in items) + { + if (item is PhysicalFile file) + { + var project = await VS.Solutions.GetActiveProjectAsync(); + var xproject = project != null ? XSolution.FindProject(project.FullPath, "") : null; + if (xproject?.ProjectNode is XSharpProjectNode prjNode && + prjNode.FindChild(file.FullPath) is XSharpFileNode fileNode && + fileNode.HasDesigner && + prjNode is XSharpSdkProjectNode) + { + _currentFile = fileNode; + visible = true; + } + } + } + Command.Visible = visible; + Command.Enabled = visible; + } + + protected override async Task ExecuteAsync(OleMenuCmdEventArgs e) + { + await ThreadHelper.JoinableTaskFactory.SwitchToMainThreadAsync(); + if (_currentFile == null) return; + + await VS.Commands.ExecuteAsync(KnownCommands.File_SaveAll); + + if (!ShadowDesignerBridge.TryResolveCompanionPaths(_currentFile, out var location, out string error)) + { + await VS.MessageBox.ShowErrorAsync("X# WinForms Designer", error); + return; + } + + DesignerChangesSync.SyncResult result; + try + { + result = DesignerChangesSync.Sync(location); + } + catch (Exception ex) + { + await VS.MessageBox.ShowErrorAsync("X# WinForms Designer", ex.ToString()); + return; + } + + await VS.Commands.ExecuteAsync(KnownCommands.File_OpenFile, location.DesignerPrgPath); + + string skippedText = result.SkippedStatements.Count > 0 + ? $" ({result.SkippedStatements.Count} statement(s) skipped -- unsupported shape, check manually: " + + string.Join("; ", result.SkippedStatements) + ")" + : ""; + await VS.StatusBar.ShowMessageAsync( + $"Regenerated Form1.Designer.prg: {result.FieldCount} field(s), {result.StatementCount} statement(s).{skippedText}"); + } + } +} diff --git a/src/VisualStudio/ProjectPackage/Commands/CommandSyncEventHandlers.cs b/src/VisualStudio/ProjectPackage/Commands/CommandSyncEventHandlers.cs new file mode 100644 index 0000000000..da28fd8c2d --- /dev/null +++ b/src/VisualStudio/ProjectPackage/Commands/CommandSyncEventHandlers.cs @@ -0,0 +1,98 @@ +// +// 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 Community.VisualStudio.Toolkit; + +using Microsoft.VisualStudio.Shell; + +using System; +using System.Threading.Tasks; + +using XSharp.Project.ShadowDesigner; +using XSharpModel; + +namespace XSharp.Project +{ + /// + /// File-context-menu command for the shadow-designer bridge: after double-clicking a + /// control in the shadow Designer (which lands the new handler stub in the companion + /// project's C# files, not the real .prg), run this to detect what's new and write it + /// into the real X# source. Visible only for a SDK-style project's .prg file that + /// already has an open shadow companion project. + /// + [Command(PackageIds.idSyncEventHandlers)] + internal sealed class CommandSyncEventHandlers : BaseCommand + { + private XSharpFileNode _currentFile; + + protected override void BeforeQueryStatus(EventArgs e) + { + base.BeforeQueryStatus(e); + _currentFile = null; + ThreadHelper.JoinableTaskFactory.Run(CheckAvailabilityAsync); + } + + private async Task CheckAvailabilityAsync() + { + bool visible = false; + var items = await VS.Solutions.GetActiveItemsAsync(); + foreach (var item in items) + { + if (item is PhysicalFile file) + { + var project = await VS.Solutions.GetActiveProjectAsync(); + var xproject = project != null ? XSolution.FindProject(project.FullPath, "") : null; + if (xproject?.ProjectNode is XSharpProjectNode prjNode && + prjNode.FindChild(file.FullPath) is XSharpFileNode fileNode && + fileNode.HasDesigner && + prjNode is XSharpSdkProjectNode) + { + _currentFile = fileNode; + visible = true; + } + } + } + Command.Visible = visible; + Command.Enabled = visible; + } + + protected override async Task ExecuteAsync(OleMenuCmdEventArgs e) + { + await ThreadHelper.JoinableTaskFactory.SwitchToMainThreadAsync(); + if (_currentFile == null) return; + + // The Designer-added stub/wiring can sit unsaved in an open document buffer -- + // both sync steps read the companion files from disk, not the live buffer. + await VS.Commands.ExecuteAsync(KnownCommands.File_SaveAll); + + if (!ShadowDesignerBridge.TryResolveCompanionPaths(_currentFile, out var location, out string error)) + { + await VS.MessageBox.ShowErrorAsync("X# WinForms Designer", error); + return; + } + + EventHandlerSync.SyncResult result; + try + { + result = EventHandlerSync.Sync(location); + } + catch (Exception ex) + { + await VS.MessageBox.ShowErrorAsync("X# WinForms Designer", ex.ToString()); + return; + } + + if (!result.HasChanges) + { + await VS.StatusBar.ShowMessageAsync("Nothing new to sync -- no new handler stubs or event wiring found."); + return; + } + + await VS.Commands.ExecuteAsync(KnownCommands.File_OpenFile, location.MainPrgPath); + await VS.StatusBar.ShowMessageAsync( + $"Synced {result.NewHandlerNames.Count} handler stub(s) and {result.NewWiringDescriptions.Count} event wiring statement(s)."); + } + } +} diff --git a/src/VisualStudio/ProjectPackage/Menus.cs b/src/VisualStudio/ProjectPackage/Menus.cs index d3a50db9d6..5db5999857 100644 --- a/src/VisualStudio/ProjectPackage/Menus.cs +++ b/src/VisualStudio/ProjectPackage/Menus.cs @@ -57,6 +57,8 @@ internal sealed partial class PackageIds public const int idGenerateWinForm = 0x0120; public const int idPublishProject = 0x0121; public const int idPackProject = 0x0122; + public const int idSyncEventHandlers = 0x0123; + public const int idSyncDesignerChanges = 0x0124; public const int idExporterSubMenu = 0x1030; public const int idExporterGroup = 0x1040; public const int idDebuggerSubMenu = 0x1050; diff --git a/src/VisualStudio/ProjectPackage/Menus.vsct b/src/VisualStudio/ProjectPackage/Menus.vsct index c8b49ee371..a5ad143878 100644 --- a/src/VisualStudio/ProjectPackage/Menus.vsct +++ b/src/VisualStudio/ProjectPackage/Menus.vsct @@ -435,6 +435,24 @@ Convert to Windows Form + +