Natools

Check-in [04e35d38a1]
Login
Overview
Comment:s_expressions-test_tools: new helper procedure to test exception throwing from all atom accessors
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 04e35d38a158e05d204e309963034abbca4556ae
User & Date: nat on 2014-02-18 20:34:44
Other Links: manifest | tags
Context
2014-02-19
20:43
s_expressions-test_tools: new helper procedures to update and test a Descriptor in a single call check-in: b5759ad827 user: nat tags: trunk
2014-02-18
20:34
s_expressions-test_tools: new helper procedure to test exception throwing from all atom accessors check-in: 04e35d38a1 user: nat tags: trunk
2014-02-17
19:43
s_expressions-test_tools: new helper procedure to test all atom accessors at once check-in: 962add2a19 user: nat tags: trunk
Changes

Modified tests/natools-s_expressions-test_tools.adb from [157c2660bd] to [25a91785a5].

305
306
307
308
309
310
311




































































312
313
314
315
316
317
318
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386







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







      end Short_Read_Atom_Test;

      if Print_Expected then
         Dump_Atom (Test, Expected, "Expected");
      end if;
   end Test_Atom_Accessors;


   procedure Test_Atom_Accessor_Exceptions
     (Test : in out NT.Test;
      Tested : in Descriptor'Class) is
   begin
      if Tested.Current_Event = Events.Add_Atom then
         Test.Error ("Test_Atom_Accessor_Exceptions during Events.Add_Atom");
         return;
      end if;

      Current_Atom_Test :
      begin
         declare
            Data : constant Atom := Tested.Current_Atom;
         begin
            Test.Fail ("No exception raised in Current_Atom");
            Dump_Atom (Test, Data, "Returned value");
         end;
      exception
         when Program_Error => null;
         when Error : others =>
            Test.Fail ("Wrong exception raised in Current_Atom");
            Test.Report_Exception (Error, NT.Fail);
      end Current_Atom_Test;

      Query_Atom_Test :
      declare
         procedure Process (Data : in Atom);

         Calls : Natural := 0;
         Buffer : Atom_Buffers.Atom_Buffer;

         procedure Process (Data : in Atom) is
         begin
            Calls := Calls + 1;
            Buffer.Append (Data);
         end Process;
      begin
         Tested.Query_Atom (Process'Access);

         Test.Fail ("No exception raised in Query_Atom");
         Dump_Atom (Test, Buffer.Data,
           "Buffer from" & Natural'Image (Calls) & " calls");
      exception
         when Program_Error => null;
         when Error : others =>
            Test.Fail ("Wrong exception raised in Query_Atom");
            Test.Report_Exception (Error, NT.Fail);
      end Query_Atom_Test;

      Read_Atom_Test :
      declare
         Buffer : Atom (0 .. 31) := (others => 46);
         Length : Count;
      begin
         Tested.Read_Atom (Buffer, Length);

         Test.Fail ("No exception raised in Read_Atom");
         Test.Info ("Returned Length:" & Count'Image (Length));
         Dump_Atom (Test, Buffer, "Output Buffer");
      exception
         when Program_Error => null;
         when Error : others =>
            Test.Fail ("Wrong exception raised in Read_Atom");
            Test.Report_Exception (Error, NT.Fail);
      end Read_Atom_Test;
   end Test_Atom_Accessor_Exceptions;



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

   overriding procedure Read

Modified tests/natools-s_expressions-test_tools.ads from [92a8d34147] to [e24a8f627e].

59
60
61
62
63
64
65





66
67
68
69
70
71
72
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77







+
+
+
+
+







   procedure Test_Atom_Accessors
     (Test : in out NT.Test;
      Tested : in Descriptor'Class;
      Expected : in Atom;
      Expected_Level : in Integer := -1);
      --  Test all the ways of accessing atom in Tested

   procedure Test_Atom_Accessor_Exceptions
     (Test : in out NT.Test;
      Tested : in Descriptor'Class);
      --  Check that all atom accessors raise Program_Error


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

   overriding procedure Read
     (Stream : in out Memory_Stream;
      Item : out Ada.Streams.Stream_Element_Array;
      Last : out Ada.Streams.Stream_Element_Offset);