Overview
| Comment: | reference_tests: full-coverage test suite for reference counter |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
681c468a7d248121c8971aaabb6b1c0f |
| User & Date: | nat on 2013-09-23 18:26:25 |
| Other Links: | manifest | tags |
Context
|
2013-09-24
| ||
| 18:28 | references: add storage pool formal parameters check-in: 779fe5056a user: nat tags: trunk | |
|
2013-09-23
| ||
| 18:26 | reference_tests: full-coverage test suite for reference counter check-in: 681c468a7d user: nat tags: trunk | |
|
2013-09-22
| ||
| 15:29 | References: new package implementing a reference counter check-in: 4306b2b680 user: nat tags: trunk | |
Changes
Added tests/natools-reference_tests.adb version [a304628ce9].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 184 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 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 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 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 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 |
------------------------------------------------------------------------------
-- Copyright (c) 2013, 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 Natools.References.Tools;
package body Natools.Reference_Tests is
package Tools is new Refs.Tools;
procedure Check_Ref
(Report : in out NT.Reporter'Class;
Name : in String;
Ref : in Refs.Reference;
Expected_Count : in Natural;
Continue : in out Boolean);
-- Check the given reference and report failure if any
-- Do nothing if Continue is False
procedure Check_Consistency
(Report : in out NT.Reporter'Class;
Name : in String;
Left, Right : in Refs.Reference;
Continue : in out Boolean);
-- Check consistency between two reference and report if failed
-- Do nothing if Continue is False
procedure Check_Count
(Report : in out NT.Reporter'Class;
Name : in String;
Expected_Count : in Integer;
Continue : in out Boolean);
-- Check instance count and report failure if any
-- Do nothing if Continue is False
--------------------
-- Object counter --
--------------------
function Factory return Counter is
begin
Instance_Count := Instance_Count + 1;
return Counter'(Ada.Finalization.Limited_Controlled with
Instance_Number => Instance_Count);
end Factory;
overriding procedure Finalize (Object : in out Counter) is
pragma Unreferenced (Object);
begin
Instance_Count := Instance_Count - 1;
end Finalize;
------------------------
-- Helper subprograms --
------------------------
procedure Check_Consistency
(Report : in out NT.Reporter'Class;
Name : in String;
Left, Right : in Refs.Reference;
Continue : in out Boolean) is
begin
if Continue and then not Tools.Is_Consistent (Left, Right) then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Inconsistent references found");
Continue := False;
end if;
end Check_Consistency;
procedure Check_Count
(Report : in out NT.Reporter'Class;
Name : in String;
Expected_Count : in Integer;
Continue : in out Boolean) is
begin
if not Continue then
return;
end if;
if Instance_Count < 0 then
NT.Item (Report, Name, NT.Fail);
NT.Info
(Report,
"Invalid Instance_Count " & Integer'Image (Instance_Count));
Continue := False;
elsif Instance_Count /= Expected_Count then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Unexpected Instance_Count"
& Integer'Image (Instance_Count)
& " instead of"
& Integer'Image (Expected_Count));
Continue := False;
end if;
end Check_Count;
procedure Check_Ref
(Report : in out NT.Reporter'Class;
Name : in String;
Ref : in Refs.Reference;
Expected_Count : in Natural;
Continue : in out Boolean)
is
Actual_Count : constant Integer := Tools.Count (Ref);
begin
if not Continue then
return;
end if;
if not Tools.Is_Valid (Ref) then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Invalid internal state for reference");
Continue := False;
elsif Actual_Count /= Expected_Count then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report,
"Unexpected reference count"
& Natural'Image (Actual_Count)
& " instead of"
& Natural'Image (Expected_Count));
Continue := False;
end if;
end Check_Ref;
--------------------
-- Invidual tests --
--------------------
procedure Test_Data_Access (Report : in out NT.Reporter'Class) is
Argument_Count : Natural;
Result : Boolean;
procedure Check (Self : in Counter);
procedure Set (Self : in out Counter);
procedure Check (Self : in Counter) is
begin
Result := Argument_Count = Self.Instance_Number;
Argument_Count := Self.Instance_Number;
end Check;
procedure Set (Self : in out Counter) is
begin
Self.Instance_Number := Argument_Count;
end Set;
Name : constant String := "Data access";
begin
declare
Ref_1 : Refs.Reference := Refs.Create (Factory'Access);
Ref_2 : Refs.Reference;
begin
Ref_2.Replace (Factory'Access);
Argument_Count := 42;
Ref_2.Update (Set'Access);
Ref_1.Update.Data.Instance_Number := 18;
Argument_Count := 18;
Ref_1.Query (Check'Access);
if not Result then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Stored 18, retrieved"
& Integer'Image (Argument_Count));
return;
end if;
Ref_1.Reset;
Argument_Count := Ref_2.Query.Data.Instance_Number;
if Argument_Count /= 42 then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Stored 42, retrieved"
& Integer'Image (Argument_Count));
return;
end if;
end;
NT.Item (Report, Name, NT.Success);
exception
when Error : others => NT.Report_Exception (Report, Name, Error);
end Test_Data_Access;
procedure Test_Double_Finalize (Report : in out NT.Reporter'Class) is
Name : constant String := "Double finalize";
Initial_Count : constant Integer := Instance_Count;
Continue : Boolean := True;
begin
declare
Ref : Refs.Reference := Refs.Create (Factory'Access);
begin
Ref.Finalize;
end;
Check_Count (Report, Name, Initial_Count, Continue);
if Continue then
NT.Item (Report, Name, NT.Success);
end if;
exception
when Error : others => NT.Report_Exception (Report, Name, Error);
end Test_Double_Finalize;
procedure Test_Instance_Counts (Report : in out NT.Reporter'Class) is
Name : constant String := "Instance counts";
Initial_Count : constant Integer := Instance_Count;
Continue : Boolean := True;
begin
declare
procedure Check (Count_0, Count_1, Count_2, Delta_I : in Integer);
Ref_0 : Refs.Reference := Refs.Create (Factory'Access);
Ref_1, Ref_2 : Refs.Reference;
procedure Check (Count_0, Count_1, Count_2, Delta_I : in Integer) is
begin
Check_Ref (Report, Name, Ref_0, Count_0, Continue);
Check_Ref (Report, Name, Ref_1, Count_1, Continue);
Check_Ref (Report, Name, Ref_2, Count_2, Continue);
Check_Consistency (Report, Name, Ref_0, Ref_1, Continue);
Check_Consistency (Report, Name, Ref_1, Ref_2, Continue);
Check_Consistency (Report, Name, Ref_2, Ref_0, Continue);
Check_Count (Report, Name, Initial_Count + Delta_I, Continue);
end Check;
begin
Check (1, 0, 0, 1);
if Continue then
Ref_1 := Refs.Create (Factory'Access);
end if;
Check (1, 1, 0, 2);
if Continue then
Ref_2 := Ref_0;
end if;
Check (2, 1, 2, 2);
if Continue then
Ref_1 := Ref_0;
end if;
Check (3, 3, 3, 1);
if Continue then
Ref_2.Replace (Factory'Access);
end if;
Check (2, 2, 1, 2);
if Continue then
Ref_1.Reset;
Ref_0 := Ref_1;
end if;
Check (0, 0, 1, 1);
end;
Check_Count (Report, Name, Initial_Count, Continue);
if Continue then
NT.Item (Report, Name, NT.Success);
end if;
exception
when Error : others => NT.Report_Exception (Report, Name, Error);
end Test_Instance_Counts;
procedure Test_Reference_Counts (Report : in out NT.Reporter'Class) is
Name : constant String := "Reference counts";
Initial_Count : constant Integer := Instance_Count;
Continue : Boolean := True;
begin
declare
procedure Check (Count_0, Count_1, Count_2 : in Integer);
Ref_0 : constant Refs.Reference := Refs.Create (Factory'Access);
Ref_1 : Refs.Reference := Ref_0;
Ref_2 : Refs.Reference;
procedure Check (Count_0, Count_1, Count_2 : in Integer) is
begin
Check_Ref (Report, Name, Ref_0, Count_0, Continue);
Check_Ref (Report, Name, Ref_1, Count_1, Continue);
Check_Ref (Report, Name, Ref_2, Count_2, Continue);
Check_Consistency (Report, Name, Ref_0, Ref_1, Continue);
Check_Consistency (Report, Name, Ref_1, Ref_2, Continue);
Check_Consistency (Report, Name, Ref_2, Ref_0, Continue);
end Check;
begin
Check (2, 2, 0);
if Continue then
Ref_2 := Ref_0;
end if;
Check (3, 3, 3);
if Continue then
Refs.Reset (Ref_1);
end if;
Check (2, 0, 2);
end;
Check_Count (Report, Name, Initial_Count, Continue);
if Continue then
NT.Item (Report, Name, NT.Success);
end if;
exception
when Error : others => NT.Report_Exception (Report, Name, Error);
end Test_Reference_Counts;
procedure Test_Reference_Tests (Report : in out NT.Reporter'Class) is
Name : constant String := "Reference tests";
Initial_Count : constant Integer := Instance_Count;
Continue : Boolean := True;
begin
declare
use type Refs.Reference;
Ref : Refs.Reference;
Base : constant Refs.Reference := Refs.Create (Factory'Access);
begin
if not Ref.Is_Empty then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Default reference is not empty");
return;
end if;
if Base.Is_Empty then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Created reference is empty");
return;
end if;
Ref.Replace (Factory'Access);
if Ref.Is_Empty then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Replaced reference is empty");
return;
end if;
if Ref = Base then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Unexpected equality between Ref and Base");
return;
end if;
Ref := Base;
if Ref /= Base then
NT.Item (Report, Name, NT.Fail);
NT.Info (Report, "Unexpected inequality between Ref and Base");
return;
end if;
end;
Check_Count (Report, Name, Initial_Count, Continue);
if Continue then
NT.Item (Report, Name, NT.Success);
end if;
exception
when Error : others => NT.Report_Exception (Report, Name, Error);
end Test_Reference_Tests;
---------------------
-- Test everything --
---------------------
procedure All_Tests (Report : in out NT.Reporter'Class) is
begin
Test_Data_Access (Report);
Test_Double_Finalize (Report);
Test_Instance_Counts (Report);
Test_Reference_Counts (Report);
Test_Reference_Tests (Report);
end All_Tests;
end Natools.Reference_Tests;
|
Added tests/natools-reference_tests.ads version [83c515b4b0].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
------------------------------------------------------------------------------
-- Copyright (c) 2013, 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.Reference_Tests is a test suite for Natools.References --
-- reference-counted object holder. --
------------------------------------------------------------------------------
with Natools.Tests;
private with Ada.Finalization;
-- private with GNAT.Debug_Pools;
private with Natools.References;
package Natools.Reference_Tests is
package NT renames Natools.Tests;
procedure All_Tests (Report : in out NT.Reporter'Class);
procedure Test_Data_Access (Report : in out NT.Reporter'Class);
procedure Test_Double_Finalize (Report : in out NT.Reporter'Class);
procedure Test_Instance_Counts (Report : in out NT.Reporter'Class);
procedure Test_Reference_Counts (Report : in out NT.Reporter'Class);
procedure Test_Reference_Tests (Report : in out NT.Reporter'Class);
private
Instance_Count : Integer := 0;
type Counter is new Ada.Finalization.Limited_Controlled with record
Instance_Number : Natural := 0;
end record;
function Factory return Counter;
overriding procedure Finalize (Object : in out Counter);
-- Pool : GNAT.Debug_Pools.Debug_Pool;
package Refs is new Natools.References (Counter);
-- (Counter, System.Pool_Global.Global_Pool_Object, Pool);
end Natools.Reference_Tests;
|
Added tests/natools-references-tools.adb version [a1e1a8435d].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
------------------------------------------------------------------------------
-- Copyright (c) 2013, 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. --
------------------------------------------------------------------------------
package body Natools.References.Tools is
function Is_Consistent (Left, Right : Reference) return Boolean is
begin
return (Left.Data = Right.Data) = (Left.Count = Right.Count);
end Is_Consistent;
function Is_Valid (Ref : Reference) return Boolean is
begin
return (Ref.Data = null) = (Ref.Count = null);
end Is_Valid;
function Count (Ref : Reference) return Natural is
begin
if Ref.Count /= null then
return Natural (Ref.Count.all);
else
return 0;
end if;
end Count;
end Natools.References.Tools;
|
Added tests/natools-references-tools.ads version [a4216fce60].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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) 2013, 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.References.Tools exposes subprograms to peek into private parts --
-- of Natools.Reference, for debug or testing purposes. --
------------------------------------------------------------------------------
generic
package Natools.References.Tools is
function Is_Consistent (Left, Right : Reference) return Boolean;
-- Check that counter and data equality are consistent
function Is_Valid (Ref : Reference) return Boolean;
-- Check consistency for internal state
function Count (Ref : Reference) return Natural;
-- Return the number of references to held object
end Natools.References.Tools;
|
Modified tests/test_all.adb from [2d7c0309a9] to [33dccb6b64].
| ︙ | ︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
-- Test_All is a binary gathering all tests from Natools components. --
-----------------------------------------------------------------------
with Ada.Command_Line;
with Ada.Text_IO;
with Natools.Chunked_Strings.Tests;
with Natools.Getopt_Long_Tests;
with Natools.Tests.Text_IO;
procedure Test_All is
package Uneven_Chunked_Strings is new Natools.Chunked_Strings
(Default_Allocation_Unit => 7,
Default_Chunk_Size => 15);
package Uneven_Chunked_Strings_Tests is new Uneven_Chunked_Strings.Tests;
| > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
-- Test_All is a binary gathering all tests from Natools components. --
-----------------------------------------------------------------------
with Ada.Command_Line;
with Ada.Text_IO;
with Natools.Chunked_Strings.Tests;
with Natools.Getopt_Long_Tests;
with Natools.Reference_Tests;
with Natools.Tests.Text_IO;
procedure Test_All is
package Uneven_Chunked_Strings is new Natools.Chunked_Strings
(Default_Allocation_Unit => 7,
Default_Chunk_Size => 15);
package Uneven_Chunked_Strings_Tests is new Uneven_Chunked_Strings.Tests;
|
| ︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
Report.Section ("Chunked_String with single allocation unit");
Single_Chunked_Strings_Tests.All_Tests (Report);
Report.End_Section;
Report.Section ("Getopt_Long");
Natools.Getopt_Long_Tests.All_Tests (Report);
Report.End_Section;
Natools.Tests.Text_IO.Print_Results (Report.Total_Results);
declare
Results : constant Natools.Tests.Result_Summary := Report.Total_Results;
begin
if Results (Natools.Tests.Fail) > 0 or
| > > > > | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
Report.Section ("Chunked_String with single allocation unit");
Single_Chunked_Strings_Tests.All_Tests (Report);
Report.End_Section;
Report.Section ("Getopt_Long");
Natools.Getopt_Long_Tests.All_Tests (Report);
Report.End_Section;
Report.Section ("References");
Natools.Reference_Tests.All_Tests (Report);
Report.End_Section;
Natools.Tests.Text_IO.Print_Results (Report.Total_Results);
declare
Results : constant Natools.Tests.Result_Summary := Report.Total_Results;
begin
if Results (Natools.Tests.Fail) > 0 or
|
| ︙ | ︙ |