From 62b2a4ac10067a83dc274a9a835073e90fe76c9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=91=D0=BE=D0=BD=D0=B4=D0=B0=D1=80=D0=B5=D0=B2=20=D0=98?= =?UTF-8?q?=D0=B2=D0=B0=D0=BD?= Date: Tue, 2 Oct 2018 22:11:07 +0200 Subject: [PATCH] fix #1229 --- NETGenerator/Helpers.cs | 15 +++++++++++++-- NETGenerator/NETGenerator.cs | 36 ++++++++++++++++++++++++++++++++---- TestSuite/delegates10.pas | 23 +++++++++++++++++++++++ 3 files changed, 68 insertions(+), 6 deletions(-) create mode 100644 TestSuite/delegates10.pas diff --git a/NETGenerator/Helpers.cs b/NETGenerator/Helpers.cs index 6c6e6b43e..e68b46c72 100644 --- a/NETGenerator/Helpers.cs +++ b/NETGenerator/Helpers.cs @@ -515,7 +515,8 @@ namespace PascalABCCompiler.NETGenerator { private Hashtable processing_types = new Hashtable(); private MethodInfo arr_mi=null; private Hashtable pas_defs = new Hashtable(); - + private Hashtable memoized_exprs = new Hashtable(); + public Helper() {} public void AddPascalTypeReference(ITypeNode tn, Type t) @@ -873,8 +874,18 @@ namespace PascalABCCompiler.NETGenerator { return processing_types[type] != null; } + public void LinkExpressionToLocalBuilder(IExpressionNode expr, LocalBuilder lb) + { + memoized_exprs[expr] = lb; + } + + public LocalBuilder GetLocalBuilderForExpression(IExpressionNode expr) + { + return memoized_exprs[expr] as LocalBuilder; + } + //получение типа - public TypeInfo GetTypeReference(ITypeNode type) + public TypeInfo GetTypeReference(ITypeNode type) { TypeInfo ti = defs[type] as TypeInfo; if (ti != null) diff --git a/NETGenerator/NETGenerator.cs b/NETGenerator/NETGenerator.cs index fa0206665..bcf38685d 100644 --- a/NETGenerator/NETGenerator.cs +++ b/NETGenerator/NETGenerator.cs @@ -7378,7 +7378,7 @@ namespace PascalABCCompiler.NETGenerator bool is_comp_gen = false; for (int i = 0; i < real_parameters.Length; i++) { - if (real_parameters[i] is INullConstantNode && parameters[i].type.is_nullable_type) + if (real_parameters[i] is INullConstantNode && parameters[i].type.is_nullable_type) { Type tp = helper.GetTypeReference(parameters[i].type).tp; LocalBuilder lb = il.DeclareLocal(tp); @@ -9307,7 +9307,11 @@ namespace PascalABCCompiler.NETGenerator SemanticTree.ICommonMethodCallNode cmcall = ifc as SemanticTree.ICommonMethodCallNode; if (cmcall != null) { - cmcall.obj.visit(this); + LocalBuilder memoized_lb = helper.GetLocalBuilderForExpression(cmcall.obj); + if (memoized_lb != null) + il.Emit(OpCodes.Ldloc, memoized_lb); + else + cmcall.obj.visit(this); if (cmcall.obj.type.is_value_type) il.Emit(OpCodes.Box, helper.GetTypeReference(cmcall.obj.type).tp); else if (cmcall.obj.conversion_type != null && cmcall.obj.conversion_type.is_value_type) @@ -9323,7 +9327,11 @@ namespace PascalABCCompiler.NETGenerator SemanticTree.ICompiledMethodCallNode cmccall = ifc as SemanticTree.ICompiledMethodCallNode; if (cmccall != null) { - cmccall.obj.visit(this); + LocalBuilder memoized_lb = helper.GetLocalBuilderForExpression(cmccall.obj); + if (memoized_lb != null) + il.Emit(OpCodes.Ldloc, memoized_lb); + else + cmccall.obj.visit(this); if (cmccall.obj.type.is_value_type) il.Emit(OpCodes.Box, helper.GetTypeReference(cmccall.obj.type).tp); else if (cmccall.obj.conversion_type != null && cmccall.obj.conversion_type.is_value_type) @@ -9902,7 +9910,27 @@ namespace PascalABCCompiler.NETGenerator bool tmp_is_addr = is_addr; is_dot_expr = false;//don't box the condition expression is_addr = false; - value.condition.visit(this); + LocalBuilder funcptr_lb = null; + if (value.condition is IBasicFunctionCallNode && + (value.condition as IBasicFunctionCallNode).real_parameters[0].type.IsDelegate && + (value.condition as IBasicFunctionCallNode).real_parameters[1] is INullConstantNode && + (value.condition as IBasicFunctionCallNode).basic_function.basic_function_type == basic_function_type.objeq) + { + IBasicFunctionCallNode eq = (value.condition as IBasicFunctionCallNode); + funcptr_lb = il.DeclareLocal(helper.GetTypeReference((value.condition as IBasicFunctionCallNode).real_parameters[0].type).tp); + eq.real_parameters[0].visit(this); + il.Emit(OpCodes.Stloc, funcptr_lb); + il.Emit(OpCodes.Ldloc, funcptr_lb); + il.Emit(OpCodes.Ldnull); + il.Emit(OpCodes.Ceq); + if (value.ret_if_false is ICommonConstructorCall) + helper.LinkExpressionToLocalBuilder((value.condition as IBasicFunctionCallNode).real_parameters[0], funcptr_lb); + else if (value.ret_if_false is ICompiledConstructorCall) + helper.LinkExpressionToLocalBuilder((value.condition as IBasicFunctionCallNode).real_parameters[0], funcptr_lb); + } + else + value.condition.visit(this); + is_dot_expr = tmp_is_dot_expr; is_addr = tmp_is_addr; il.Emit(OpCodes.Brfalse, FalseLabel); diff --git a/TestSuite/delegates10.pas b/TestSuite/delegates10.pas new file mode 100644 index 000000000..a024b66d4 --- /dev/null +++ b/TestSuite/delegates10.pas @@ -0,0 +1,23 @@ +var i: integer; + +function f1: procedure; +begin + Inc(i); + Result := procedure ()->exit; +end; + +procedure test(p: procedure); +begin + p(); +end; + +begin + var p: procedure; + p := f1(); + p(); + assert(i = 1); + test(f1); + assert(i = 2); + p := f1 <> nil ? f1 : nil; + assert(i = 4); +end. \ No newline at end of file