unit testProc;
interface
uses
System.Sysutils,
DUnitX.TestFramework;
type
[TestFixture]
TestTproc =
class(TObject)
private
function GetProc(
const Value : integer): TProc;
public
[TEST]
procedure test2vars;
[TEST]
procedure test2refernce;
end;
implementation
{ TestTproc }
type
PIInterface = ^IInterface;
function TestTproc.GetProc(
const Value : integer): TProc;
begin
result :=
procedure
Var x : integer;
begin
x := 2 * Value;
if x > 3
then;
end;
end;
procedure TestTproc.test2vars;
var lp1, lp2 : Tproc;
obj1, obj2: TInterfacedObject;
begin
lp1 := GetProc(1);
lp2 := GetProc(1);
assert.AreNotEqual<Tproc>(lp1, lp2);
obj1 := PIInterface(@lp1)^
as TInterfacedObject;
obj2 := PIInterface(@lp2)^
as TInterfacedObject;
// Will fail....
assert.AreEqual<TInterfacedObject>(obj1, obj2);
end;
procedure TestTproc.test2refernce;
var lp1, lp2 : Tproc;
obj1, obj2: TInterfacedObject;
begin
lp1 := GetProc(1);
lp2 := lp1;
assert.AreEqual<Tproc>(lp1, lp2);
obj1 := PIInterface(@lp1)^
as TInterfacedObject;
obj2 := PIInterface(@lp2)^
as TInterfacedObject;
assert.AreEqual<TInterfacedObject>(obj1, obj2);
end;
initialization
TDUnitX.RegisterTestFixture(TestTproc);
end.