Skip to content

rtti: skip generic methods in the legacy VMT method table (fixes upstream#41410) #41

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Moonbot-Tech wants to merge 1 commit into
base: main
Choose a base branch
from
Open

rtti: skip generic methods in the legacy VMT method table (fixes upstream#41410) #41

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions compiler/ncgvmt.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -462,7 +462,8 @@ TMsgInt = record
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if (pd.procsym=tsym(p)) and
(pd.visibility=vis_published) then
(pd.visibility=vis_published) and
not pd.is_generic then
inc(plongint(arg)^);
end;
end;
Expand Down Expand Up @@ -490,7 +491,8 @@ tvmtasmoutput = record
begin
pd:=tprocdef(Tprocsym(p).ProcdefList[i]);
if (pd.procsym=tsym(p)) and
(pd.visibility=vis_published) then
(pd.visibility=vis_published) and
not pd.is_generic then
begin
{ l: name_of_method }
lists^.pubmethodstcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,datatcb,l);
Expand Down
44 changes: 44 additions & 0 deletions tests/webtbs/tw41410.pp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
program tw41410;

{$mode delphi}

type
{$M+}
TContainer = class
private
FValue: Integer;
published
procedure Ping;
procedure Test<T>(const AValue: T);
end;
{$M-}

procedure TContainer.Ping;
begin
FValue := 7;
end;

procedure TContainer.Test<T>(const AValue: T);
begin
FValue := SizeOf(AValue);
end;

var
Container: TContainer;
begin
Container := TContainer.Create;
try
if Container.MethodAddress('Ping') = nil then
Halt(1);
if Container.MethodAddress('Test') <> nil then
Halt(2);
Container.Ping;
if Container.FValue <> 7 then
Halt(3);
Container.Test<Int64>(42);
if Container.FValue <> SizeOf(Int64) then
Halt(4);
finally
Container.Free;
end;
end.