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: |
04e35d38a158e05d204e309963034abb |
| 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);
|
| ︙ |