From 6426315ba68fed08b049dc0ebfb9493bc5ad9a96 Mon Sep 17 00:00:00 2001 From: Olivier Ramonat Date: Thu, 13 Mar 2008 11:46:24 +0100 Subject: [PATCH] Add a regtest to check tasking --- src/db-sqlite.adb | 29 ++++++++- tests/regtests.gpr | 11 ++++ tests/t1.adb | 177 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 214 insertions(+), 3 deletions(-) create mode 100644 tests/regtests.gpr create mode 100644 tests/t1.adb diff --git a/src/db-sqlite.adb b/src/db-sqlite.adb index d752d26..5393662 100755 --- a/src/db-sqlite.adb +++ b/src/db-sqlite.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ --- GnadeLite -- +-- GnadeLite -- -- -- --- Copyright (C) 2006-2007 -- +-- Copyright (C) 2006-2008 -- -- Pascal Obry - Olivier Ramonat -- -- -- -- This library is free software; you can redistribute it and/or modify -- @@ -48,6 +48,7 @@ package body DB.SQLite is protected SQLite_Safe is procedure Close (DB : in Handle; Result : out Sqlite3.Return_Value); + -- Close the database procedure Exec (DB : in Handle; SQL : in String; Result : out Sqlite3.Return_Value); @@ -55,12 +56,13 @@ package body DB.SQLite is procedure Open (DB : in Handle; Name : in String; Result : out Sqlite3.Return_Value); - -- Open an SQL statement + -- Open the database procedure Prepare_Select (DB : in Handle; Iter : in out Standard.DB.Iterator'Class; SQL : in String); + -- Prepare a select statement end SQLite_Safe; ----------------------- @@ -249,25 +251,46 @@ package body DB.SQLite is Execute (DB, "rollback"); end Rollback; + ----------------- + -- SQLite_Safe -- + ----------------- + protected body SQLite_Safe is + + ----------- + -- Close -- + ----------- + procedure Close (DB : in Handle; Result : out Sqlite3.Return_Value) is begin Result := SQLite3.Close (DB.H); end Close; + ---------- + -- Exec -- + ---------- + procedure Exec (DB : in Handle; SQL : in String; Result : out Sqlite3.Return_Value) is begin Result := SQLite3.Exec (DB.H, SQL); end Exec; + ---------- + -- Open -- + ---------- + procedure Open (DB : in Handle; Name : in String; Result : out Sqlite3.Return_Value) is begin Result := SQLite3.Open (DB.H, Name); end Open; + -------------------- + -- Prepare_Select -- + -------------------- + procedure Prepare_Select (DB : in Handle; Iter : in out Standard.DB.Iterator'Class; diff --git a/tests/regtests.gpr b/tests/regtests.gpr new file mode 100644 index 0000000..c22e08b --- /dev/null +++ b/tests/regtests.gpr @@ -0,0 +1,11 @@ +with "../gnadelite"; + +project Regtests is + for Source_Dirs use ("."); + for Main use ("t1"); + + package Compiler is + for Default_Switches ("Ada") use ("-gnat05"); + end Compiler; +end Regtests; + diff --git a/tests/t1.adb b/tests/t1.adb new file mode 100644 index 0000000..8caa727 --- /dev/null +++ b/tests/t1.adb @@ -0,0 +1,177 @@ +with Ada.Directories; +with Ada.Exceptions; +with Ada.Task_Attributes; +with Ada.Text_IO; + +with DB.SQLite; +with DB.Tools; + +with Morzhol.Logs; + +procedure T1 is + + use Ada; + use Ada.Exceptions; + + task type Inserts is + entry Start (Id : in Positive); + end Inserts; + + task type Selects is + entry Start (Id : in Positive); + end Selects; + + type TLS_DBH is record + Handle : access DB.Handle'Class; + Connected : Boolean; + end record; + + type TLS_DBH_Access is access all TLS_DBH; + + Null_DBH : constant TLS_DBH := + TLS_DBH'(Handle => null, Connected => False); + + DB_Path : constant String := DB.SQLite.In_Memory_Database; + + package DBH_TLS is + new Task_Attributes (Attribute => TLS_DBH, Initial_Value => Null_DBH); + + procedure Connect (DBH : in TLS_DBH_Access); + -- Connects to the database if needed + + ------------- + -- Connect -- + ------------- + + procedure Connect (DBH : in TLS_DBH_Access) is + begin + if not DBH.Connected then + DBH.Handle := new DB.SQLite.Handle; + DBH.Handle.Connect (DB_Path); + DBH.Connected := True; + DBH_TLS.Set_Value (DBH.all); + end if; + end Connect; + + ------------- + -- Inserts -- + ------------- + + task body Inserts is + DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference); + + Max_Insert : constant Positive := 10000; + Task_Id : Positive; + Current : Positive := 1; + begin + Connect (DBH); + + accept Start (Id : in Positive) do + Task_Id := Id; + + -- Insert a first element + declare + SQL : constant String := "insert into test (counter, tid) values (" + & Positive'Image (Current) & ", " & Positive'Image (Task_Id) & ")"; + begin + DBH.Handle.Execute (SQL); + end; + Current := Current + 1; + end Start; + + loop + exit when Current = Max_Insert; + + declare + SQL : constant String := "insert into test (counter, tid) values (" + & Positive'Image (Current) & ", " + & Positive'Image (Task_Id) & ")"; + begin + DBH.Handle.Execute (SQL); + end; + Current := Current + 1; + + end loop; + exception + when E : others => Text_IO.Put_Line (Exception_Information (E)); + end Inserts; + + ------------- + -- Selects -- + ------------- + + task body Selects is + DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference); + Task_Id : Positive; + Last : Positive := 1; + begin + accept Start (Id : in Positive) do + Task_Id := Id; + Text_IO.Put_Line ("Reader " & Positive'Image (Task_Id) & " start"); + Connect (DBH); + end Start; + loop + declare + Iter : DB.SQLite.Iterator; + Line : DB.String_Vectors.Vector; + begin + DBH.Handle.Prepare_Select + (Iter, "select max(counter), tid from test"); + if Iter.More then + Iter.Get_Line (Line); + if Positive'Value + (DB.String_Vectors.Element (Line, 1)) = 9999 then + Text_IO.Put_Line ("Reader " + & Positive'Image (Task_Id) + & " Stop successfully"); + Line.Clear; + Iter.End_Select; + exit; + end if; + if Positive'Value + (DB.String_Vectors.Element (Line, 1)) /= Last then + Last := Positive'Value (DB.String_Vectors.Element (Line, 1)); + Text_IO.Put_Line + ("Reader " & Positive'Image (Task_Id) & " see " + & DB.String_Vectors.Element (Line, 1) & " write by " + & DB.String_Vectors.Element (Line, 2)); + end if; + Line.Clear; + end if; + Iter.End_Select; + end; + end loop; + exception + when E : others => Text_IO.Put_Line (Exception_Information (E)); + end Selects; +begin + + Morzhol.Logs.Set (Morzhol.Logs.Information, False); + Morzhol.Logs.Set (Morzhol.Logs.Warnings, False); + Morzhol.Logs.Set (Morzhol.Logs.Error, True); -- show errors + + Create_DB : declare + DBH : constant TLS_DBH_Access := TLS_DBH_Access (DBH_TLS.Reference); + begin + Connect (DBH); + DBH.Handle.Execute + ("create table test ('Counter' boolean, 'tid' integer)"); + end Create_DB; + + declare + Writer_1 : Inserts; + Writer_2 : Inserts; + Writer_3 : Inserts; + Reader_1 : Selects; + Reader_2 : Selects; + begin + -- Start the writer + + Writer_1.Start (1); + Writer_2.Start (2); + Writer_3.Start (3); + + Reader_1.Start (1); + Reader_2.Start (2); + end; +end T1; -- 2.11.4.GIT