Natools

Check-in [b14a72b9cb]
Login

Check-in [b14a72b9cb]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:s_expressions-cache_tests: new packge for S-expression memory cache test suite
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b14a72b9cb0ba805f72494f386bf8e4de28a6422
User & Date: nat 2014-02-13 22:15:30.435
Context
2014-02-15
15:20
s_expressions-cache_tests: add deep- and shallow-copy to existing tests check-in: 5b437645d5 user: nat tags: trunk
2014-02-13
22:15
s_expressions-cache_tests: new packge for S-expression memory cache test suite check-in: b14a72b9cb user: nat tags: trunk
2014-02-12
21:59
Move Check_Stream from Natools.S_Expressions.Printers.Pretty.Tests to Natools.S_Expressions.Test_Tools to make it more widely available check-in: f95cb1f5a8 user: nat tags: trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Added tests/natools-s_expressions-cache_tests.adb. 
























































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with System.Storage_Pools;

with GNAT.Debug_Pools;

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Generic_Caches;
with Natools.S_Expressions.Printers;
with Natools.S_Expressions.Test_Tools;

package body Natools.S_Expressions.Cache_Tests is

   Pool : GNAT.Debug_Pools.Debug_Pool;

   package Debug_Caches is new Generic_Caches
     (System.Storage_Pools.Root_Storage_Pool'Class (Pool),
      System.Storage_Pools.Root_Storage_Pool'Class (Pool),
      System.Storage_Pools.Root_Storage_Pool'Class (Pool));


   procedure Inject_Test (Printer : in out Printers.Printer'Class);
      --  Inject test S-expression into Pr

   function Canonical_Test return Atom;
      --  Return canonical encoding of test S-expression above


   ------------------------
   -- Helper Subprograms --
   ------------------------

   function Canonical_Test return Atom is
   begin
      return To_Atom ("5:begin(()(4:head4:tail))3:end");
   end Canonical_Test;


   procedure Inject_Test (Printer : in out Printers.Printer'Class) is
   begin
      Printer.Append_Atom (To_Atom ("begin"));
      Printer.Open_List;
      Printer.Open_List;
      Printer.Close_List;
      Printer.Open_List;
      Printer.Append_Atom (To_Atom ("head"));
      Printer.Append_Atom (To_Atom ("tail"));
      Printer.Close_List;
      Printer.Close_List;
      Printer.Append_Atom (To_Atom ("end"));
   end Inject_Test;


   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Default_Instantiation (Report);
      Debug_Instantiation (Report);
   end All_Tests;


   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Debug_Instantiation (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Debug instantiation");
      Buffer : Atom_Buffers.Atom_Buffer;

      procedure Put (S : in String);
      procedure Put_Line (S : in String);
      procedure Flush;
      procedure Info_Pool;

      procedure Put (S : in String) is
      begin
         Buffer.Append (To_Atom (S));
      end Put;

      procedure Put_Line (S : in String) is
      begin
         Test.Info (To_String (Buffer.Data) & S);
         Buffer.Soft_Reset;
      end Put_Line;

      procedure Flush is
      begin
         if Buffer.Length > 0 then
            Test.Info (To_String (Buffer.Data));
         end if;
         Buffer.Hard_Reset;
      end Flush;

      procedure Info_Pool is
         procedure Print_Info is new GNAT.Debug_Pools.Print_Info;
      begin
         Print_Info (Pool);
         Flush;
      end Info_Pool;
   begin
      declare
         Cache : Debug_Caches.Reference;
      begin
         Inject_Test (Cache);

         declare
            First : Debug_Caches.Cursor := Cache.First;
            Output : aliased Test_Tools.Memory_Stream;
            Pr : Printers.Canonical (Output'Access);
         begin
            Output.Set_Expected (Canonical_Test);
            Printers.Transfer (First, Pr);
            Output.Check_Stream (Test);
         end;

         declare
            Second : Debug_Caches.Cursor := Cache.First;
            Output : aliased Test_Tools.Memory_Stream;
            Pr : Printers.Canonical (Output'Access);
         begin
            Output.Set_Expected (Canonical_Test);
            Printers.Transfer (Second, Pr);
            Output.Check_Stream (Test);
         end;
      end;

      Info_Pool;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Debug_Instantiation;


   procedure Default_Instantiation (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Default instantiation");
   begin
      declare
         Cache : Caches.Reference;
      begin
         Inject_Test (Cache);

         declare
            First : Caches.Cursor := Cache.First;
            Output : aliased Test_Tools.Memory_Stream;
            Pr : Printers.Canonical (Output'Access);
         begin
            Output.Set_Expected (Canonical_Test);
            Printers.Transfer (First, Pr);
            Output.Check_Stream (Test);
         end;

         declare
            Second : Caches.Cursor := Cache.First;
            Output : aliased Test_Tools.Memory_Stream;
            Pr : Printers.Canonical (Output'Access);
         begin
            Output.Set_Expected (Canonical_Test);
            Printers.Transfer (Second, Pr);
            Output.Check_Stream (Test);
         end;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Default_Instantiation;

end Natools.S_Expressions.Cache_Tests;






Added tests/natools-s_expressions-cache_tests.ads.








































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Cache_Tests provides tests for generic memeory     --
-- cache in Natools.S_Expressions.Generic_Caches and its default            --
-- instantiation.                                                           --
------------------------------------------------------------------------------

with Natools.Tests;

package Natools.S_Expressions.Cache_Tests is

   package NT renames Natools.Tests;

   procedure All_Tests (Report : in out NT.Reporter'Class);

   procedure Debug_Instantiation (Report : in out NT.Reporter'Class);
   procedure Default_Instantiation (Report : in out NT.Reporter'Class);

end Natools.S_Expressions.Cache_Tests;






Changes to tests/test_all.adb.






︙


20
21
22
23
24
25
26

27
28
29
30
31
32
33

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34








+









with Ada.Command_Line;
with Ada.Text_IO;
with Natools.Chunked_Strings.Tests;
with Natools.Getopt_Long_Tests;
with Natools.Reference_Tests;
with Natools.S_Expressions.Atom_Buffers.Tests;
with Natools.S_Expressions.Cache_Tests;
with Natools.S_Expressions.Encodings.Tests;
with Natools.S_Expressions.Parsers.Tests;
with Natools.S_Expressions.Printers.Tests;
with Natools.S_Expressions.Printers.Pretty.Tests;
with Natools.String_Slice_Set_Tests;
with Natools.String_Slice_Tests;
with Natools.Tests.Text_IO;




︙


72
73
74
75
76
77
78




79
80
81
82
83
84
85

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90








+
+
+
+








   Report.Section ("References");
   Natools.Reference_Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Atom_Buffers");
   Natools.S_Expressions.Atom_Buffers.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Caches");
   Natools.S_Expressions.Cache_Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Encodings");
   Natools.S_Expressions.Encodings.Tests.All_Tests (Report);
   Report.End_Section;

   Report.Section ("S_Expressions.Parsers");
   Natools.S_Expressions.Parsers.Tests.All_Tests (Report);




︙