Starting to refactor the core object "WTestCase" into Testa.TestCase

This commit is contained in:
R. Tyler Croy 2011-12-29 22:55:50 -08:00
parent 8338e4f8bf
commit 40ea1ceafb
4 changed files with 24 additions and 12 deletions

11
src/testa.ads Normal file
View File

@ -0,0 +1,11 @@
package Testa is
type TestCase is tagged private;
type Test_Method_Type is access procedure (T : in out TestCase);
private
type TestCase is tagged record
To_Invoke : Test_Method_Type := null;
end record;
end Testa;

View File

@ -4,23 +4,23 @@ with Ada.Text_IO;
use Ada.Text_IO;
package body WasRun is
procedure Run (T : in out TestCase) is
procedure Run (T : in out WTestCase) is
begin
T.Method_To_Invoke (T);
end Run;
procedure Test_Method (T : in out TestCase) is
procedure Test_Method (T : in out WTestCase) is
begin
T.WasRun := True;
end Test_Method;
procedure Set_Method (T : in out TestCase;
procedure Set_Method (T : in out WTestCase;
M : in Test_Method_Type) is
begin
T.Method_To_Invoke := M;
end Set_Method;
procedure Print_WasRun(T : in TestCase) is
procedure Print_WasRun(T : in WTestCase) is
begin
if T.WasRun then
Put_Line ("WasRun => True");

View File

@ -1,20 +1,21 @@
with Testa;
package WasRun is
type TestCase is tagged private;
type WTestCase is tagged private;
procedure Run (T : in out TestCase);
procedure Test_Method (T : in out TestCase);
procedure Print_WasRun (T : in TestCase);
procedure Run (T : in out WTestCase);
procedure Test_Method (T : in out WTestCase);
procedure Print_WasRun (T : in WTestCase);
type Test_Method_Type is access procedure (T : in out TestCase);
type Test_Method_Type is access procedure (T : in out WTestCase);
procedure Set_Method (T : in out TestCase;
procedure Set_Method (T : in out WTestCase;
M : in Test_Method_Type);
private
type TestCase is tagged record
type WTestCase is new Testa.TestCase with record
WasRun : Boolean := False;
Method_To_Invoke : Test_Method_Type;
end record;

View File

@ -5,7 +5,7 @@ with WasRun;
use Ada.Text_IO;
procedure WasRun_Runner is
WasRunTest : WasRun.TestCase;
WasRunTest : WasRun.WTestCase;
begin
Put_Line ("Starting WasRun Runner");
WasRunTest.Set_Method (WasRun.Test_Method'Access);