fix #1229

NETGenerator/Helpers.cs

@@ -515,6 +515,7 @@ 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() {}
 		
@@ -873,6 +874,16 @@ 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)
 		{

NETGenerator/NETGenerator.cs

@@ -9307,6 +9307,10 @@ namespace PascalABCCompiler.NETGenerator
             SemanticTree.ICommonMethodCallNode cmcall = ifc as SemanticTree.ICommonMethodCallNode;
             if (cmcall != null)
             {
+                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);
@@ -9323,6 +9327,10 @@ namespace PascalABCCompiler.NETGenerator
             SemanticTree.ICompiledMethodCallNode cmccall = ifc as SemanticTree.ICompiledMethodCallNode;
             if (cmccall != null)
             {
+                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);
@@ -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;
+            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);

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.