Overview
| Comment: | s_expressions-lockable-tests: add a test suite for Loackable.Descriptor objects and use it to tester Wrapper |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
5fce88a98151825063a40abfa972bc7e |
| User & Date: | nat on 2014-03-02 17:03:06 |
| Other Links: | manifest | tags |
Context
|
2014-03-03
| ||
| 20:56 | s_expressions-lockable-tests: fix bad expected value in interface test check-in: 98b6fee05f user: nat tags: trunk | |
|
2014-03-02
| ||
| 17:03 | s_expressions-lockable-tests: add a test suite for Loackable.Descriptor objects and use it to tester Wrapper check-in: 5fce88a981 user: nat tags: trunk | |
|
2014-03-01
| ||
| 11:25 | s_expressions-lockable-tests: new package with a test suite for lock level stack check-in: 0bbab0a171 user: nat tags: trunk | |
Changes
Modified tests/natools-s_expressions-lockable-tests.adb from [75b7ead240] to [a15e290edf].
| ︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- ------------------------------------------------------------------------------ with Natools.S_Expressions.Test_Tools; with Natools.S_Expressions.Parsers; package body Natools.S_Expressions.Lockable.Tests is ------------------------- -- Complete Test Suite -- ------------------------- procedure All_Tests (Report : in out NT.Reporter'Class) is begin | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 |
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. --
------------------------------------------------------------------------------
with Natools.S_Expressions.Test_Tools;
with Natools.S_Expressions.Parsers;
package body Natools.S_Expressions.Lockable.Tests is
-------------------------------
-- Lockable.Descriptor Tests --
-------------------------------
function Test_Expression return Atom is
begin
return To_Atom ("(begin(command1 arg1.1 arg1.2)"
& "(command2 (subcmd2.1 arg2.1.1) (subcmd2.3) arg2.4)"
& "end)");
end Test_Expression;
procedure Test_Interface
(Test : in out NT.Test;
Object : in out Lockable.Descriptor'Class)
is
Level_1, Level_2 : Lock_State;
Base : Natural;
begin
Base := Object.Current_Level;
Test_Tools.Next_And_Check (Test, Object, To_Atom ("begin"), Base);
Test_Tools.Next_And_Check (Test, Object, Events.Open_List, Base + 1);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("command1"), Base + 1,
"Before first lock:");
Object.Lock (Level_1);
Test_Tools.Test_Atom_Accessors (Test, Object, To_Atom ("command1"), 0,
"After first lock:");
Test_Tools.Next_And_Check (Test, Object, To_Atom ("arg1.1"), 0);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("arg1.2"), 0);
Test_Tools.Next_And_Check (Test, Object, Events.End_Of_Input, 0,
"Before first unlock:");
Test_Tools.Test_Atom_Accessor_Exceptions (Test, Object);
Object.Unlock (Level_1);
declare
Event : constant Events.Event := Object.Current_Event;
Level : constant Natural := Object.Current_Level;
begin
if Event /= Events.Close_List then
Test.Fail ("Current event is " & Events.Event'Image (Event)
& ", expected Close_List");
end if;
if Level /= Base then
Test.Fail ("Current level is" & Natural'Image (Level)
& ", expected" & Natural'Image (Base));
end if;
end;
Test_Tools.Next_And_Check (Test, Object, Events.Open_List, Base + 1);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("command2"), Base + 1,
"Before second lock:");
Object.Lock (Level_1);
Test_Tools.Test_Atom_Accessors (Test, Object, To_Atom ("command2"), 0,
"After second lock:");
Test_Tools.Next_And_Check (Test, Object, Events.Open_List, 1);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("subcmd2.1"), 1,
"Before inner lock:");
Object.Lock (Level_2);
Test_Tools.Test_Atom_Accessors (Test, Object, To_Atom ("subcmd2.1"), 0,
"After inner lock:");
Test_Tools.Next_And_Check (Test, Object, To_Atom ("arg2.1.1"), 0,
"Before inner unlock:");
Object.Unlock (Level_2, False);
Test_Tools.Test_Atom_Accessors (Test, Object, To_Atom ("arg2.1.1"), 1,
"After inner unlock:");
Test_Tools.Next_And_Check (Test, Object, Events.Close_List, 0);
Test_Tools.Next_And_Check (Test, Object, Events.Open_List, 1);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("subcmd2.3"), 1,
"Before inner lock:");
Object.Lock (Level_2);
Test_Tools.Test_Atom_Accessors (Test, Object, To_Atom ("subcmd2.3"), 0,
"After inner lock:");
Test_Tools.Next_And_Check (Test, Object, Events.End_Of_Input, 0,
"Before inner unlock:");
Object.Unlock (Level_2, False);
declare
Event : constant Events.Event := Object.Current_Event;
Level : constant Natural := Object.Current_Level;
begin
if Event /= Events.Close_List then
Test.Fail ("Current event is " & Events.Event'Image (Event)
& ", expected Close_List");
end if;
if Level /= 1 then
Test.Fail ("Current level is" & Natural'Image (Level)
& ", expected 1");
end if;
end;
Object.Unlock (Level_1);
Test_Tools.Next_And_Check (Test, Object, To_Atom ("end"), Base);
Test_Tools.Next_And_Check (Test, Object, Events.Close_List, Base - 1);
end Test_Interface;
-------------------------
-- Complete Test Suite --
-------------------------
procedure All_Tests (Report : in out NT.Reporter'Class) is
begin
|
| ︙ | ︙ | |||
145 146 147 148 149 150 151 152 |
Pop_Level (Stack, State (1));
Check_Level (Stack, 0, "14");
end;
exception
when Error : others => Test.Report_Exception (Error);
end Test_Stack;
end Natools.S_Expressions.Lockable.Tests;
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 |
Pop_Level (Stack, State (1));
Check_Level (Stack, 0, "14");
end;
exception
when Error : others => Test.Report_Exception (Error);
end Test_Stack;
procedure Test_Wrapper_Extra (Report : in out NT.Reporter'Class) is
Test : NT.Test := Report.Item ("Extra tests of wrapper");
begin
declare
Input : aliased Test_Tools.Memory_Stream;
Parser : aliased Parsers.Parser;
Subparser : aliased Parsers.Subparser (Parser'Access, Input'Access);
Tested : Wrapper (Subparser'Access);
State : Lock_State;
begin
Input.Set_Data (To_Atom ("(cmd1 arg1)(cmd2 4:arg2"));
-- Check Events.Error is returned by Next when finished
Test_Tools.Next_And_Check (Test, Tested, Events.Open_List, 1);
Test_Tools.Next_And_Check (Test, Tested, To_Atom ("cmd1"), 1);
Tested.Lock (State);
Test_Tools.Next_And_Check (Test, Tested, To_Atom ("arg1"), 0);
Test_Tools.Next_And_Check (Test, Tested, Events.End_Of_Input, 0);
Test_Tools.Next_And_Check (Test, Tested, Events.Error, 0);
Tested.Unlock (State);
-- Run Unlock with End_Of_Input in backend
Test_Tools.Next_And_Check (Test, Tested, Events.Open_List, 1);
Test_Tools.Next_And_Check (Test, Tested, To_Atom ("cmd2"), 1);
Tested.Lock (State);
Test_Tools.Next_And_Check (Test, Tested, To_Atom ("arg2"), 0);
Tested.Unlock (State);
end;
exception
when Error : others => Test.Report_Exception (Error);
end Test_Wrapper_Extra;
procedure Test_Wrapper_Interface (Report : in out NT.Reporter'Class) is
Test : NT.Test
:= Report.Item ("Lockable.Descriptor interface of wrapper");
begin
declare
Input : aliased Test_Tools.Memory_Stream;
Parser : aliased Parsers.Parser;
Subparser : aliased Parsers.Subparser (Parser'Access, Input'Access);
Tested : Wrapper (Subparser'Access);
begin
Input.Set_Data (Test_Expression);
Test_Tools.Next_And_Check (Test, Subparser, Events.Open_List, 1);
Test_Interface (Test, Tested);
end;
exception
when Error : others => Test.Report_Exception (Error);
end Test_Wrapper_Interface;
end Natools.S_Expressions.Lockable.Tests;
|
Modified tests/natools-s_expressions-lockable-tests.ads from [f578c376f2] to [730be3fd9a].
| ︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 | with Natools.Tests; package Natools.S_Expressions.Lockable.Tests is pragma Preelaborate (Tests); package NT renames Natools.Tests; procedure All_Tests (Report : in out NT.Reporter'Class); procedure Test_Stack (Report : in out NT.Reporter'Class); end Natools.S_Expressions.Lockable.Tests; | > > > > > > > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
with Natools.Tests;
package Natools.S_Expressions.Lockable.Tests is
pragma Preelaborate (Tests);
package NT renames Natools.Tests;
function Test_Expression return Atom;
procedure Test_Interface
(Test : in out NT.Test;
Object : in out Lockable.Descriptor'Class);
procedure All_Tests (Report : in out NT.Reporter'Class);
procedure Test_Stack (Report : in out NT.Reporter'Class);
procedure Test_Wrapper_Extra (Report : in out NT.Reporter'Class);
procedure Test_Wrapper_Interface (Report : in out NT.Reporter'Class);
end Natools.S_Expressions.Lockable.Tests;
|