From e9676f56b8e10b3040ae8e9cc775ba788f23c980 Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 27 Dec 2004 15:55:32 +0000 Subject: [PATCH] no message --- tests/test/dumpclass.pp | 70 ++++++++++++++++++++++++----------------- 1 file changed, 41 insertions(+), 29 deletions(-) diff --git a/tests/test/dumpclass.pp b/tests/test/dumpclass.pp index d458de7eef..b627dd1166 100644 --- a/tests/test/dumpclass.pp +++ b/tests/test/dumpclass.pp @@ -4,9 +4,9 @@ program DumpClass; uses Classes, SysUtils; - + const - VMT_COUNT = 100; + VMT_COUNT = 100; type @@ -20,32 +20,40 @@ type Entries: packed array[0..9999999] of TMethodNameTableEntry; end; PMethodNameTable = ^TMethodNameTable; - + TPointerArray = packed array[0..9999999] of Pointer; PPointerArray = ^TPointerArray; - + PFieldInfo = ^TFieldInfo; TFieldInfo = packed record FieldOffset: LongWord; ClassTypeIndex: Word; Name: ShortString; end; - + PFieldClassTable = ^TFieldClassTable; - TFieldClassTable = packed record + TFieldClassTable = +{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed +{$endif FPC_REQUIRES_PROPER_ALIGNMENT} + record Count: Word; Entries: array[Word] of TPersistentClass; end; PFieldTable = ^TFieldTable; - TFieldTable = packed record + TFieldTable = +{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT} + packed +{$endif FPC_REQUIRES_PROPER_ALIGNMENT} + record FieldCount: Word; ClassTable: PFieldClassTable; { Fields: array[Word] of TFieldInfo; Elements have variant size! } end; - + {$M+} - TMyTest = class(TObject) + TMyTest = class(TObject) published F1: TMyTest; F2: TMyTest; @@ -55,7 +63,7 @@ type {$M-} TMyTest2 = class(TMyTest) - F3: TMyTest; + F3: TMyTest; F4: TMyTest; procedure P2; override; procedure P3; virtual; @@ -65,28 +73,28 @@ type procedure P1; virtual; procedure P2; virtual; end; - -procedure TMyTest.P1; + +procedure TMyTest.P1; begin end; -procedure TMyTest.P2; +procedure TMyTest.P2; begin end; -procedure TMyTest2.P2; +procedure TMyTest2.P2; begin end; -procedure TMyTest2.P3; +procedure TMyTest2.P3; begin end; -procedure TMyPersistent.P1; +procedure TMyPersistent.P1; begin end; -procedure TMyPersistent.P2; +procedure TMyPersistent.P2; begin end; @@ -100,7 +108,7 @@ var Indent: String; n, idx: Integer; SearchAddr: Pointer; -begin +begin WriteLn('---------------------------------------------'); WriteLn('Dump of ', AClass.ClassName); WriteLn('---------------------------------------------'); @@ -109,7 +117,7 @@ begin begin WriteLn(Indent, 'Processing ', AClass.Classname); Indent := Indent + ' '; - + //--- Cmnt := PPointer(Pointer(AClass) + vmtMethodTable)^; if Cmnt <> nil @@ -117,11 +125,11 @@ begin WriteLn(Indent, 'Method count: ', IntToStr(Cmnt^.Count)); Cvmt := Pointer(AClass) + vmtMethodStart; - + for n := 0 to Cmnt^.Count - 1 do - begin + begin Write(Indent, 'Search: ', Cmnt^.Entries[n].Name^); - + SearchAddr := Cmnt^.Entries[n].Addr; for idx := 0 to VMT_COUNT - 1 do begin @@ -135,11 +143,11 @@ begin WriteLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', AClass.ClassName, '"'); Break; end; - end; + end; end; end; - - + + //--- Cft := PPointer(Pointer(AClass) + vmtFieldTable)^; if Cft <> nil @@ -147,22 +155,26 @@ begin WriteLn(Indent, 'Field count: ', Cft^.FieldCount); fi := @Cft^.ClassTable + SizeOf(Cft^.ClassTable); for n := 0 to Cft^.FieldCount - 1 do - begin + begin +{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} + pointer(fi):=align(fi,sizeof(pointer)); +{$endif FPC_REQUIRES_PROPER_ALIGNMENT} + Move(fi^.FieldOffset, FieldOffset, SizeOf(FieldOffset)); WriteLn(Indent, ' ', n, ': ', fi^.Name, ' @', FieldOffset); fi := @fi^.name + 1 + Ord(fi^.name[0]); end; WriteLn(Indent, 'Field class count: ', Cft^.ClassTable^.Count); for n := 0 to Cft^.ClassTable^.Count - 1 do - begin + begin WriteLn(Indent, ' ', n, ': ', Cft^.ClassTable^.Entries[n].ClassName); end; end; - + AClass := AClass.ClassParent; end; end; - + begin ClassDump(TMyTest); ClassDump(TMyTest2);