Test suite results for test file test/tclass8.pp

Test run data :

Test file "test/tclass8.pp" information:

t_id 1380
t_version 1.1
t_adddate 2004/10/24
t_result 0
t_knownrunerror 0

Detailed test run results:

Record count: 1

No log of 734839.

Source:

{ %version=1.1 }

{$mode objfpc}

uses
  classes;

type

{$M+}
  TTestCaseTest = class(TObject)
  published
    procedure TestSetUp;
    procedure TestAsString;
  end;

procedure TTestCaseTest.TestSetup;
begin
  writeln('TestSetup');
end;

procedure TTestCaseTest.TestAsString;
begin
  writeln('TestAsString');
end;

function GetMethodNameTableAddress(AClass: TClass): Pointer;
type
  TMethodNameRec = packed record
    name : pshortstring;
    addr : pointer;
  end;

  TMethodNameTable = packed record
    count : dword;
    entries : packed array[0..0] of TMethodNameRec;
  end;

  pMethodNameTable =  ^TMethodNameTable;

var
  methodTable : pMethodNameTable;
  vmt: TClass;
begin
  vmt := aClass;
  if assigned(vmt) then
  begin
    methodTable := pMethodNameTable((Pointer(vmt) + vmtMethodTable)^);
    Result := methodTable;
  end;
end;

begin
  writeln('Address of TestSetUp : ',ptrint(TTestCaseTest.MethodAddress('TestSetUp')));
  writeln('Address of TestAsString : ',ptrint(TTestCaseTest.MethodAddress('TestAsString')));
  if not (Assigned(GetMethodNameTableAddress(TTestCaseTest))) then
    halt(1);
end.

Link to SVN view of test/tclass8.pp source.