Natools

Check-in [9ff0437f97]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:s_expressions-test_tools: add versions of Dump_Atom and Test_Atom for the new Test type
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9ff0437f978baf1203b2e93639c4c9da00bcd4e7
User & Date: nat on 2014-01-25 16:04:43
Other Links: manifest | tags
Context
2014-01-26
13:26
s_expressions-printers-pretty: new package providing a S-expression pretty printer check-in: 803c3f82a0 user: nat tags: trunk
2014-01-25
16:04
s_expressions-test_tools: add versions of Dump_Atom and Test_Atom for the new Test type check-in: 9ff0437f97 user: nat tags: trunk
2014-01-24
21:59
tests: new interface using finalization to ensure reporting is correct in all code paths check-in: 444efe557e user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified tests/natools-s_expressions-test_tools.adb from [a3c92b3b45] to [b83412e9a0].

︙
126
127
128
129
130
131
132
133

134
135
136
137
138






























139
140
141
142
143
144
145

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








-
+





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








            Report.Info (Label & ": """ & To_String (Data) & '"');
         else
            Report.Info ('"' & To_String (Data) & '"');
         end if;
      else
         if Label'Length > 0 then
            Report.Info
              (Label & ": " & Natural'Image (Data'Length) & " octets");
              (Label & ":" & Natural'Image (Data'Length) & " octets");
         end if;

         while I < Data'Length loop
            Length := Offset'Min (16, Data'Length - I);
            Report.Info (Hex_Slice
              (I, 8,
               Data (Data'First + I .. Data'First + I + Length - 1), 16));
            I := I + 16;
         end loop;
      end if;
   end Dump_Atom;


   procedure Dump_Atom  --  Cut and pasted code because generics crash gnat
     (Test : in out NT.Test;
      Data : in Atom;
      Label : in String := "")
   is
      I, Length : Offset := 0;
   begin
      if Is_Printable (Data) then
         if Label'Length > 0 then
            Test.Info (Label & ": """ & To_String (Data) & '"');
         else
            Test.Info ('"' & To_String (Data) & '"');
         end if;
      else
         if Label'Length > 0 then
            Test.Info
              (Label & ":" & Natural'Image (Data'Length) & " octets");
         end if;

         while I < Data'Length loop
            Length := Offset'Min (16, Data'Length - I);
            Test.Info (Hex_Slice
              (I, 8,
               Data (Data'First + I .. Data'First + I + Length - 1), 16));
            I := I + 16;
         end loop;
      end if;
   end Dump_Atom;
︙
155
156
157
158
159
160
161













162
163
164
165
166
167
168

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211








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








      else
         Report.Item (Test_Name, NT.Fail);
         Dump_Atom (Report, Found, "Found");
         Dump_Atom (Report, Expected, "Expected");
      end if;
   end Test_Atom;


   procedure Test_Atom
     (Test : in out NT.Test;
      Expected : in Atom;
      Found : in Atom) is
   begin
      if Found /= Expected then
         Test.Fail;
         Dump_Atom (Test, Found, "Found");
         Dump_Atom (Test, Expected, "Expected");
      end if;
   end Test_Atom;



   -------------------
   -- Memory Stream --
   -------------------

   overriding procedure Read
︙

Modified tests/natools-s_expressions-test_tools.ads from [938b61502e] to [44f4289719].

︙
32
33
34
35
36
37
38




39
40
41
42
43
44
45
46
47




48
49
50
51
52
53
54

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








+
+
+
+









+
+
+
+








package Natools.S_Expressions.Test_Tools is
   pragma Preelaborate (Test_Tools);

   package NT renames Natools.Tests;

   procedure Dump_Atom
     (Report : in out NT.Reporter'Class;
      Data : in Atom;
      Label : in String := "");
   procedure Dump_Atom
     (Test : in out NT.Test;
      Data : in Atom;
      Label : in String := "");
      --  Dump contents on Data as info in Report

   procedure Test_Atom
     (Report : in out NT.Reporter'Class;
      Test_Name : in String;
      Expected : in Atom;
      Found : in Atom);
   procedure Test_Atom
     (Test : in out NT.Test;
      Expected : in Atom;
      Found : in Atom);
      --  Report success when Found is equal to Expected, and failure
      --  with diagnostics otherwise.


   type Memory_Stream is new Ada.Streams.Root_Stream_Type with private;

   overriding procedure Read
︙

This page was generated in about 0.004s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47