diff --git a/.gitattributes b/.gitattributes index 606f73b31b..04b3b060f2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -6287,6 +6287,7 @@ tests/webtbs/tw3898.pp svneol=native#text/plain tests/webtbs/tw3899.pp svneol=native#text/plain tests/webtbs/tw3900.pp svneol=native#text/plain tests/webtbs/tw3913.pp svneol=native#text/plain +tests/webtbs/tw3930.pp -text tests/webtbs/tw3931a.pp svneol=native#text/plain tests/webtbs/tw3939.pp svneol=native#text/plain tests/webtbs/tw3953a.pp svneol=native#text/plain diff --git a/compiler/symdef.pas b/compiler/symdef.pas index dd36a9e606..f43d105498 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -283,6 +283,7 @@ interface procedure deref; { add interface reference loaded from ppu } procedure addintf_deref(const d:tderef;iofs:longint); + procedure addintf_ioffset(d:tdef;iofs:longint); procedure clearmappings; procedure addmappings(intfindex: longint; const origname, newname: string); @@ -4275,25 +4276,35 @@ implementation function tobjectdef.getcopy : tstoreddef; + var + i, + implintfcount : longint; begin - result:=inherited getcopy; - (* result:=tobjectdef.create(objecttype,objname^,childof); - childofderef : tderef; - objname, - objrealname : pstring; - objectoptions : tobjectoptions; - { to be able to have a variable vmt position } - { and no vmt field for objects without virtuals } - vmt_offset : longint; - writing_class_record_stab : boolean; - objecttype : tobjectdeftype; - iidguid: pguid; - iidstr: pstring; - lastvtableindex: longint; - { store implemented interfaces defs and name mappings } - implementedinterfaces: timplementedinterfaces; - *) + tobjectdef(result).symtable:=symtable.getcopy; + if assigned(objname) then + tobjectdef(result).objname:=stringdup(objname^); + if assigned(objrealname) then + tobjectdef(result).objrealname:=stringdup(objrealname^); + tobjectdef(result).objectoptions:=objectoptions; + tobjectdef(result).vmt_offset:=vmt_offset; + if assigned(iidguid) then + begin + new(tobjectdef(result).iidguid); + move(iidguid^,tobjectdef(result).iidguid^,sizeof(iidguid^)); + end; + if assigned(iidstr) then + tobjectdef(result).iidstr:=stringdup(iidstr^); + tobjectdef(result).lastvtableindex:=lastvtableindex; + if assigned(implementedinterfaces) then + begin + implintfcount:=implementedinterfaces.count; + for i:=1 to implintfcount do + begin + tobjectdef(result).implementedinterfaces.addintf_ioffset(implementedinterfaces.interfaces(i), + implementedinterfaces.ioffsets(i)); + end; + end; end; @@ -5222,6 +5233,15 @@ implementation finterfaces.insert(hintf); end; + procedure timplementedinterfaces.addintf_ioffset(d:tdef;iofs:longint); + var + hintf : timplintfentry; + begin + hintf:=timplintfentry.create(tobjectdef(d)); + hintf.ioffset:=iofs; + finterfaces.insert(hintf); + end; + procedure timplementedinterfaces.addintf(def: tdef); begin if not assigned(def) or (searchintf(def)<>-1) or (def.deftype<>objectdef) or diff --git a/tests/webtbs/tw3930.pp b/tests/webtbs/tw3930.pp new file mode 100644 index 0000000000..9b77cb42b3 --- /dev/null +++ b/tests/webtbs/tw3930.pp @@ -0,0 +1,19 @@ +{$mode objfpc} +uses + classes; + +type + TMyStringList = type TStringlist; + +var + list : TMyStringList; + +begin + list:=TMyStringList.Create; + list.Free; + if pointer(TMyStringList)=pointer(TStringList) then + halt(1); + writeln('ok'); +end. + + \ No newline at end of file