From 00f78420d8f54bc57df1aaba91ccebc1de1fd4d0 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Wed, 9 Mar 2016 08:50:51 -0500 Subject: [PATCH 01/15] WndPlayground: Changed the field into a TextArea and made it bigger --- JSONItem_MTC Harness/WndPlayground.xojo_window | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/JSONItem_MTC Harness/WndPlayground.xojo_window b/JSONItem_MTC Harness/WndPlayground.xojo_window index 3b93773..b6013de 100644 --- a/JSONItem_MTC Harness/WndPlayground.xojo_window +++ b/JSONItem_MTC Harness/WndPlayground.xojo_window @@ -135,7 +135,7 @@ Begin Window WndPlayground Visible = True Width = 132 End - Begin TextField fldJSON + Begin TextArea fldJSON AcceptTabs = False Alignment = 0 AutoDeactivate = True @@ -143,26 +143,31 @@ Begin Window WndPlayground BackColor = &cFFFFFF00 Bold = False Border = True - CueText = "" DataField = "" DataSource = "" Enabled = True Format = "" - Height = 22 + Height = 40 HelpTag = "" + HideSelection = True Index = -2147483648 Italic = False Left = 20 LimitText = 0 + LineHeight = 0.0 + LineSpacing = 1.0 LockBottom = False LockedInPosition= False LockLeft = True LockRight = False LockTop = True Mask = "" - Password = False + Multiline = True ReadOnly = False Scope = 0 + ScrollbarHorizontal= False + ScrollbarVertical= True + Styled = False TabIndex = 4 TabPanelIndex = 0 TabStop = True @@ -325,7 +330,6 @@ Begin Window WndPlayground Selectable = False TabIndex = 8 TabPanelIndex = 0 - TabStop = True Text = "JSONItem" TextAlign = 0 TextColor = &c00000000 @@ -360,7 +364,6 @@ Begin Window WndPlayground Selectable = False TabIndex = 9 TabPanelIndex = 0 - TabStop = True Text = "JSONItem_MTC" TextAlign = 0 TextColor = &c00000000 @@ -426,7 +429,6 @@ Begin Window WndPlayground Selectable = False TabIndex = 11 TabPanelIndex = 0 - TabStop = True Text = "Encode Unicode:" TextAlign = 0 TextColor = &c00000000 From 963ae6e1ae92b28bd54ff14ebbe67cedccf3a780 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Thu, 28 Apr 2016 16:00:07 -0400 Subject: [PATCH 02/15] Added Operator_Subscript so it can be used as an array to assign values --- JSONItem_MTC.xojo_xml_code | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/JSONItem_MTC.xojo_xml_code b/JSONItem_MTC.xojo_xml_code index f2a0f78..59e53bc 100644 --- a/JSONItem_MTC.xojo_xml_code +++ b/JSONItem_MTC.xojo_xml_code @@ -1,8 +1,8 @@ - + JSONItem_MTC - 0 + 1447604198 1 1 0 @@ -2206,6 +2206,23 @@ Boolean + + Operator_Subscript + + 1 + + 134217984 + Sub Operator_Subscript(index As Integer, Assigns value As Variant) + self.Value( index ) = value + End Sub + + 134217984 + + 0 + 0 + index As Integer, Assigns value As Variant + + Legal From 7563a0fc99f66a737de9be7f261049ec187678a4 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Fri, 29 Apr 2016 16:54:08 -0400 Subject: [PATCH 03/15] JSONItem_MTC: Removed pragmas as they don't make much difference anyway --- JSONItem_MTC.xojo_xml_code | 49 +------------------------------------- 1 file changed, 1 insertion(+), 48 deletions(-) diff --git a/JSONItem_MTC.xojo_xml_code b/JSONItem_MTC.xojo_xml_code index 59e53bc..769f454 100644 --- a/JSONItem_MTC.xojo_xml_code +++ b/JSONItem_MTC.xojo_xml_code @@ -2,7 +2,7 @@ JSONItem_MTC - 1447604198 + 0 1 1 0 @@ -207,13 +207,6 @@ 134217984 Function DecodeString(inMB As MemoryBlock, ByRef pos As Integer, current As JSONItem_MTC, outMB As MemoryBlock) As String - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #pragma StackOverflowChecking false - #endif - dim lastPos as integer = inMB.Size - 1 if pos > lastPos then raise new JSONException( "Missing """, 7, pos + 1 ) @@ -443,13 +436,6 @@ 134217984 Function DecodeValue(inMB As MemoryBlock, ByRef pos As Integer, current As JSONItem_MTC, outMB As MemoryBlock) As Variant - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #pragma StackOverflowChecking false - #endif - static trueValue as Int32 if trueValue = 0 then dim mb as MemoryBlock = "true" @@ -624,13 +610,6 @@ // &hfeff // &hfff0 - &hffff - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #pragma StackOverflowChecking false - #endif - static alwaysEncode() as integer = Array( _ 127, &hAD, _ &h600, &h601, &h602, &h603, &h604, _ @@ -838,12 +817,6 @@ 134217984 Sub EncodeValue(value As Variant, settings As JSONItem_MTC, level As Integer, outMB As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock) - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #endif - if value IsA JSONItem_MTC then JSONItem_MTC( value ).Serialize( outMB, outIndex, settings, level, inMB ) @@ -1395,12 +1368,6 @@ 134217984 Sub Serialize(outMB As MemoryBlock, ByRef outIndex As Integer, settings As JSONItem_MTC, level As Integer, inMB As MemoryBlock) - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #endif - level = level + 1 dim notCompact as boolean = not( settings.Compact ) and settings.IndentSpacing > 0 @@ -1901,13 +1868,6 @@ 134217984 Sub LoadObject(inMB As MemoryBlock, ByRef pos As Integer, ByRef current As JSONItem_MTC, stack() As JSONItem_MTC, outMB As MemoryBlock) - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #pragma StackOverflowChecking false - #endif - dim inPtr As Ptr = inMB dim name as string @@ -1983,13 +1943,6 @@ 134217984 Sub LoadArray(inMB As MemoryBlock, ByRef pos As Integer, ByRef current As JSONItem_MTC, stack() As JSONItem_MTC, outMB As MemoryBlock) - #if not DebugBuild - #pragma BackgroundTasks false - #pragma BoundsChecking false - #pragma NilObjectChecking false - #pragma StackOverflowChecking false - #endif - dim inPtr As Ptr = inMB dim commaFound as boolean From c7c7b770e2bc8f4dc7c1373a61b357d9b340f37d Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Fri, 29 Apr 2016 17:21:26 -0400 Subject: [PATCH 04/15] Updated XojoUnit to 5.0 --- .../XojoUnit/TestFramework/Assert.xojo_code | 4 +- .../TestFramework/TestController.xojo_code | 23 ++- .../TestFramework/TestGroup.xojo_code | 143 ++++++++++++++++-- .../XojoUnit/Tests/XojoUnitTests.xojo_code | 79 ++++++++++ .../XojoUnit/XojoUnitAboutWindow.xojo_window | 1 - .../XojoUnit/XojoUnitTestWindow.xojo_window | 3 +- 6 files changed, 233 insertions(+), 20 deletions(-) diff --git a/JSONItem_MTC Harness/XojoUnit/TestFramework/Assert.xojo_code b/JSONItem_MTC Harness/XojoUnit/TestFramework/Assert.xojo_code index 333b693..08d8eb5 100644 --- a/JSONItem_MTC Harness/XojoUnit/TestFramework/Assert.xojo_code +++ b/JSONItem_MTC Harness/XojoUnit/TestFramework/Assert.xojo_code @@ -92,7 +92,7 @@ Protected Class Assert Pass() Else 'Fail(FailEqualMessage(Format(expected, "-#########.##########"), Format(actual, "-#########.##########")), message) - Fail(FailEqualMessage(expected.ToText(Xojo.Core.Locale.Current, "-#########.##########"), actual.ToText(Xojo.Core.Locale.Current, "-#########.##########")), message) + Fail(FailEqualMessage(expected.ToText(Xojo.Core.Locale.Current, "#########.##########"), actual.ToText(Xojo.Core.Locale.Current, "#########.##########")), message) End If End Sub #tag EndMethod @@ -406,7 +406,7 @@ Protected Class Assert Pass() Else 'Fail(FailEqualMessage(Format(expected, "-#########.##########"), Format(actual, "-#########.##########")), message) - Fail(FailEqualMessage(expected.ToText(Xojo.Core.Locale.Current, "-#########.##########"), actual.ToText(Xojo.Core.Locale.Current, "-#########.##########")), message) + Fail(FailEqualMessage(expected.ToText(Xojo.Core.Locale.Current, "#########.##########"), actual.ToText(Xojo.Core.Locale.Current, "#########.##########")), message) End If End Sub #tag EndMethod diff --git a/JSONItem_MTC Harness/XojoUnit/TestFramework/TestController.xojo_code b/JSONItem_MTC Harness/XojoUnit/TestFramework/TestController.xojo_code index aa563ef..0708b58 100644 --- a/JSONItem_MTC Harness/XojoUnit/TestFramework/TestController.xojo_code +++ b/JSONItem_MTC Harness/XojoUnit/TestFramework/TestController.xojo_code @@ -222,6 +222,7 @@ Protected Class TestController #tag Method, Flags = &h0 Sub Start() RunTestGroups + Call RunTestCount // Updates all the counts End Sub #tag EndMethod @@ -293,6 +294,10 @@ Protected Class TestController Private mFailedCount As Integer #tag EndProperty + #tag Property, Flags = &h21 + Private mNotImplementedCount As Integer + #tag EndProperty + #tag Property, Flags = &h21 Private mPassedCount As Integer #tag EndProperty @@ -309,6 +314,15 @@ Protected Class TestController Private mTimer As Double #tag EndProperty + #tag ComputedProperty, Flags = &h0 + #tag Getter + Get + Return mNotImplementedCount + End Get + #tag EndGetter + NotImplementedCount As Integer + #tag EndComputedProperty + #tag ComputedProperty, Flags = &h0 #tag Getter Get @@ -339,6 +353,7 @@ Protected Class TestController mPassedCount = 0 mFailedCount = 0 mSkippedCount = 0 + mNotImplementedCount = 0 Dim totalCount As Integer @@ -348,6 +363,7 @@ Protected Class TestController mPassedCount = mPassedCount + tg.PassedTestCount mFailedCount = mFailedCount + tg.FailedTestCount mSkippedCount = mSkippedCount + tg.SkippedTestCount + mNotImplementedCount = mNotImplementedCount + tg.NotImplementedCount Next Return totalCount @@ -369,7 +385,7 @@ Protected Class TestController #tag Constant, Name = kHasDotComment, Type = String, Dynamic = False, Default = \"(\?#HasDot)", Scope = Private, CompatibilityFlags = (TargetConsole and (Target32Bit or Target64Bit)) or (TargetWeb and (Target32Bit or Target64Bit)) or (TargetDesktop and (Target32Bit or Target64Bit)) #tag EndConstant - #tag Constant, Name = XojoUnitVersion, Type = Text, Dynamic = False, Default = \"4.6", Scope = Public + #tag Constant, Name = XojoUnitVersion, Type = Text, Dynamic = False, Default = \"5.0", Scope = Public #tag EndConstant @@ -414,6 +430,11 @@ Protected Class TestController Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="PassedCount" Group="Behavior" diff --git a/JSONItem_MTC Harness/XojoUnit/TestFramework/TestGroup.xojo_code b/JSONItem_MTC Harness/XojoUnit/TestFramework/TestGroup.xojo_code index 43474b7..b00b753 100644 --- a/JSONItem_MTC Harness/XojoUnit/TestFramework/TestGroup.xojo_code +++ b/JSONItem_MTC Harness/XojoUnit/TestFramework/TestGroup.xojo_code @@ -27,6 +27,74 @@ Protected Class TestGroup End Sub #tag EndMethod + #tag Method, Flags = &h1 + Protected Sub Constructor(fromGroup As TestGroup) + // + // Clone from another group + // + // Only take the super's properties + // + + Static props() As Xojo.Introspection.PropertyInfo + If props.Ubound = -1 Then + Dim ti As Xojo.Introspection.TypeInfo + ti = Xojo.Introspection.GetType(Self) + While ti.BaseType IsA Object And Not (ti Is ti.BaseType) + ti = ti.BaseType + Wend + props = ti.Properties + End If + + // + // Since computed properties can have side effects, do them first + // + Dim doComputed As Boolean = False // Will be flipped in the loop + + Do + doComputed = Not doComputed + + For Each prop As Xojo.Introspection.PropertyInfo In props + If prop.IsComputed <> doComputed Then + Continue For prop + End If + + If Not prop.CanRead Or Not prop.CanWrite Then + Continue For prop + End If + + Dim fromValue As Auto = prop.Value(fromGroup) + Dim propName As Text = prop.PropertyType.Name + + // + // Handle arrays specially + // + If propName.Right(2) = "()" Then + Dim toArr() As Object = prop.Value(Self) + Dim fromArr() As Object = fromValue + + For i As Integer = 0 To fromArr.Ubound + toArr.Append(fromArr(i)) + Next i + Else + prop.Value(Self) = fromValue + End If + Next prop + + Loop Until doComputed = False + + IsClone = True + RaiseEvent Setup + End Sub + #tag EndMethod + + #tag Method, Flags = &h21 + Private Sub Destructor() + If IsClone Then + RaiseEvent TearDown + End If + End Sub + #tag EndMethod + #tag Method, Flags = &h21 Private Sub EndTimer() Dim elapsed As Double @@ -85,21 +153,36 @@ Protected Class TestGroup #tag Method, Flags = &h21 Private Sub RunTests() + Dim myInfo As Xojo.Introspection.TypeInfo = Xojo.Introspection.GetType(Self) + Dim constructors() As Xojo.Introspection.ConstructorInfo = myInfo.Constructors + Dim useConstructor As Xojo.Introspection.ConstructorInfo + For Each c As Xojo.Introspection.ConstructorInfo In constructors + If c.Parameters.Ubound = 0 Then + useConstructor = c + Exit For c + End If + Next c + + Dim constructorParams() As Auto + constructorParams.Append Self + For Each result As TestResult In mResults If Not result.IncludeMethod Then result.Result = Result.Skipped Continue For result End If - Dim param() As Auto - Dim rv As Auto - Try CurrentTestResult = result Dim method As Xojo.Introspection.MethodInfo = result.MethodInfo + // + // Get a clone + // + Dim clone As TestGroup = useConstructor.Invoke(constructorParams) + StartTimer - rv = method.Invoke(Self, param) + method.Invoke(clone) EndTimer Catch e As RuntimeException @@ -107,15 +190,19 @@ Protected Class TestGroup Raise e End If - Dim eInfo As Xojo.Introspection.TypeInfo - eInfo = Xojo.Introspection.GetType(e) - - Dim errorMessage As Text - errorMessage = "A " + eInfo.FullName + " occurred and was caught." - If e.Reason <> "" Then - errorMessage = errorMessage + &u0A + "Message: " + e.Reason + If Not RaiseEvent UnhandledException(e, result.TestName) Then + + Dim eInfo As Xojo.Introspection.TypeInfo + eInfo = Xojo.Introspection.GetType(e) + + Dim errorMessage As Text + errorMessage = "A " + eInfo.FullName + " occurred and was caught." + If e.Reason <> "" Then + errorMessage = errorMessage + &u0A + "Message: " + e.Reason + End If + Assert.Fail(errorMessage) + End If - Assert.Fail(errorMessage) End Try Next @@ -135,9 +222,7 @@ Protected Class TestGroup Sub Start() If IncludeGroup Then ClearResults - RaiseEvent Setup RunTests - RaiseEvent TearDown Else ClearResults(True) // Mark tests as Skipped End If @@ -159,6 +244,10 @@ Protected Class TestGroup Event TearDown() #tag EndHook + #tag Hook, Flags = &h0 + Event UnhandledException(err As RuntimeException, methodName As Text) As Boolean + #tag EndHook + #tag ComputedProperty, Flags = &h1 #tag Getter @@ -211,6 +300,10 @@ Protected Class TestGroup IncludeGroup As Boolean = True #tag EndProperty + #tag Property, Flags = &h21 + Private IsClone As Boolean + #tag EndProperty + #tag Property, Flags = &h21 Private mAssert As Assert #tag EndProperty @@ -227,6 +320,23 @@ Protected Class TestGroup Name As Text #tag EndProperty + #tag ComputedProperty, Flags = &h0 + #tag Getter + Get + Dim testCount As Integer + + For Each tr As TestResult In mResults + If tr.Result = TestResult.NotImplemented Then + testCount = testCount + 1 + End If + Next + + Return testCount + End Get + #tag EndGetter + NotImplementedCount As Integer + #tag EndComputedProperty + #tag ComputedProperty, Flags = &h0 #tag Getter Get @@ -329,6 +439,11 @@ Protected Class TestGroup Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="PassedTestCount" Group="Behavior" diff --git a/JSONItem_MTC Harness/XojoUnit/Tests/XojoUnitTests.xojo_code b/JSONItem_MTC Harness/XojoUnit/Tests/XojoUnitTests.xojo_code index f2a04f6..42fcb06 100644 --- a/JSONItem_MTC Harness/XojoUnit/Tests/XojoUnitTests.xojo_code +++ b/JSONItem_MTC Harness/XojoUnit/Tests/XojoUnitTests.xojo_code @@ -1,6 +1,34 @@ #tag Class Protected Class XojoUnitTests Inherits TestGroup + #tag Event + Sub Setup() + Prop2 = Prop2 + 1 + + End Sub + #tag EndEvent + + #tag Event + Sub TearDown() + Prop2 = Prop2 - 1 + + End Sub + #tag EndEvent + + #tag Event + Function UnhandledException(err As RuntimeException, methodName As Text) As Boolean + #pragma unused err + + Const kMethodName As Text = "UnhandledException" + + If methodName.Length >= kMethodName.Length And methodName.Left(kMethodName.Length) = kMethodName Then + Assert.Pass("Exception was handled") + Return True + End If + End Function + #tag EndEvent + + #tag Method, Flags = &h0 Sub AreDifferentObjectTest() Dim d1 As Xojo.Core.Date = Xojo.Core.Date.Now @@ -356,6 +384,20 @@ Inherits TestGroup End Sub #tag EndMethod + #tag Method, Flags = &h0 + Sub CleanSlate1Test() + Assert.AreEqual(0, Prop1) + Prop1 = Prop1 + 1 + End Sub + #tag EndMethod + + #tag Method, Flags = &h0 + Sub CleanSlate2Test() + Assert.AreEqual(0, Prop1) + Prop1 = Prop1 + 1 + End Sub + #tag EndMethod + #tag Method, Flags = &h0 Sub IsFalseTest() Assert.IsFalse(False) @@ -390,6 +432,43 @@ Inherits TestGroup End Sub #tag EndMethod + #tag Method, Flags = &h0 + Sub Setup1Test() + Assert.AreEqual(1, Prop2) + + End Sub + #tag EndMethod + + #tag Method, Flags = &h0 + Sub Setup2Test() + Assert.AreEqual(1, Prop2) + + End Sub + #tag EndMethod + + #tag Method, Flags = &h0 + Sub UnhandledExceptionTest() + // + // Create an exception + // + + Dim d As Dictionary // Nil! + + #Pragma BreakOnExceptions False + call d.Value(1) + #Pragma BreakOnExceptions Default + End Sub + #tag EndMethod + + + #tag Property, Flags = &h21 + Private Prop1 As Integer + #tag EndProperty + + #tag Property, Flags = &h21 + Private Shared Prop2 As Integer + #tag EndProperty + #tag ViewBehavior #tag ViewProperty diff --git a/JSONItem_MTC Harness/XojoUnit/XojoUnitAboutWindow.xojo_window b/JSONItem_MTC Harness/XojoUnit/XojoUnitAboutWindow.xojo_window index 94b3bb7..59f7c8c 100644 --- a/JSONItem_MTC Harness/XojoUnit/XojoUnitAboutWindow.xojo_window +++ b/JSONItem_MTC Harness/XojoUnit/XojoUnitAboutWindow.xojo_window @@ -158,7 +158,6 @@ End "7 - Global Floating Window" "8 - Sheet Window" "9 - Metal Window" - "10 - Drawer Window" "11 - Modeless Dialog" #tag EndEnumValues #tag EndViewProperty diff --git a/JSONItem_MTC Harness/XojoUnit/XojoUnitTestWindow.xojo_window b/JSONItem_MTC Harness/XojoUnit/XojoUnitTestWindow.xojo_window index 5dc9167..1d317fb 100644 --- a/JSONItem_MTC Harness/XojoUnit/XojoUnitTestWindow.xojo_window +++ b/JSONItem_MTC Harness/XojoUnit/XojoUnitTestWindow.xojo_window @@ -863,7 +863,7 @@ End For Each g As TestGroup In mController.TestGroups TestGroupList.AddFolder(g.Name) TestGroupList.CellType(TestGroupList.LastIndex, 2) = Listbox.TypeCheckbox - TestGroupList.CellCheck(TestGroupList.LastIndex, 2) = True + TestGroupList.CellCheck(TestGroupList.LastIndex, 2) = g.IncludeGroup TestGroupList.RowTag(TestGroupList.LastIndex) = g Next @@ -1142,7 +1142,6 @@ End "7 - Global Floating Window" "8 - Sheet Window" "9 - Metal Window" - "10 - Drawer Window" "11 - Modeless Dialog" #tag EndEnumValues #tag EndViewProperty From 4578d3e1e3c295720f7516d48efbe13e3706814c Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 00:46:25 -0400 Subject: [PATCH 05/15] Nothingness --- .../Tests/CompareTests.xojo_code | 76 +++++++++++++++++++ .../WndPlayground.xojo_window | 1 - 2 files changed, 76 insertions(+), 1 deletion(-) diff --git a/JSONItem_MTC Harness/Tests/CompareTests.xojo_code b/JSONItem_MTC Harness/Tests/CompareTests.xojo_code index 6c5427a..85d0ee6 100644 --- a/JSONItem_MTC Harness/Tests/CompareTests.xojo_code +++ b/JSONItem_MTC Harness/Tests/CompareTests.xojo_code @@ -72,5 +72,81 @@ Inherits TestGroup #tag EndMethod + #tag ViewBehavior + #tag ViewProperty + Name="Duration" + Group="Behavior" + Type="Double" + #tag EndViewProperty + #tag ViewProperty + Name="FailedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="IncludeGroup" + Group="Behavior" + InitialValue="True" + Type="Boolean" + #tag EndViewProperty + #tag ViewProperty + Name="Index" + Visible=true + Group="ID" + InitialValue="-2147483648" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Left" + Visible=true + Group="Position" + InitialValue="0" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Name" + Visible=true + Group="ID" + Type="String" + #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="PassedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="RunTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="SkippedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Super" + Visible=true + Group="ID" + Type="String" + #tag EndViewProperty + #tag ViewProperty + Name="TestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Top" + Visible=true + Group="Position" + InitialValue="0" + Type="Integer" + #tag EndViewProperty + #tag EndViewBehavior End Class #tag EndClass diff --git a/JSONItem_MTC Harness/WndPlayground.xojo_window b/JSONItem_MTC Harness/WndPlayground.xojo_window index b6013de..94feebb 100644 --- a/JSONItem_MTC Harness/WndPlayground.xojo_window +++ b/JSONItem_MTC Harness/WndPlayground.xojo_window @@ -882,7 +882,6 @@ End "7 - Global Floating Window" "8 - Sheet Window" "9 - Metal Window" - "10 - Drawer Window" "11 - Modeless Dialog" #tag EndEnumValues #tag EndViewProperty From 458fad46e90c39757679ce8edc83df7dda6b1c75 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 00:47:02 -0400 Subject: [PATCH 06/15] Added StressTest and reorganized tests --- .../JSONItem_MTC Harness.xojo_project | 3 +- .../Tests/DesktopTestController.xojo_code | 6 +- .../Tests/StressTests.xojo_code | 83 +++++++++++++++++++ 3 files changed, 89 insertions(+), 3 deletions(-) create mode 100644 JSONItem_MTC Harness/Tests/StressTests.xojo_code diff --git a/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project b/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project index 35e0a01..93e56ca 100644 --- a/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project +++ b/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project @@ -14,10 +14,11 @@ Class=DesktopTestController;Tests/DesktopTestController.xojo_code;&h3FC78D4E;&h1 Class=BasicTests_JSONItem;Tests/BasicTests_JSONItem.xojo_code;&h6BEECF33;&h1962C3CC;false Class=BasicTests_JSONItem_MTC;Tests/BasicTests_JSONItem_MTC.xojo_code;&h2324D4BF;&h1962C3CC;false Class=BasicTests_NewFramework;Tests/BasicTests_NewFramework.xojo_code;&h28A07FF;&h1962C3CC;false +Class=CompareTests;Tests/CompareTests.xojo_code;&h30843965;&h1962C3CC;false Class=LongTests_JSONItem_MTC;Tests/LongTests_JSONItem_MTC.xojo_code;&h513E8F7E;&h1962C3CC;false Class=JsonOrgExampleTests;Tests/JsonOrgExampleTests.xojo_code;&h260C54C7;&h1962C3CC;false +Class=StressTests;Tests/StressTests.xojo_code;&h1D5DEFFF;&h1962C3CC;false Class=XojoJSONItemTests;Tests/XojoJSONItemTests.xojo_code;&h794C237D;&h1962C3CC;false -Class=CompareTests;Tests/CompareTests.xojo_code;&h30843965;&h1962C3CC;false RawData=json_sample;Text Files/json_sample.txt;&h5E7609A1;&h0;false Module=M_Global;M_Global.xojo_code;&h3616CFFF;&h0;false Folder=Tests;XojoUnit/Tests;&h44C729E7;&h2516B04D;false diff --git a/JSONItem_MTC Harness/Tests/DesktopTestController.xojo_code b/JSONItem_MTC Harness/Tests/DesktopTestController.xojo_code index 603ff1c..6663666 100644 --- a/JSONItem_MTC Harness/Tests/DesktopTestController.xojo_code +++ b/JSONItem_MTC Harness/Tests/DesktopTestController.xojo_code @@ -9,13 +9,15 @@ Inherits TestController 'group = New XojoUnitTests(Self, "Assertion") 'group = New XojoUnitFailTests(Self, "Fail Tests") + group = new CompareTests( Self, "Compare JSONItem_MTC to JSONItem" ) group = New BasicTests_JSONItem(Self, "Native JSONItem Tests") group = New BasicTests_JSONItem_MTC(Self, "Basic JSONItem_MTC Tests") group = new BasicTests_NewFramework( Self, "Basic New Framework Tests" ) - group = new LongTests_JSONItem_MTC( self, "Long JSONItem_MTC Tests" ) group = New JsonOrgExampleTests(Self, "Example Documents from json.org/example") - group = new CompareTests( Self, "Compare JSONItem_MTC to JSONItem" ) + group = new LongTests_JSONItem_MTC( self, "Long JSONItem_MTC Tests" ) + group = New StressTests(Self, "Stress Tests") group = new XojoJSONItemTests( self, "Xojo's Unit Tests" ) + End Sub #tag EndEvent diff --git a/JSONItem_MTC Harness/Tests/StressTests.xojo_code b/JSONItem_MTC Harness/Tests/StressTests.xojo_code new file mode 100644 index 0000000..e930229 --- /dev/null +++ b/JSONItem_MTC Harness/Tests/StressTests.xojo_code @@ -0,0 +1,83 @@ +#tag Class +Protected Class StressTests +Inherits TestGroup + #tag Method, Flags = &h21 + Private Sub BigStringTest() + const kSize = 700 * 1024 * 1024 + dim halfSize as integer = ( kSize \ 2 ) + 1 + + dim s as string = "0123456789" + + while s.LenB < halfSize + s = s + s + wend + + if s.LenB < kSize then + s = s + s.Mid( 1, kSize - s.LenB ) + end if + + dim length as integer = s.LenB + #pragma unused length + + dim j as new JSONItem_MTC + j.Compact = true + + try + j.Append s + Assert.Pass + catch err as OutOfMemoryException + Assert.Fail "Ran out of memory" + return + end try + + dim jString as string + try + jString = j.ToString + Assert.AreEqual 0, StrComp( "[""" + s + """]", jString, 0 ), "Strings don't match" + catch err as OutOfMemoryException + Assert.Fail "Ran out of memory creating string" + return + end try + + return + End Sub + #tag EndMethod + + + #tag ViewBehavior + #tag ViewProperty + Name="Index" + Visible=true + Group="ID" + InitialValue="-2147483648" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Left" + Visible=true + Group="Position" + InitialValue="0" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="Name" + Visible=true + Group="ID" + Type="String" + #tag EndViewProperty + #tag ViewProperty + Name="Super" + Visible=true + Group="ID" + Type="String" + #tag EndViewProperty + #tag ViewProperty + Name="Top" + Visible=true + Group="Position" + InitialValue="0" + Type="Integer" + #tag EndViewProperty + #tag EndViewBehavior +End Class +#tag EndClass From 5e0405781109c3c8f9be0eb0f9c81c94d88a705f Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 00:56:58 -0400 Subject: [PATCH 07/15] New version of Xojo --- JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project b/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project index 93e56ca..61c2ed5 100644 --- a/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project +++ b/JSONItem_MTC Harness/JSONItem_MTC Harness.xojo_project @@ -1,5 +1,5 @@ Type=Desktop -RBProjectVersion=2015.031 +RBProjectVersion=2016.011 MinIDEVersion=20070100 Class=App;App.xojo_code;&h14C611D3;&h0;false MenuBar=MenuBar1;MenuBar1.xojo_menu;&h18745784;&h0;false From 6dd30c2498ce2a517e14c1e4a4ab98b894776d39 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 02:32:38 -0400 Subject: [PATCH 08/15] StressTests: Small improvement for debugging --- .../Tests/StressTests.xojo_code | 44 ++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/JSONItem_MTC Harness/Tests/StressTests.xojo_code b/JSONItem_MTC Harness/Tests/StressTests.xojo_code index e930229..9b6ca37 100644 --- a/JSONItem_MTC Harness/Tests/StressTests.xojo_code +++ b/JSONItem_MTC Harness/Tests/StressTests.xojo_code @@ -30,10 +30,11 @@ Inherits TestGroup return end try + dim expect as string = "[""" + s + """]" dim jString as string try jString = j.ToString - Assert.AreEqual 0, StrComp( "[""" + s + """]", jString, 0 ), "Strings don't match" + Assert.AreEqual 0, StrComp( expect, jString, 0 ), "Strings don't match" catch err as OutOfMemoryException Assert.Fail "Ran out of memory creating string" return @@ -45,6 +46,22 @@ Inherits TestGroup #tag ViewBehavior + #tag ViewProperty + Name="Duration" + Group="Behavior" + Type="Double" + #tag EndViewProperty + #tag ViewProperty + Name="FailedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="IncludeGroup" + Group="Behavior" + InitialValue="True" + Type="Boolean" + #tag EndViewProperty #tag ViewProperty Name="Index" Visible=true @@ -65,12 +82,37 @@ Inherits TestGroup Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="PassedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="RunTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty + #tag ViewProperty + Name="SkippedTestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="Super" Visible=true Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="TestCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="Top" Visible=true From 23950a970073f721479c5cb1fc861dd14e38fa9d Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 02:56:38 -0400 Subject: [PATCH 09/15] StressTests: More tests, smaller size --- JSONItem_MTC Harness/Tests/StressTests.xojo_code | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/JSONItem_MTC Harness/Tests/StressTests.xojo_code b/JSONItem_MTC Harness/Tests/StressTests.xojo_code index 9b6ca37..802d047 100644 --- a/JSONItem_MTC Harness/Tests/StressTests.xojo_code +++ b/JSONItem_MTC Harness/Tests/StressTests.xojo_code @@ -3,7 +3,7 @@ Protected Class StressTests Inherits TestGroup #tag Method, Flags = &h21 Private Sub BigStringTest() - const kSize = 700 * 1024 * 1024 + const kSize = 500 * 1024 * 1024 dim halfSize as integer = ( kSize \ 2 ) + 1 dim s as string = "0123456789" @@ -34,12 +34,16 @@ Inherits TestGroup dim jString as string try jString = j.ToString + Assert.AreEqual expect.LenB, jString.LenB, "Lengths don't match" Assert.AreEqual 0, StrComp( expect, jString, 0 ), "Strings don't match" catch err as OutOfMemoryException Assert.Fail "Ran out of memory creating string" return end try + Assert.IsTrue Encodings.UTF8.IsValidData( jString ), "Not valid UTF8" + Assert.IsTrue jString.Encoding = Encodings.UTF8, "Encoding isn't UTF8" + return End Sub #tag EndMethod From a32e46905c014363a776484369589ee8be766aca Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 02:57:22 -0400 Subject: [PATCH 10/15] JSONItem_MTC: Split up the outbound MemoryBlocks into smaller chunks --- JSONItem_MTC.xojo_xml_code | 202 ++++++++++++++++++++++--------------- 1 file changed, 120 insertions(+), 82 deletions(-) diff --git a/JSONItem_MTC.xojo_xml_code b/JSONItem_MTC.xojo_xml_code index 769f454..556ed49 100644 --- a/JSONItem_MTC.xojo_xml_code +++ b/JSONItem_MTC.xojo_xml_code @@ -594,7 +594,7 @@ 1 134217984 - Sub EncodeString(s As String, settings As JSONItem_MTC, outMB As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock) + Sub EncodeString(s As String, settings As JSONItem_MTC, outMBs() As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock) // Encodes a string for output during ToString. // Honors the EncodeUnicode setting, but some characters must ALWAYS be encoded for // Javascript compatibility. These are @@ -624,12 +624,10 @@ &hFFFA, &hFFFB, &hFFFC, &hFFFD, &hFFFE, &hFFFF _ ) + dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) dim outSize as integer = outMB.Size if outIndex > ( outSize - 12 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 12 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) end if dim outPtr as Ptr = outMB @@ -666,10 +664,8 @@ end if if outIndex > ( outSize - 12 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 12 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB end if @@ -791,10 +787,7 @@ loop if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) outPtr = outMB end if @@ -807,7 +800,7 @@ 33 0 - s As String, settings As JSONItem_MTC, outMB As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock + s As String, settings As JSONItem_MTC, outMBs() As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock @@ -816,22 +809,22 @@ 1 134217984 - Sub EncodeValue(value As Variant, settings As JSONItem_MTC, level As Integer, outMB As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock) + Sub EncodeValue(value As Variant, settings As JSONItem_MTC, level As Integer, outMBs() As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock) if value IsA JSONItem_MTC then - JSONItem_MTC( value ).Serialize( outMB, outIndex, settings, level, inMB ) + JSONItem_MTC( value ).Serialize( outMBs, outIndex, settings, level, inMB ) elseif value IsA Dictionary then dim child as JSONItem_MTC = Dictionary( value ) - child.Serialize( outMB, outIndex, settings, level, inMB ) + child.Serialize( outMBs, outIndex, settings, level, inMB ) elseif value.Type = Variant.TypeString or value.Type = Variant.TypeCString or _ value.Type = Variant.TypePString then - EncodeString( value.StringValue, settings, outMB, outIndex, inMB ) + EncodeString( value.StringValue, settings, outMBs, outIndex, inMB ) elseif value.Type = Variant.TypeText then dim t as Text = value.TextValue dim s as string = t - EncodeString( s, settings, outMB, outIndex, inMB ) + EncodeString( s, settings, outMBs, outIndex, inMB ) else @@ -863,12 +856,11 @@ insert = value.StringValue.Lowercase end if + dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) dim outSize as integer = outMB.Size if outIndex > ( outSize - insert.LenB ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - insert.LenB ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size end if outMB.StringValue( outIndex, insert.LenB ) = insert @@ -881,7 +873,7 @@ 33 0 - value As Variant, settings As JSONItem_MTC, level As Integer, outMB As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock + value As Variant, settings As JSONItem_MTC, level As Integer, outMBs() As MemoryBlock, ByRef outIndex As Integer, inMB As MemoryBlock @@ -1341,15 +1333,36 @@ 134217984 Function Serialize(data As JSONItem_MTC) As String - dim outMB as new MemoryBlock( 2048 ) + dim outMB as new MemoryBlock( kOutMBSize ) + dim outMBs() as MemoryBlock + outMBs.Append outMB dim outIndex as integer - dim inMB as new MemoryBlock( 2048 ) + dim inMB as new MemoryBlock( kInMBSize ) - data.Serialize( outMB, outIndex, self, 0, inMB) + data.Serialize( outMBs, outIndex, self, 0, inMB) + outMBs( outMBs.Ubound ).Size = outIndex - dim r as string = outMB.StringValue( 0, outIndex ) - r = r.DefineEncoding( Encodings.UTF8 ) + dim joiner() as string + redim joiner( outMBs.Ubound) + + for i as integer = 0 to outMBs.Ubound + #if DebugBuild + if i = 1 then + i = i // A place to break + end if + #endif + + outMB = outMBs( i ) + outMBs( i ) = nil + dim s as string = outMB + outMB = nil + + s = s.DefineEncoding( Encodings.UTF8 ) + joiner( i ) = s + next i + + dim r as string = join( joiner, "" ) return r End Function @@ -1367,7 +1380,9 @@ 1 134217984 - Sub Serialize(outMB As MemoryBlock, ByRef outIndex As Integer, settings As JSONItem_MTC, level As Integer, inMB As MemoryBlock) + Sub Serialize(outMBs() As MemoryBlock, ByRef outIndex As Integer, settings As JSONItem_MTC, level As Integer, inMB As MemoryBlock) + dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) + level = level + 1 dim notCompact as boolean = not( settings.Compact ) and settings.IndentSpacing > 0 @@ -1387,10 +1402,8 @@ // dim outSize as integer = outMB.Size if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size end if dim outPtr as Ptr = outMB @@ -1412,12 +1425,10 @@ for i as integer = 0 to ArrayValues.Ubound if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize - end if + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB + end if if notCompact then outMB.StringValue( outIndex, indenter.LenB ) = indenter @@ -1425,14 +1436,13 @@ end if dim value as variant = ArrayValues( i ) - EncodeValue( value, settings, level, outMB, outIndex, inMB ) + EncodeValue( value, settings, level, outMBs, outIndex, inMB ) + outMB = outMBs( outMBs.Ubound ) outSize = outMB.Size if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size end if outPtr = outMB @@ -1451,21 +1461,17 @@ next i if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize - end if + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB + end if if notCompact then if outIndex > ( outSize - indenter.LenB ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - indenter.LenB ) - outMB.Size = outSize - end if + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB + end if outMB.StringValue( outIndex, indenter.LenB - settings.IndentSpacing ) = indenter.LeftB( indenter.LenB - indentSpacing ) outIndex = outIndex + ( indenter.LenB - settings.IndentSpacing ) @@ -1473,12 +1479,10 @@ end if if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize - end if + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB + end if outPtr.Byte( outIndex ) = kCloseSquareBracket outIndex = outIndex + 1 @@ -1503,10 +1507,8 @@ dim keys() as variant = d.Keys for i as integer = 0 to keys.Ubound if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB end if @@ -1517,14 +1519,13 @@ dim key as variant = keys( i ) dim name as string = KeyToName( key ) - EncodeString( name, settings, outMB, outIndex, inMB ) + EncodeString( name, settings, outMBs, outIndex, inMB ) + outMB = outMBs( outMBs.Ubound ) outSize = outMB.Size if outIndex > ( outSize - 1 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size end if outPtr = outMB @@ -1532,14 +1533,13 @@ outIndex = outIndex + 1 dim value as variant = d.Value( key ) - EncodeValue( value, settings, level, outMB, outIndex, inMB ) + EncodeValue( value, settings, level, outMBs, outIndex, inMB ) + outMB = outMBs( outMBs.Ubound ) outSize = outMB.Size if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size end if outPtr = outMB @@ -1559,10 +1559,8 @@ if notCompact then if outIndex > ( outSize - indenter.LenB ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - indenter.LenB ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB end if @@ -1572,10 +1570,8 @@ end if if outIndex > ( outSize - 1024 ) then - do - outSize = outSize + outSize - loop until outIndex <= ( outSize - 1024 ) - outMB.Size = outSize + outMB = AppendOutMB( outMBs, outIndex ) + outSize = outMB.Size outPtr = outMB end if @@ -1590,7 +1586,7 @@ 1 0 - outMB As MemoryBlock, ByRef outIndex As Integer, settings As JSONItem_MTC, level As Integer, inMB As MemoryBlock + outMBs() As MemoryBlock, ByRef outIndex As Integer, settings As JSONItem_MTC, level As Integer, inMB As MemoryBlock @@ -2176,6 +2172,30 @@ index As Integer, Assigns value As Variant + + AppendOutMB + + 1 + + 134217984 + Function AppendOutMB(outMBs() As MemoryBlock, ByRef outIndex As Integer) As MemoryBlock + dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) + outMB.Size = outIndex + + outMB = new MemoryBlock( kOutMBSize ) + outMBs.Append outMB + outIndex = 0 + + return outMB + End Function + + 134217984 + + 33 + 0 + outMBs() As MemoryBlock, ByRef outIndex As Integer + MemoryBlock + Legal @@ -2778,6 +2798,24 @@ -0.0############## 0 + + kInMBSize + + 1 + 134217984 + 2 + 2048 + 33 + + + kOutMBSize + + 1 + 134217984 + 2 + 2097152 + 33 + 134217984 EncodeType From 6abb59a88ae37b156ed38712014f728eaf3ce3dc Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sat, 30 Apr 2016 03:06:24 -0400 Subject: [PATCH 11/15] StressTests: Stop testing for valid UTF8 data --- JSONItem_MTC Harness/Tests/StressTests.xojo_code | 1 - 1 file changed, 1 deletion(-) diff --git a/JSONItem_MTC Harness/Tests/StressTests.xojo_code b/JSONItem_MTC Harness/Tests/StressTests.xojo_code index 802d047..1a77bfc 100644 --- a/JSONItem_MTC Harness/Tests/StressTests.xojo_code +++ b/JSONItem_MTC Harness/Tests/StressTests.xojo_code @@ -41,7 +41,6 @@ Inherits TestGroup return end try - Assert.IsTrue Encodings.UTF8.IsValidData( jString ), "Not valid UTF8" Assert.IsTrue jString.Encoding = Encodings.UTF8, "Encoding isn't UTF8" return From b5e39c3c638aecdc8983d12f6c4c76692deb2cfc Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sun, 1 May 2016 09:00:06 -0400 Subject: [PATCH 12/15] JSONItem_MTC: More efficient memory handling when serializing --- JSONItem_MTC.xojo_xml_code | 61 ++++++++++++++++++++++++++++---------- 1 file changed, 45 insertions(+), 16 deletions(-) diff --git a/JSONItem_MTC.xojo_xml_code b/JSONItem_MTC.xojo_xml_code index 556ed49..0c4d4fe 100644 --- a/JSONItem_MTC.xojo_xml_code +++ b/JSONItem_MTC.xojo_xml_code @@ -624,9 +624,11 @@ &hFFFA, &hFFFB, &hFFFC, &hFFFD, &hFFFE, &hFFFF _ ) + const kByteBuffer = 13 // Most an encoding can use plus the trailing quote + dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) dim outSize as integer = outMB.Size - if outIndex > ( outSize - 12 ) then + if outIndex > ( outSize - kByteBuffer ) then outMB = AppendOutMB( outMBs, outIndex ) end if dim outPtr as Ptr = outMB @@ -663,7 +665,7 @@ exit do end if - if outIndex > ( outSize - 12 ) then + if outIndex > ( outSize - kByteBuffer ) then outMB = AppendOutMB( outMBs, outIndex ) outSize = outMB.Size outPtr = outMB @@ -786,11 +788,6 @@ loop - if outIndex > ( outSize - 1024 ) then - outMB = AppendOutMB( outMBs, outIndex ) - outPtr = outMB - end if - outPtr.Byte( outIndex ) = kQuote outIndex = outIndex + 1 @@ -856,15 +853,15 @@ insert = value.StringValue.Lowercase end if + dim insertLen as integer = insert.LenB dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) dim outSize as integer = outMB.Size - if outIndex > ( outSize - insert.LenB ) then + if outIndex > ( outSize - insertLen ) then outMB = AppendOutMB( outMBs, outIndex ) - outSize = outMB.Size end if - outMB.StringValue( outIndex, insert.LenB ) = insert - outIndex = outIndex + insert.LenB + outMB.StringValue( outIndex, insertLen ) = insert + outIndex = outIndex + insertLen end if End Sub @@ -1333,7 +1330,12 @@ 134217984 Function Serialize(data As JSONItem_MTC) As String - dim outMB as new MemoryBlock( kOutMBSize ) + // + // Most JSON will be rather small, so we'll start with a small initial block + + const kInitialMBSize = 10 * 1024 + + dim outMB as new MemoryBlock( kInitialMBSize ) dim outMBs() as MemoryBlock outMBs.Append outMB dim outIndex as integer @@ -1341,7 +1343,11 @@ dim inMB as new MemoryBlock( kInMBSize ) data.Serialize( outMBs, outIndex, self, 0, inMB) - outMBs( outMBs.Ubound ).Size = outIndex + + // + // We know exactly how long the last MemoryBlock's data is + // in outIndex + // dim joiner() as string redim joiner( outMBs.Ubound) @@ -1355,9 +1361,33 @@ outMB = outMBs( i ) outMBs( i ) = nil - dim s as string = outMB + + dim s as string + if i = outMBs.Ubound then + + s = outMB.StringValue( 0, outIndex ) + + else + // + // Scan for the final null + // + dim lastBytePos as integer = outMB.Size - 1 + dim p as Ptr = outMB + for bytePos as integer = lastBytePos downto 0 + if p.Byte( bytePos ) <> 0 then + s = outMB.StringValue( 0, bytePos + 1 ) + exit for bytePos + end if + next bytePos + outMB = nil + end if + + if s = "" then + raise new JSONException( "Couldn't find non-null bytes in a MemoryBlock", 0 ) + end if + s = s.DefineEncoding( Encodings.UTF8 ) joiner( i ) = s next i @@ -2179,8 +2209,7 @@ 134217984 Function AppendOutMB(outMBs() As MemoryBlock, ByRef outIndex As Integer) As MemoryBlock - dim outMB as MemoryBlock = outMBs( outMBs.Ubound ) - outMB.Size = outIndex + dim outMB as MemoryBlock outMB = new MemoryBlock( kOutMBSize ) outMBs.Append outMB From 8e53846cde9aaaeb8865810ad961daced86d87fc Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sun, 1 May 2016 09:47:35 -0400 Subject: [PATCH 13/15] Added more case-sensitive key tests --- .../Tests/BasicTests_JSONItem.xojo_code | 20 +++++++++++++++++++ .../Tests/BasicTests_JSONItem_MTC.xojo_code | 9 +++++++++ .../Tests/BasicTests_NewFramework.xojo_code | 20 ++++++++++++++----- 3 files changed, 44 insertions(+), 5 deletions(-) diff --git a/JSONItem_MTC Harness/Tests/BasicTests_JSONItem.xojo_code b/JSONItem_MTC Harness/Tests/BasicTests_JSONItem.xojo_code index 7dec735..d3e7dae 100644 --- a/JSONItem_MTC Harness/Tests/BasicTests_JSONItem.xojo_code +++ b/JSONItem_MTC Harness/Tests/BasicTests_JSONItem.xojo_code @@ -1,6 +1,21 @@ #tag Class Protected Class BasicTests_JSONItem Inherits TestGroup + #tag Method, Flags = &h21 + Private Sub CaseSensitiveKeyTest() + dim j as new JSONItem + j.Value( "a" ) = 1 + j.Value( "A" ) = 2 + + Assert.AreEqual( 2, j.Count, "Should be 2 objects" ) + Assert.AreEqual( 1, j.Value( "a" ).IntegerValue ) + + j.Value( "Man" ) = 3 + Assert.IsFalse( j.HasName( "MaT" ), "Keys with same Base64 encoding return incorrect results" ) + + End Sub + #tag EndMethod + #tag Method, Flags = &h21 Private Sub IllegalStringTest() dim j as JSONItem @@ -227,6 +242,11 @@ Inherits TestGroup Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="PassedTestCount" Group="Behavior" diff --git a/JSONItem_MTC Harness/Tests/BasicTests_JSONItem_MTC.xojo_code b/JSONItem_MTC Harness/Tests/BasicTests_JSONItem_MTC.xojo_code index 224e93f..afe8357 100644 --- a/JSONItem_MTC Harness/Tests/BasicTests_JSONItem_MTC.xojo_code +++ b/JSONItem_MTC Harness/Tests/BasicTests_JSONItem_MTC.xojo_code @@ -72,6 +72,10 @@ Inherits TestGroup Assert.AreEqual( 2, j.Count, "Should be 2 objects" ) Assert.AreEqual( 1, j.Value( "a" ).IntegerValue ) + + j.Value( "Man" ) = 3 + Assert.IsFalse( j.HasName( "MaT" ), "Keys with same Base64 encoding return incorrect results" ) + End Sub #tag EndMethod @@ -647,6 +651,11 @@ Inherits TestGroup Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="PassedTestCount" Group="Behavior" diff --git a/JSONItem_MTC Harness/Tests/BasicTests_NewFramework.xojo_code b/JSONItem_MTC Harness/Tests/BasicTests_NewFramework.xojo_code index 38cb2f8..0b0cb34 100644 --- a/JSONItem_MTC Harness/Tests/BasicTests_NewFramework.xojo_code +++ b/JSONItem_MTC Harness/Tests/BasicTests_NewFramework.xojo_code @@ -44,14 +44,15 @@ Inherits TestGroup Private Sub CaseSensitiveKeyTest() Using Xojo.Core - dim j as Dictionary = NewCaseSensitiveDictionary + dim j as Dictionary = Xojo.Data.ParseJSON( kCaseSensitiveJSON ) - j.Value( "a" ) = 1 - j.Value( "A" ) = 2 - - Assert.AreEqual( 2, j.Count, "Should be 2 objects" ) + Assert.AreEqual( 3, j.Count, "Should be 3 objects" ) dim r as integer = j.Value( "a" ) Assert.AreEqual( 1, r ) + + Assert.IsFalse( j.HasKey( "MaT" ), "Keys with same Base64 encoding return incorrect results" ) + + End Sub #tag EndMethod @@ -165,6 +166,10 @@ Inherits TestGroup #tag EndMethod + #tag Constant, Name = kCaseSensitiveJSON, Type = Text, Dynamic = False, Default = \"{\n \"a\" : 1\x2C\n \"A\" : 2\x2C\n \"Man\" : 3\n}", Scope = Private + #tag EndConstant + + #tag ViewBehavior #tag ViewProperty Name="Duration" @@ -202,6 +207,11 @@ Inherits TestGroup Group="ID" Type="String" #tag EndViewProperty + #tag ViewProperty + Name="NotImplementedCount" + Group="Behavior" + Type="Integer" + #tag EndViewProperty #tag ViewProperty Name="PassedTestCount" Group="Behavior" From 8fcd77176dc570210b0d25d97115948f92fa510c Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sun, 1 May 2016 09:48:01 -0400 Subject: [PATCH 14/15] JSONItem_MTC: Moved silly line --- JSONItem_MTC.xojo_xml_code | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/JSONItem_MTC.xojo_xml_code b/JSONItem_MTC.xojo_xml_code index 0c4d4fe..c902fa7 100644 --- a/JSONItem_MTC.xojo_xml_code +++ b/JSONItem_MTC.xojo_xml_code @@ -1380,10 +1380,10 @@ end if next bytePos - outMB = nil - end if + outMB = nil + if s = "" then raise new JSONException( "Couldn't find non-null bytes in a MemoryBlock", 0 ) end if From beab72650772212b194645f58295355b2c5e90c8 Mon Sep 17 00:00:00 2001 From: Kem Tekinay Date: Sun, 1 May 2016 09:53:51 -0400 Subject: [PATCH 15/15] Updated README --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index df274ab..8190a22 100644 --- a/README.md +++ b/README.md @@ -22,7 +22,7 @@ This class implements all the features and functions of its native twin and shou - This class has a Strict property. When set to `True`, it will strictly interpret JSON string according to JSON specs (values like `TRUE` and `+1` will be rejected), and will raise an exception rather than outputting `inf` or `nan`. -- This class will properly handle characters with code points > &hFFFF when both encoding and decoding. The native class does not. +- This class will properly handle characters with code points > &uFFFF when both encoding and decoding. The native class does not. - This class will properly reject invalid hex in a "\uNNNN" structure. @@ -30,11 +30,11 @@ This class implements all the features and functions of its native twin and shou - When loading a JSON string, this class will figure out its encoding and even strip any BOM that might prefix it. -- As of Xojo 2014r21, ToString and Load are significantly faster in this class than the native version. +- As of Xojo 2016r1, ToString and Load are significantly faster in this class than the native version. ##License -This class was created by Kem Tekinay, MacTechnologies Consulting (ktekinay@mactechnologies dot com). It is copyright ©2014 by Kem Tekinay, all rights reserved. +This class was created by Kem Tekinay, MacTechnologies Consulting (ktekinay@mactechnologies dot com). It is copyright ©2016 by Kem Tekinay, all rights reserved. This project is distributed AS-IS and no warranty of fitness for any particular purpose is expressed or implied. The author disavows any responsibility for bad design, poor execution, or any other faults.