tests/t1.adb

   1 ------------------------------------------------------------------------------
   2 --                                GnadeLite                                 --
   3 --                                                                          --
   4 --                            Copyright (C) 2008                            --
   5 --                      Pascal Obry - Olivier Ramonat                       --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.Directories;
  23 with Ada.Exceptions;
  24 with Ada.Task_Attributes;
  25 with Ada.Text_IO;
  26
  27 with DB.SQLite;
  28 with DB.Tools;
  29
  30 with Morzhol.Logs;
  31
  32 procedure T1 is
  33
  34    use Ada;
  35    use Ada.Exceptions;
  36
  37    Max_Insert : constant Positive := 10000;
  38    Verbose    : constant Boolean := False;
  39
  40    task type Inserts is
  41       entry Start (Id : in Positive);
  42    end Inserts;
  43
  44    task type Selects is
  45       entry Start (Id : in Positive);
  46    end Selects;
  47
  48    type TLS_DBH is record
  49       Handle    : access DB.Handle'Class;
  50       Connected : Boolean;
  51    end record;
  52
  53    type TLS_DBH_Access is access all TLS_DBH;
  54
  55    Null_DBH : constant TLS_DBH :=
  56                 TLS_DBH'(Handle => null, Connected => False);
  57
  58    DB_Path : constant String := DB.SQLite.In_Memory_Database;
  59
  60    package DBH_TLS is
  61      new Task_Attributes (Attribute => TLS_DBH, Initial_Value => Null_DBH);
  62
  63    procedure Connect (DBH : in TLS_DBH_Access);
  64    --  Connects to the database if needed
  65
  66    -------------
  67    -- Connect --
  68    -------------
  69
  70    procedure Connect (DBH : in TLS_DBH_Access) is
  71    begin
  72       if not DBH.Connected then
  73          DBH.Handle := new DB.SQLite.Handle;
  74          DBH.Handle.Connect (DB_Path);
  75          DBH.Connected := True;
  76          DBH_TLS.Set_Value (DBH.all);
  77       end if;
  78    end Connect;
  79
  80    -------------
  81    -- Inserts --
  82    -------------
  83
  84    task body Inserts is
  85       DBH     : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
  86       Task_Id : Positive;
  87       Current : Positive := 1;
  88    begin
  89       Connect (DBH);
  90
  91       accept Start (Id : in Positive) do
  92          Task_Id := Id;
  93
  94          --  Insert a first element
  95          declare
  96             SQL : constant String :=
  97                     "insert into test (counter, tid) values ("
  98                       & Positive'Image (Current) & ", "
  99                       & Positive'Image (Task_Id) & ")";
 100          begin
 101             DBH.Handle.Execute (SQL);
 102          end;
 103          Current := Current + 1;
 104       end Start;
 105
 106       loop
 107          declare
 108             SQL : constant String :=
 109                     "insert into test (counter, tid) values ("
 110                       & Positive'Image (Current) & ", "
 111                       & Positive'Image (Task_Id) & ")";
 112          begin
 113             DBH.Handle.Execute (SQL);
 114          end;
 115
 116          exit when Current = Max_Insert;
 117          Current := Current + 1;
 118       end loop;
 119
 120       DBH.Handle.Close;
 121    exception
 122       when E : others =>
 123          Text_IO.Put_Line
 124            ("Inserts" & Positive'Image (Task_Id) & "; "
 125             & Exception_Information (E));
 126    end Inserts;
 127
 128    -------------
 129    -- Selects --
 130    -------------
 131
 132    task body Selects is
 133       DBH     : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 134       Task_Id : Positive;
 135       Last    : Natural := 1;
 136    begin
 137       accept Start (Id : in Positive) do
 138          Task_Id := Id;
 139          if Verbose then
 140             Text_IO.Put_Line ("Reader " & Positive'Image (Task_Id) & " start");
 141          end if;
 142          Connect (DBH);
 143       end Start;
 144
 145       loop
 146          declare
 147             Iter : DB.SQLite.Iterator;
 148             Line : DB.String_Vectors.Vector;
 149          begin
 150             DBH.Handle.Prepare_Select
 151               (Iter, "select max(counter), tid from test");
 152
 153             if Iter.More then
 154                Iter.Get_Line (Line);
 155
 156                if DB.String_Vectors.Element (Line, 1) /= "" then
 157                   if Natural'Value
 158                     (DB.String_Vectors.Element (Line, 1)) = Max_Insert
 159                   then
 160                      Text_IO.Put_Line ("Reader "
 161                                        & Positive'Image (Task_Id)
 162                                        & " Stop successfully");
 163                      Line.Clear;
 164                      Iter.End_Select;
 165                      exit;
 166                   end if;
 167
 168                   if Verbose and then Natural'Value
 169                     (DB.String_Vectors.Element (Line, 1)) /= Last
 170                   then
 171                      Last := Natural'Value
 172                        (DB.String_Vectors.Element (Line, 1));
 173                      Text_IO.Put_Line
 174                        ("Reader " & Positive'Image (Task_Id) & " see "
 175                         & DB.String_Vectors.Element (Line, 1) & " write by "
 176                         & DB.String_Vectors.Element (Line, 2));
 177                   end if;
 178                end if;
 179                Line.Clear;
 180             end if;
 181             Iter.End_Select;
 182          end;
 183       end loop;
 184
 185       DBH.Handle.Close;
 186    exception
 187       when E : others =>
 188          Text_IO.Put_Line
 189            ("Selects" & Positive'Image (Task_Id) & "; "
 190             & Exception_Information (E));
 191    end Selects;
 192
 193 begin
 194    Morzhol.Logs.Set (Morzhol.Logs.Information, False);
 195    Morzhol.Logs.Set (Morzhol.Logs.Warnings, False);
 196    Morzhol.Logs.Set (Morzhol.Logs.Error, True); --  show errors
 197
 198    Create_DB : declare
 199       DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 200    begin
 201       Connect (DBH);
 202       DBH.Handle.Execute
 203         ("create table test ('Counter' boolean, 'tid' integer)");
 204    end Create_DB;
 205
 206    declare
 207       Writers : array (1 .. 2) of Inserts;
 208       Readers : array (1 .. 10) of Selects;
 209    begin
 210       --  Start the readers
 211
 212       for K in Readers'Range loop
 213          Readers (K).Start (K);
 214       end loop;
 215
 216       --  Start the writer
 217
 218       for K in Writers'Range loop
 219          Writers (K).Start (K);
 220       end loop;
 221    end;
 222
 223 end T1;