ADDED tests/natools-reference_tests-pools.adb Index: tests/natools-reference_tests-pools.adb ================================================================== --- tests/natools-reference_tests-pools.adb +++ tests/natools-reference_tests-pools.adb @@ -0,0 +1,338 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +package body Natools.Reference_Tests.Pools is + + use type Ref_Pools.Pool_Size; + + + procedure Check_Counts + (Test : in out NT.Test; + Pool : in Ref_Pools.Pool; + Active, Initialized, Total : in Ref_Pools.Pool_Size); + + procedure Check_Order + (Test : in out NT.Test; + Pool : in out Ref_Pools.Pool); + + + ------------------------------ + -- Local Helper Subprograms -- + ------------------------------ + + procedure Check_Counts + (Test : in out NT.Test; + Pool : in Ref_Pools.Pool; + Active, Initialized, Total : in Ref_Pools.Pool_Size) + is + S : Ref_Pools.Pool_Size; + begin + S := Pool.Active_Size; + if S /= Active then + Test.Fail + ("Pool.Active_Size is" + & Ref_Pools.Pool_Size'Image (S) + & ", expected " + & Ref_Pools.Pool_Size'Image (Active)); + end if; + + S := Pool.Initialized_Size; + if S /= Initialized then + Test.Fail + ("Pool.Initialized_Size is" + & Ref_Pools.Pool_Size'Image (S) + & ", expected " + & Ref_Pools.Pool_Size'Image (Initialized)); + end if; + + S := Pool.Capacity; + if S /= Total then + Test.Fail + ("Pool.Initialized_Size is" + & Ref_Pools.Pool_Size'Image (S) + & ", expected " + & Ref_Pools.Pool_Size'Image (Total)); + end if; + end Check_Counts; + + + procedure Check_Order + (Test : in out NT.Test; + Pool : in out Ref_Pools.Pool) + is + procedure Process (Ref : in Refs.Reference); + + Rank, Last : Natural := 0; + + procedure Process (Ref : in Refs.Reference) is + begin + Rank := Rank + 1; + + if Ref.Is_Empty then + Test.Fail ("Unexpected empty reference at rank" + & Natural'Image (Rank)); + return; + end if; + + declare + Accessor : constant Refs.Accessor := Ref.Query; + begin + if Accessor.Data.Instance_Number = 0 then + Test.Fail ("Unexpected null instance number at rank" + & Natural'Image (Rank)); + elsif Last = 0 then + Last := Accessor.Data.Instance_Number; + elsif Accessor.Data.Instance_Number /= Last + 1 then + Test.Fail ("At rank" + & Natural'Image (Rank) + & ", reference to instance" + & Natural'Image (Accessor.Data.Instance_Number) + & " following reference to instance" + & Natural'Image (Last)); + Last := 0; + else + Last := Accessor.Data.Instance_Number; + end if; + end; + end Process; + begin + Pool.Unchecked_Iterate (Process'Access); + end Check_Order; + + + + ------------------------ + -- Peudo_Process Task -- + ------------------------ + + task body Pseudo_Process is + Time : Duration; + Ref : Refs.Reference; + begin + select + accept Start (Target : in Refs.Reference; Amount : in Duration) do + Time := Amount; + Ref := Target; + end Start; + or terminate; + end select; + + delay Time; + Ref.Reset; + end Pseudo_Process; + + + procedure Bounded_Start + (Process : in out Pseudo_Process; + Pool : in out Ref_Pools.Pool; + Amount : in Duration; + Test : in out NT.Test; + Expected_Instance : in Natural) + is + Ref : Refs.Reference; + begin + Pool.Get (Factory'Access, Ref); + + if Ref.Query.Data.Instance_Number /= Expected_Instance then + Test.Fail ("Got reference to instance" + & Natural'Image (Ref.Query.Data.Instance_Number) + & ", expected" + & Natural'Image (Expected_Instance)); + end if; + + Process.Start (Ref, Amount); + end Bounded_Start; + + + procedure Unbounded_Start + (Process : in out Pseudo_Process; + Pool : in out Ref_Pools.Pool; + Amount : in Duration; + Test : in out NT.Test; + Expected_Instance : in Natural) + is + Ref : Refs.Reference; + begin + Pool.Create (Factory'Access, Ref); + + if Ref.Query.Data.Instance_Number /= Expected_Instance then + Test.Fail ("Got reference to instance" + & Natural'Image (Ref.Query.Data.Instance_Number) + & ", expected" + & Natural'Image (Expected_Instance)); + end if; + + Process.Start (Ref, Amount); + end Unbounded_Start; + + + + ------------------------- + -- Complete Test Suite -- + ------------------------- + + procedure All_Tests (Report : in out NT.Reporter'Class) is + begin + Bounded_Pool (Report); + Static_Pool (Report); + Unbounded_Pool (Report); + end All_Tests; + + + + ----------------------- + -- Inidividual Tests -- + ----------------------- + + procedure Bounded_Pool (Report : in out NT.Reporter'Class) is + Test : NT.Test := Report.Item ("Bounded pool typical usage"); + begin + declare + Test_Length : constant Duration := 0.5; + Ref_Pool : Ref_Pools.Pool; + Workers : array (1 .. 4) of Pseudo_Process; + begin + -- Timeline (in Test_Length/10): <--------> + -- Task using reference 1: 1111111111 + -- Task using reference 2: 2222 44 + -- Task using reference 3: 3333 + + Check_Counts (Test, Ref_Pool, 0, 0, 0); + Ref_Pool.Preallocate (3); + Check_Counts (Test, Ref_Pool, 0, 0, 3); + + Bounded_Start (Workers (1), Ref_Pool, Test_Length, Test, 1); + Check_Counts (Test, Ref_Pool, 1, 1, 3); + + delay Test_Length * 0.2; + Bounded_Start (Workers (2), Ref_Pool, Test_Length * 0.4, Test, 2); + Check_Counts (Test, Ref_Pool, 2, 2, 3); + + delay Test_Length * 0.2; + Bounded_Start (Workers (3), Ref_Pool, Test_Length * 0.4, Test, 3); + Check_Counts (Test, Ref_Pool, 3, 3, 3); + + delay Test_Length * 0.1; + begin + Bounded_Start (Workers (4), Ref_Pool, Test_Length * 0.2, Test, 0); + Test.Fail ("Expected exception after filling bounded pool"); + exception + when Constraint_Error => + null; + when Error : others => + Test.Info ("At Get on full bounded pool,"); + Test.Report_Exception (Error, NT.Fail); + end; + + delay Test_Length * 0.2; + Check_Counts (Test, Ref_Pool, 2, 3, 3); + Bounded_Start (Workers (4), Ref_Pool, Test_Length * 0.2, Test, 2); + Check_Counts (Test, Ref_Pool, 3, 3, 3); + + Check_Order (Test, Ref_Pool); + end; + exception + when Error : others => Test.Report_Exception (Error); + end Bounded_Pool; + + + procedure Static_Pool (Report : in out NT.Reporter'Class) is + Test : NT.Test := Report.Item ("Static pool typical usage"); + begin + declare + Size : constant Ref_Pools.Pool_Size := 10; + Ref_Pool : Ref_Pools.Pool; + Ref : array (Ref_Pools.Pool_Size range 1 .. Size) of Refs.Reference; + begin + Check_Counts (Test, Ref_Pool, 0, 0, 0); + Ref_Pool.Preallocate (Size, Factory'Access); + Check_Counts (Test, Ref_Pool, 0, Size, Size); + + for I in Ref'Range loop + Ref_Pool.Get (Ref (I)); + Check_Counts (Test, Ref_Pool, I, Size, Size); + end loop; + + Ref (2).Reset; + Check_Counts (Test, Ref_Pool, Size - 1, Size, Size); + + Ref_Pool.Get (Ref (2)); + Check_Counts (Test, Ref_Pool, Size, Size, Size); + + declare + Extra_Ref : Refs.Reference; + begin + Ref_Pool.Get (Extra_Ref); + Test.Fail ("Expected exception at Get on full pool"); + exception + when Constraint_Error => + null; + when Error : others => + Test.Info ("At Get on full pool,"); + Test.Report_Exception (Error, NT.Fail); + end; + + Check_Order (Test, Ref_Pool); + end; + exception + when Error : others => Test.Report_Exception (Error); + end Static_Pool; + + + procedure Unbounded_Pool (Report : in out NT.Reporter'Class) is + Test : NT.Test := Report.Item ("Unbounded pool typical usage"); + begin + declare + Test_Length : constant Duration := 0.5; + Ref_Pool : Ref_Pools.Pool; + Workers : array (1 .. 5) of Pseudo_Process; + begin + Check_Counts (Test, Ref_Pool, 0, 0, 0); + Ref_Pool.Preallocate (1); + Check_Counts (Test, Ref_Pool, 0, 0, 1); + + -- Timeline (in Test_Length/10): <--------> + -- Task using reference 1: 11111 444 + -- Task using reference 2: 22222 55 + -- Task using reference 3: 33333 + + Unbounded_Start (Workers (1), Ref_Pool, Test_Length * 0.5, Test, 1); + Check_Counts (Test, Ref_Pool, 1, 1, 1); + + delay Test_Length * 0.2; + Unbounded_Start (Workers (2), Ref_Pool, Test_Length * 0.5, Test, 2); + Check_Counts (Test, Ref_Pool, 2, 2, 2); + + delay Test_Length * 0.2; + Unbounded_Start (Workers (3), Ref_Pool, Test_Length * 0.5, Test, 3); + Check_Counts (Test, Ref_Pool, 3, 3, 3); + + delay Test_Length * 0.2; + Check_Counts (Test, Ref_Pool, 2, 3, 3); + Unbounded_Start (Workers (4), Ref_Pool, Test_Length * 0.3, Test, 1); + Check_Counts (Test, Ref_Pool, 3, 3, 3); + + delay Test_Length * 0.1; + Check_Counts (Test, Ref_Pool, 2, 3, 3); + Ref_Pool.Purge; + Check_Counts (Test, Ref_Pool, 2, 2, 2); + Unbounded_Start (Workers (5), Ref_Pool, Test_Length * 0.2, Test, 3); + end; + exception + when Error : others => Test.Report_Exception (Error); + end Unbounded_Pool; + +end Natools.Reference_Tests.Pools; ADDED tests/natools-reference_tests-pools.ads Index: tests/natools-reference_tests-pools.ads ================================================================== --- tests/natools-reference_tests-pools.ads +++ tests/natools-reference_tests-pools.ads @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Reference_Tests.Pools expands reference test suite with -- +-- reference pools. -- +------------------------------------------------------------------------------ + +private with Natools.References.Pools; + +package Natools.Reference_Tests.Pools is + + procedure All_Tests (Report : in out NT.Reporter'Class); + + procedure Bounded_Pool (Report : in out NT.Reporter'Class); + procedure Static_Pool (Report : in out NT.Reporter'Class); + procedure Unbounded_Pool (Report : in out NT.Reporter'Class); + +private + + package Ref_Pools is new Refs.Pools; + + + task type Pseudo_Process is + entry Start (Target : in Refs.Reference; Amount : in Duration); + end Pseudo_Process; + + procedure Bounded_Start + (Process : in out Pseudo_Process; + Pool : in out Ref_Pools.Pool; + Amount : in Duration; + Test : in out NT.Test; + Expected_Instance : in Natural); + + procedure Unbounded_Start + (Process : in out Pseudo_Process; + Pool : in out Ref_Pools.Pool; + Amount : in Duration; + Test : in out NT.Test; + Expected_Instance : in Natural); + +end Natools.Reference_Tests.Pools; Index: tests/test_all.adb ================================================================== --- tests/test_all.adb +++ tests/test_all.adb @@ -23,10 +23,11 @@ with Natools.Chunked_Strings.Tests; with Natools.Cron.Tests; with Natools.Getopt_Long_Tests; with Natools.HMAC_Tests; with Natools.Reference_Tests; +with Natools.Reference_Tests.Pools; with Natools.S_Expressions.Atom_Buffers.Tests; with Natools.S_Expressions.Cache_Tests; with Natools.S_Expressions.Dynamic_Interpreter_Tests; with Natools.S_Expressions.Encodings.Tests; with Natools.S_Expressions.File_RW_Tests; @@ -89,10 +90,14 @@ Report.Section ("References"); Natools.Reference_Tests.All_Tests (Report); Natools.Reference_Tests.Test_Task_Safety (Report); Report.End_Section; + + Report.Section ("References.Pools"); + Natools.Reference_Tests.Pools.All_Tests (Report); + Report.End_Section; Report.Section ("S_Expressions.Atom_Buffers"); Natools.S_Expressions.Atom_Buffers.Tests.All_Tests (Report); Report.End_Section;