<commit_before>-----------------------------------------------------------------------
--  concurrency.tests -- Unit tests for concurrency package
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 <NAME>
--  Written by <NAME> (<EMAIL>)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Concurrent.Counters;
with Util.Test_Caller;
with Util.Measures;
with Util.Log.Loggers;
with Util.Concurrent.Copies;
with Util.Concurrent.Pools;
with Util.Concurrent.Fifos;
with Util.Concurrent.Arrays;
package body Util.Concurrent.Tests is

   use Util.Tests;
   use Util.Concurrent.Counters;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Concurrent.Tests");

   type Connection is new Ada.Finalization.Controlled with record
      Name  : Ada.Strings.Unbounded.Unbounded_String;
      Value : Natural := 0;
   end record;

   function "=" (Left, Right : in Connection) return Boolean;

   overriding
   procedure Finalize (C : in out Connection);

   function "=" (Left, Right : in Connection) return Boolean is
   begin
      return Left.Value = Right.Value;
   end "=";

   package Connection_Pool is new Util.Concurrent.Pools (Connection);

   package Connection_Fifo is new Util.Concurrent.Fifos (Connection, 7);

   package Connection_Arrays is new Util.Concurrent.Arrays (Connection);

   package Caller is new Util.Test_Caller (Test, "Concurrent");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Increment",
                       Test_Increment'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Decrement",
                       Test_Decrement'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Decrement + Test",
                       Test_Decrement_And_Test'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Copies.Get + Set",
                       Test_Copy'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Pools.Get_Instance",
                       Test_Pool'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Pools (concurrent test)",
                       Test_Concurrent_Pool'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Fifos",
                       Test_Fifo'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Fifos (concurrent test)",
                       Test_Concurrent_Fifo'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Arrays",
                       Test_Array'Access);
   end Add_Tests;

   overriding
   procedure Finalize (C : in out Connection) is
   begin
      null;
   end Finalize;

   --  ------------------------------
   --  Test concurrent pool
   --  ------------------------------
   procedure Test_Pool (T : in out Test) is
      use Ada.Strings.Unbounded;

      P : Connection_Pool.Pool;
      C : Connection;
   begin
      --  Set the pool capacity.
      P.Set_Size (Capacity => 10);

      --  Insert the objects.
      for I in 1 .. 10 loop
         C.Name := To_Unbounded_String (Integer'Image (I));
         P.Release (C);
      end loop;

      --  Use the pool and verify the objects.
      declare
         C : array (1 .. 10) of Connection;
      begin
         for J in 1 .. 3 loop
            --  Get each object and verify that it matches our instance.
            for I in reverse 1 .. 10 loop
               P.Get_Instance (C (I));
               Assert_Equals (T, Integer'Image (I), To_String (C (I).Name), "Invalid pool object");
            end loop;

            --  Put the object back in the pool.
            for I in 1 .. 10 loop
               P.Release (C (I));
            end loop;
         end loop;
      end;

      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            P.Get_Instance (C);
            P.Release (C);
         end loop;
         Util.Measures.Report (S, "Pool Get_Instance+Release", 1000);
      end;
   end Test_Pool;

   --  ------------------------------
   --  Test concurrent pool
   --  ------------------------------
   procedure Test_Concurrent_Pool (T : in out Test) is
      use Ada.Strings.Unbounded;

      Count_By_Task : constant Natural := 10_001;
      Task_Count    : constant Natural := 17;
      Capacity      : constant Natural := 5;

      P : Connection_Pool.Pool;
      C : Connection;
      S : Util.Measures.Stamp;
   begin
      --  Set the pool capacity.
      P.Set_Size (Capacity => Capacity);

      --  Insert the objects.
      for I in 1 .. Capacity loop
         C.Name := To_Unbounded_String (Integer'Image (I));
         P.Release (C);
      end loop;

      declare

         --  A task that picks an object from the pool, increment the value and puts
         --  back the object in the pool.
         task type Worker is
            entry Start (Count : in Natural);
         end Worker;

         task body Worker is
            Cnt : Natural;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            --  Get an object from the pool, increment the value and put it back in the pool.
            for I in 1 .. Cnt loop
               declare
                  C : Connection;
               begin
                  P.Get_Instance (C);
                  C.Value := C.Value + 1;
                  P.Release (C);
               end;
            end loop;
         exception
            when others =><commit_msg>Report the exception in the log when an error occurs<commit_after>-----------------------------------------------------------------------
--  concurrency.tests -- Unit tests for concurrency package
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 <NAME>
--  Written by <NAME> (<EMAIL>)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Finalization;

with Util.Concurrent.Counters;
with Util.Test_Caller;
with Util.Measures;
with Util.Log.Loggers;
with Util.Concurrent.Copies;
with Util.Concurrent.Pools;
with Util.Concurrent.Fifos;
with Util.Concurrent.Arrays;
package body Util.Concurrent.Tests is

   use Util.Tests;
   use Util.Concurrent.Counters;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Concurrent.Tests");

   type Connection is new Ada.Finalization.Controlled with record
      Name  : Ada.Strings.Unbounded.Unbounded_String;
      Value : Natural := 0;
   end record;

   function "=" (Left, Right : in Connection) return Boolean;

   overriding
   procedure Finalize (C : in out Connection);

   function "=" (Left, Right : in Connection) return Boolean is
   begin
      return Left.Value = Right.Value;
   end "=";

   package Connection_Pool is new Util.Concurrent.Pools (Connection);

   package Connection_Fifo is new Util.Concurrent.Fifos (Connection, 7);

   package Connection_Arrays is new Util.Concurrent.Arrays (Connection);

   package Caller is new Util.Test_Caller (Test, "Concurrent");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Increment",
                       Test_Increment'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Decrement",
                       Test_Decrement'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Counter.Decrement + Test",
                       Test_Decrement_And_Test'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Copies.Get + Set",
                       Test_Copy'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Pools.Get_Instance",
                       Test_Pool'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Pools (concurrent test)",
                       Test_Concurrent_Pool'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Fifos",
                       Test_Fifo'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Fifos (concurrent test)",
                       Test_Concurrent_Fifo'Access);
      Caller.Add_Test (Suite, "Test Util.Concurrent.Arrays",
                       Test_Array'Access);
   end Add_Tests;

   overriding
   procedure Finalize (C : in out Connection) is
   begin
      null;
   end Finalize;

   --  ------------------------------
   --  Test concurrent pool
   --  ------------------------------
   procedure Test_Pool (T : in out Test) is
      use Ada.Strings.Unbounded;

      P : Connection_Pool.Pool;
      C : Connection;
   begin
      --  Set the pool capacity.
      P.Set_Size (Capacity => 10);

      --  Insert the objects.
      for I in 1 .. 10 loop
         C.Name := To_Unbounded_String (Integer'Image (I));
         P.Release (C);
      end loop;

      --  Use the pool and verify the objects.
      declare
         C : array (1 .. 10) of Connection;
      begin
         for J in 1 .. 3 loop
            --  Get each object and verify that it matches our instance.
            for I in reverse 1 .. 10 loop
               P.Get_Instance (C (I));
               Assert_Equals (T, Integer'Image (I), To_String (C (I).Name), "Invalid pool object");
            end loop;

            --  Put the object back in the pool.
            for I in 1 .. 10 loop
               P.Release (C (I));
            end loop;
         end loop;
      end;

      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            P.Get_Instance (C);
            P.Release (C);
         end loop;
         Util.Measures.Report (S, "Pool Get_Instance+Release", 1000);
      end;
   end Test_Pool;

   --  ------------------------------
   --  Test concurrent pool
   --  ------------------------------
   procedure Test_Concurrent_Pool (T : in out Test) is
      use Ada.Strings.Unbounded;

      Count_By_Task : constant Natural := 10_001;
      Task_Count    : constant Natural := 17;
      Capacity      : constant Natural := 5;

      P : Connection_Pool.Pool;
      C : Connection;
      S : Util.Measures.Stamp;
   begin
      --  Set the pool capacity.
      P.Set_Size (Capacity => Capacity);

      --  Insert the objects.
      for I in 1 .. Capacity loop
         C.Name := To_Unbounded_String (Integer'Image (I));
         P.Release (C);
      end loop;

      declare

         --  A task that picks an object from the pool, increment the value and puts
         --  back the object in the pool.
         task type Worker is
            entry Start (Count : in Natural);
         end Worker;

         task body Worker is
            Cnt : Natural;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            --  Get an object from the pool, increment the value and put it back in the pool.
            for I in 1 .. Cnt loop
               declare
                  C : Connection;
               begin
                  P.Get_Instance (C);
                  C.Value := C.Value + 1;
                  P.Release (C);
               end;
            end loop;
         exception
            when E : others =>
{'fraction_non_alphanumeric': 0.1303361684892669, 'fraction_numerical': 0.010692588092345079, 'mean_word_length': 1.7229819144243494, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3849146', 'n_tokens_mistral': 3556, 'n_tokens_neox': 3319, 'n_words': 1118}