tests/t1.adb

   1 with Ada.Directories;
   2 with Ada.Exceptions;
   3 with Ada.Task_Attributes;
   4 with Ada.Text_IO;
   5
   6 with DB.SQLite;
   7 with DB.Tools;
   8
   9 with Morzhol.Logs;
  10
  11 procedure T1 is
  12
  13    use Ada;
  14    use Ada.Exceptions;
  15
  16    task type Inserts is
  17       entry Start (Id : in Positive);
  18    end Inserts;
  19
  20    task type Selects is
  21       entry Start (Id : in Positive);
  22    end Selects;
  23
  24    type TLS_DBH is record
  25       Handle    : access DB.Handle'Class;
  26       Connected : Boolean;
  27    end record;
  28
  29    type TLS_DBH_Access is access all TLS_DBH;
  30
  31    Null_DBH : constant TLS_DBH :=
  32                 TLS_DBH'(Handle => null, Connected => False);
  33
  34    DB_Path : constant String := DB.SQLite.In_Memory_Database;
  35
  36    package DBH_TLS is
  37      new Task_Attributes (Attribute => TLS_DBH, Initial_Value => Null_DBH);
  38
  39    procedure Connect (DBH : in TLS_DBH_Access);
  40    --  Connects to the database if needed
  41
  42    -------------
  43    -- Connect --
  44    -------------
  45
  46    procedure Connect (DBH : in TLS_DBH_Access) is
  47    begin
  48       if not DBH.Connected then
  49          DBH.Handle := new DB.SQLite.Handle;
  50          DBH.Handle.Connect (DB_Path);
  51          DBH.Connected := True;
  52          DBH_TLS.Set_Value (DBH.all);
  53       end if;
  54    end Connect;
  55
  56    -------------
  57    -- Inserts --
  58    -------------
  59
  60    task body Inserts is
  61       DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
  62
  63       Max_Insert : constant Positive := 10000;
  64       Task_Id    : Positive;
  65       Current    : Positive := 1;
  66    begin
  67       Connect (DBH);
  68
  69       accept Start (Id : in Positive) do
  70          Task_Id := Id;
  71
  72          --  Insert a first element
  73          declare
  74             SQL : constant String := "insert into test (counter, tid) values ("
  75               & Positive'Image (Current) & ", " & Positive'Image (Task_Id) & ")";
  76          begin
  77             DBH.Handle.Execute (SQL);
  78          end;
  79          Current := Current + 1;
  80       end Start;
  81
  82       loop
  83          exit when Current = Max_Insert;
  84
  85          declare
  86             SQL : constant String := "insert into test (counter, tid) values ("
  87               & Positive'Image (Current) & ", "
  88               & Positive'Image (Task_Id) & ")";
  89          begin
  90             DBH.Handle.Execute (SQL);
  91          end;
  92          Current := Current + 1;
  93
  94       end loop;
  95    exception
  96       when E : others => Text_IO.Put_Line (Exception_Information (E));
  97    end Inserts;
  98
  99    -------------
 100    -- Selects --
 101    -------------
 102
 103    task body Selects is
 104       DBH     : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 105       Task_Id : Positive;
 106       Last    : Positive := 1;
 107    begin
 108       accept Start (Id : in Positive) do
 109          Task_Id := Id;
 110          Text_IO.Put_Line ("Reader " & Positive'Image (Task_Id) & " start");
 111          Connect (DBH);
 112       end Start;
 113       loop
 114          declare
 115             Iter      : DB.SQLite.Iterator;
 116             Line      : DB.String_Vectors.Vector;
 117          begin
 118             DBH.Handle.Prepare_Select
 119               (Iter, "select max(counter), tid from test");
 120             if Iter.More then
 121                Iter.Get_Line (Line);
 122                if Positive'Value
 123                  (DB.String_Vectors.Element (Line, 1)) = 9999 then
 124                   Text_IO.Put_Line ("Reader "
 125                                     & Positive'Image (Task_Id)
 126                                     & " Stop successfully");
 127                   Line.Clear;
 128                   Iter.End_Select;
 129                   exit;
 130                end if;
 131                if Positive'Value
 132                  (DB.String_Vectors.Element (Line, 1)) /= Last then
 133                   Last := Positive'Value (DB.String_Vectors.Element (Line, 1));
 134                   Text_IO.Put_Line
 135                     ("Reader " & Positive'Image (Task_Id) & " see "
 136                      & DB.String_Vectors.Element (Line, 1) & " write by "
 137                      & DB.String_Vectors.Element (Line, 2));
 138                end if;
 139                Line.Clear;
 140             end if;
 141             Iter.End_Select;
 142          end;
 143       end loop;
 144    exception
 145       when E : others => Text_IO.Put_Line (Exception_Information (E));
 146    end Selects;
 147 begin
 148
 149    Morzhol.Logs.Set (Morzhol.Logs.Information, False);
 150    Morzhol.Logs.Set (Morzhol.Logs.Warnings, False);
 151    Morzhol.Logs.Set (Morzhol.Logs.Error, True); --  show errors
 152
 153    Create_DB : declare
 154       DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 155    begin
 156       Connect (DBH);
 157       DBH.Handle.Execute
 158         ("create table test ('Counter' boolean, 'tid' integer)");
 159    end Create_DB;
 160
 161    declare
 162       Writer_1 : Inserts;
 163       Writer_2 : Inserts;
 164       Writer_3 : Inserts;
 165       Reader_1 : Selects;
 166       Reader_2 : Selects;
 167    begin
 168       --  Start the writer
 169
 170       Writer_1.Start (1);
 171       Writer_2.Start (2);
 172       Writer_3.Start (3);
 173
 174       Reader_1.Start (1);
 175       Reader_2.Start (2);
 176    end;
 177 end T1;