diff --git a/.gitattributes b/.gitattributes index a6f6840991..bf33be9003 100644 --- a/.gitattributes +++ b/.gitattributes @@ -10646,6 +10646,7 @@ tests/webtbs/tw1592.pp svneol=native#text/plain tests/webtbs/tw15930.pp svneol=native#text/plain tests/webtbs/tw16004.pp svneol=native#text/plain tests/webtbs/tw16018.pp svneol=native#text/plain +tests/webtbs/tw16034.pp svneol=native#text/plain tests/webtbs/tw16040.pp svneol=native#text/plain tests/webtbs/tw16065.pp svneol=native#text/pascal tests/webtbs/tw16083.pp svneol=native#text/plain diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 554b1fa27a..63b2c58233 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -4421,12 +4421,14 @@ implementation tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,sizeof(pint)); tObjectSymtable(symtable).alignrecord(tObjectSymtable(symtable).datasize,sizeof(pint)); end; - - vmt_offset:=tObjectSymtable(symtable).datasize; vs:=tfieldvarsym.create('_vptr$'+objname^,vs_value,voidpointertype,[]); hidesym(vs); tObjectSymtable(symtable).insert(vs); tObjectSymtable(symtable).addfield(vs,vis_hidden); + if (tObjectSymtable(symtable).usefieldalignment<>bit_alignment) then + vmt_offset:=vs.fieldoffset + else + vmt_offset:=vs.fieldoffset div 8; include(objectoptions,oo_has_vmt); end; end; diff --git a/tests/webtbs/tw16034.pp b/tests/webtbs/tw16034.pp new file mode 100644 index 0000000000..3bee77feb0 --- /dev/null +++ b/tests/webtbs/tw16034.pp @@ -0,0 +1,160 @@ +program Hello; + +{$ifdef fpc} +{$mode delphi} +{$endif} + +{$APPTYPE CONSOLE} +{$O-} + +type + ptr = pointer; + Int = ptrint; + pPtr = ^ptr; + UInt = ptruint; + Bool = Boolean; + + // Object woth VMT at offset 0. + TObj0 = + object + Constructor Init; + Function Value(p: UInt): UInt; Virtual; + enD; + + // Object with VMT at offset 0, and size = 5. + TObj1 = + object (TObj0) + f1: Byte; // UInt; + + Constructor Init; + Function Value(p: UInt): UInt; Virtual; + enD; + + // Object with VMT at offset 0, but size = 8. (???) + TObj2 = + object + f1{, f2, f3, f4}: Byte; // UInt; + + Constructor Init; + Function Value(p: UInt): UInt; Virtual; + enD; + +{ Implmentation } + +Constructor TObj0.Init; +begin +enD; + +Function TObj0.Value(p: UInt): UInt; +begin + Result := 0; +enD; + +Constructor TObj1.Init; +begin +enD; + +Function TObj1.Value(p: UInt): UInt; +begin + Result := 0; +enD; + +Constructor TObj2.Init; +begin +enD; + +Function TObj2.Value(p: UInt): UInt; +begin + Result := 0; +enD; + +{ Low Level VMT Routines } + +type + pObjVMT = ^TObjVMT; + TObjVMT = + record + fInstanceSize: UInt; + fInstanceSize2: Int; + fParent: pObjVMT; + enD; + +Function GetInstanceSize(AVMT: pObjVMT): UInt; +begin + Result := AVMT.fInstanceSize; +enD; + +Function GetVMTPtrOffset(AVMT: pObjVMT): UInt; +begin + if (AVMT.fParent = nil) then + Result := GetInstanceSize(AVMT) - SizeOf(ptr) else + Result := GetVMTPtrOffset(AVMT.fParent); +enD; + +Function SetVMT(Obj: ptr; AVMT: ptr): Bool; +begin + Result := (AVMT <> nil); + + if (Result) then + pPtr(UInt(Obj) + GetVMTPtrOffset(AVMT))^ := AVMT; +enD; + + +{ Main } + +var + O0: TObj0; + O1: TObj1; + O2: TObj2; + + s0, s1, s2: UInt; + v0, v1, v2: ptr; + cn0, cn1, cn2: ptr; + +begin + // VMT Pointers + v0 := TypeOf(TObj0); + v1 := TypeOf(TObj1); + v2 := TypeOf(TObj2); + + // Object sizes + s0 := SizeOf(TObj0); // = 4 + s1 := SizeOf(TObj1); // = 5 + s2 := SizeOf(TObj2); // = 8 (???) + writeln(s0); + writeln(s1); + writeln(s2); + + // Method pointers + cn0 := @TObj0.Value; + cn1 := @TObj1.Value; + cn2 := @TObj2.Value; + + // VMT offsets (use in watches - need in program!) +// Int(@o0._vptr$) - Int(@o0) = 0 +// Int(@o1._vptr$) - Int(@o1) = 0 +// Int(@o2._vptr$) - Int(@o2) = 1 (???) + +{ + // Constructors - skipping + O0.Init; + O1.Init; + O2.Init; +} + + // Store VMT (emulate constructor) + SetVMT(@O0, TypeOf(TObj0)); + SetVMT(@O1, TypeOf(TObj1)); + SetVMT(@O2, TypeOf(TObj2)); + + // Call Virtual Functions + O2.f1 := O0.Value(0); + O2.f1 := O1.Value(0); + O2.f1 := O2.Value(0); {CRASHES !!!} + { SizeOf(TObj2) must be 5, + or ptr(Int(@o2._vptr$) - Int(@o2)) must be 4! } + + // MessageBox will be displayed, if all was successfull + writeln(O2.f1, 'Hello, FPC uWorld!', 'Hello', 0); +end. +