Overview
| Comment: | reference_tests: add a test for the implicit dereference |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
263f8e760e730e47a63ea16bda733359 |
| User & Date: | nat on 2014-11-27 22:25:18 |
| Other Links: | manifest | tags |
Context
|
2014-11-28
| ||
| 22:37 | constant_indefinite_ordered_maps: add Ada 2012 iterator and indexing interfaces check-in: 327414fdc7 user: nat tags: trunk | |
|
2014-11-27
| ||
| 22:25 | reference_tests: add a test for the implicit dereference check-in: 263f8e760e user: nat tags: trunk | |
|
2014-11-26
| ||
| 20:13 | references: add Implicit_Dereference aspects check-in: 3a18c0edc9 user: nat tags: trunk | |
Changes
Modified tests/natools-reference_tests.adb from [2ff64e22d8] to [8f83a23777].
| ︙ | ︙ | |||
237 238 239 240 241 242 243 244 245 246 247 248 249 250 |
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
| > > > > > > > > > > > > > > > > > > > > > > > | 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 |
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_Implicit_Dereference (Report : in out NT.Reporter'Class) is
Test : NT.Test := Report.Item ("Implicit dereference");
Other_Number : constant Integer := 123;
procedure Set_Number (Object : in out Counter);
procedure Set_Number (Object : in out Counter) is
begin
Object.Instance_Number := Other_Number;
end Set_Number;
begin
declare
Ref : constant Refs.Reference := Refs.Create (Factory'Access);
Original_Number : constant Natural := Ref.Query.Instance_Number;
begin
Set_Number (Ref.Update);
Ref.Update.Instance_Number := Original_Number;
end;
exception
when Error : others => Test.Report_Exception (Error);
end Test_Implicit_Dereference;
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
|
| ︙ | ︙ | |||
488 489 490 491 492 493 494 495 496 497 498 499 500 |
-- 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;
| > | 511 512 513 514 515 516 517 518 519 520 521 522 523 524 |
-- Test everything --
---------------------
procedure All_Tests (Report : in out NT.Reporter'Class) is
begin
Test_Data_Access (Report);
Test_Double_Finalize (Report);
Test_Implicit_Dereference (Report);
Test_Instance_Counts (Report);
Test_Reference_Counts (Report);
Test_Reference_Tests (Report);
end All_Tests;
end Natools.Reference_Tests;
|
Modified tests/natools-reference_tests.ads from [4f9c866773] to [c49c1a9bf8].
| ︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
package NT renames Natools.Tests;
procedure All_Tests (Report : in out NT.Reporter'Class);
-- All tests except Test_Task_Safety (see the Note above)
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);
procedure Test_Task_Safety (Report : in out NT.Reporter'Class);
private
| > | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 |
package NT renames Natools.Tests;
procedure All_Tests (Report : in out NT.Reporter'Class);
-- All tests except Test_Task_Safety (see the Note above)
procedure Test_Data_Access (Report : in out NT.Reporter'Class);
procedure Test_Double_Finalize (Report : in out NT.Reporter'Class);
procedure Test_Implicit_Dereference (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);
procedure Test_Task_Safety (Report : in out NT.Reporter'Class);
private
|
| ︙ | ︙ |