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
  29 with Morzhol.Logs;
  30
  31 procedure T1 is
  32
  33    use Ada;
  34    use Ada.Exceptions;
  35
  36    Max_Insert : constant Positive := 100;
  37    Verbose    : constant Boolean := False;
  38
  39    task type Inserts is
  40       entry Start (Id : in Positive);
  41    end Inserts;
  42
  43    task type Selects is
  44       entry Start (Id : in Positive);
  45    end Selects;
  46
  47    type TLS_DBH is record
  48       Handle    : access DB.Handle'Class;
  49       Connected : Boolean;
  50    end record;
  51
  52    type TLS_DBH_Access is access all TLS_DBH;
  53
  54    Null_DBH : constant TLS_DBH :=
  55                 TLS_DBH'(Handle => null, Connected => False);
  56
  57    DB_Path : constant String := "temp.db";
  58
  59    package DBH_TLS is
  60      new Task_Attributes (Attribute => TLS_DBH, Initial_Value => Null_DBH);
  61
  62    procedure Connect (DBH : in TLS_DBH_Access);
  63    --  Connects to the database if needed
  64
  65    -------------
  66    -- Connect --
  67    -------------
  68
  69    procedure Connect (DBH : in TLS_DBH_Access) is
  70    begin
  71       if not DBH.Connected then
  72          DBH.Handle := new DB.SQLite.Handle;
  73          DBH.Handle.Connect (DB_Path);
  74          DBH.Connected := True;
  75          DBH_TLS.Set_Value (DBH.all);
  76       end if;
  77    end Connect;
  78
  79    -------------
  80    -- Inserts --
  81    -------------
  82
  83    task body Inserts is
  84       DBH     : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
  85       Task_Id : Positive;
  86       Current : Positive := 1;
  87    begin
  88       Connect (DBH);
  89
  90       accept Start (Id : in Positive) do
  91          Task_Id := Id;
  92
  93          --  Insert a first element
  94          declare
  95             SQL : constant String :=
  96                     "insert into test (counter, tid) values ("
  97                       & Positive'Image (Current) & ", "
  98                       & Positive'Image (Task_Id) & ")";
  99          begin
 100             DBH.Handle.Execute (SQL);
 101          end;
 102          Current := Current + 1;
 103       end Start;
 104
 105       loop
 106          declare
 107             SQL : constant String :=
 108                     "insert into test (counter, tid) values ("
 109                       & Positive'Image (Current) & ", "
 110                       & Positive'Image (Task_Id) & ")";
 111          begin
 112             DBH.Handle.Execute (SQL);
 113          end;
 114
 115          exit when Current = Max_Insert;
 116          Current := Current + 1;
 117       end loop;
 118
 119       DBH.Handle.Close;
 120    exception
 121       when E : others =>
 122          Text_IO.Put_Line
 123            ("Inserts" & Positive'Image (Task_Id) & "; "
 124             & Exception_Information (E));
 125    end Inserts;
 126
 127    -------------
 128    -- Selects --
 129    -------------
 130
 131    task body Selects is
 132       DBH     : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 133       Task_Id : Positive;
 134       Last    : Natural := 1;
 135    begin
 136       accept Start (Id : in Positive) do
 137          Task_Id := Id;
 138          if Verbose then
 139             Text_IO.Put_Line ("Reader " & Positive'Image (Task_Id) & " start");
 140          end if;
 141          Connect (DBH);
 142       end Start;
 143
 144       loop
 145          declare
 146             Iter : DB.SQLite.Iterator;
 147             Line : DB.String_Vectors.Vector;
 148          begin
 149             DBH.Handle.Prepare_Select
 150               (Iter, "select max(counter), tid from test");
 151
 152             if Iter.More then
 153                Iter.Get_Line (Line);
 154
 155                if DB.String_Vectors.Element (Line, 1) /= "" then
 156                   if Natural'Value
 157                     (DB.String_Vectors.Element (Line, 1)) = Max_Insert
 158                   then
 159                      Text_IO.Put_Line ("Reader "
 160                                        & Positive'Image (Task_Id)
 161                                        & " Stop successfully");
 162                      Line.Clear;
 163                      Iter.End_Select;
 164                      exit;
 165                   end if;
 166
 167                   if Verbose and then Natural'Value
 168                     (DB.String_Vectors.Element (Line, 1)) /= Last
 169                   then
 170                      Last := Natural'Value
 171                        (DB.String_Vectors.Element (Line, 1));
 172                      Text_IO.Put_Line
 173                        ("Reader " & Positive'Image (Task_Id) & " see "
 174                         & DB.String_Vectors.Element (Line, 1) & " write by "
 175                         & DB.String_Vectors.Element (Line, 2));
 176                   end if;
 177                end if;
 178                Line.Clear;
 179             end if;
 180             Iter.End_Select;
 181          end;
 182       end loop;
 183
 184       DBH.Handle.Close;
 185    exception
 186       when E : others =>
 187          Text_IO.Put_Line
 188            ("Selects" & Positive'Image (Task_Id) & "; "
 189             & Exception_Information (E));
 190    end Selects;
 191
 192 begin
 193    Morzhol.Logs.Set (Morzhol.Logs.Information, False);
 194    Morzhol.Logs.Set (Morzhol.Logs.Warnings, False);
 195    Morzhol.Logs.Set (Morzhol.Logs.Error, True); --  show errors
 196
 197    Create_DB : declare
 198       DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference);
 199    begin
 200       if Ada.Directories.Exists (DB_Path) then
 201          Ada.Directories.Delete_File (DB_Path);
 202       end if;
 203       Connect (DBH);
 204       DBH.Handle.Execute
 205         ("create table test ('Counter' boolean, 'tid' integer)");
 206    end Create_DB;
 207
 208    declare
 209       Writers : array (1 .. 2) of Inserts;
 210       Readers : array (1 .. 10) of Selects;
 211    begin
 212       --  Start the readers
 213
 214       for K in Readers'Range loop
 215          Readers (K).Start (K);
 216       end loop;
 217
 218       --  Start the writer
 219
 220       for K in Writers'Range loop
 221          Writers (K).Start (K);
 222       end loop;
 223    end;
 224
 225 end T1;