Natools

Check-in [5fce88a981]
Login
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: 5fce88a98151825063a40abfa972bc7e7d4151b7
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
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
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
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;