administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

bug fix #2158

Browse source
This commit is contained in:
Бондарев Иван 2019-12-22 14:58:12 +01:00
parent 3b7bf665ef
commit aefc784d26
2 changed files with 54 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
NETGenerator/NETGenerator.cs
View file

@ -9601,7 +9601,13 @@ namespace PascalABCCompiler.NETGenerator
}
}
PushObjectCommand(ifc);
il.Emit(OpCodes.Ldftn, mi);
if (mi.IsVirtual || mi.IsAbstract)
{
il.Emit(OpCodes.Dup);
il.Emit(OpCodes.Ldvirtftn, mi);
}
else
il.Emit(OpCodes.Ldftn, mi);
il.Emit(OpCodes.Newobj, cnstr);
return;
}
@ -9614,8 +9620,6 @@ namespace PascalABCCompiler.NETGenerator
}
is_dot_expr = false;
bool need_fee = false;
bool is_comp_gen = false;
EmitArguments(parameters, real_parameters);
if (value.new_obj_awaited())
{
@ -9689,7 +9693,13 @@ namespace PascalABCCompiler.NETGenerator
}
}
PushObjectCommand(ifc);
il.Emit(OpCodes.Ldftn, mi);
if (mi.IsVirtual || mi.IsAbstract)
{
il.Emit(OpCodes.Dup);
il.Emit(OpCodes.Ldvirtftn, mi);
}
else
il.Emit(OpCodes.Ldftn, mi);
il.Emit(OpCodes.Newobj, value.constructor.constructor_info);
return;
}

40
TestSuite/delegates13.pas Normal file
View file

@ -0,0 +1,40 @@
var i: integer;
type
t0 = abstract class
procedure p0; abstract;
procedure p2; virtual;
begin
end;
procedure p3;
begin
i := 3;
end;
end;
t1 = class(t0)
procedure p0; override;
begin
i := 1;
end;
procedure p2; override;
begin
i := 2;
end;
end;
procedure p1(p: Action0);
begin
p();
end;
begin
var a := new t1 as t0;
p1(a.p0);
assert(i = 1);
p1(a.p2);
assert(i = 2);
p1(a.p3);
assert(i = 3);
end.