From f406dfd1732df1f432d2604917badfbac47ab9e6 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: Fri, 10 Aug 2018 14:22:52 +0200 Subject: [PATCH] fix #917 --- TestSuite/lambdas6.pas | 15 +++++++++++++++ TestSuite/lambdas_closures_8.pas | 4 ++-- TestSuite/lambdas_generics1.pas | 4 +++- TestSuite/lambdas_generics2.pas | 2 +- TestSuite/lambdas_generics5.pas | 3 ++- TestSuite/lambdas_in_generics_1.pas | 4 ++-- TestSuite/property6.pas | 5 +++++ .../TreeConversion/syntax_tree_visitor.cs | 3 +++ 8 files changed, 33 insertions(+), 7 deletions(-) create mode 100644 TestSuite/lambdas6.pas diff --git a/TestSuite/lambdas6.pas b/TestSuite/lambdas6.pas new file mode 100644 index 000000000..6a541efa8 --- /dev/null +++ b/TestSuite/lambdas6.pas @@ -0,0 +1,15 @@ +function f1(self:array of byte; a:byte):byte; extensionmethod := a+1; + +procedure p1(self:T; f:()->byte); extensionmethod; +begin + assert(f = 1); + assert(f() = 1); +end; + +begin + var a:array of byte; + SetLength(a, 2); + var b:byte; + b.p1(()->a.f1(0)); + +end. \ No newline at end of file diff --git a/TestSuite/lambdas_closures_8.pas b/TestSuite/lambdas_closures_8.pas index 109c1614f..01449b4a4 100644 --- a/TestSuite/lambdas_closures_8.pas +++ b/TestSuite/lambdas_closures_8.pas @@ -1,5 +1,5 @@ -begin +begin var f: IntFunc := x->x*4; var g: IntFunc := x->x + f(0); - f(1); + assert(f(1) = 4); end. \ No newline at end of file diff --git a/TestSuite/lambdas_generics1.pas b/TestSuite/lambdas_generics1.pas index 00ccb1563..bf92be592 100644 --- a/TestSuite/lambdas_generics1.pas +++ b/TestSuite/lambdas_generics1.pas @@ -1,8 +1,10 @@ +var o: object; procedure p(a: System.Func; b:System.Func; c: X); begin - writeln(a(c)); + o := a(c); end; begin p(x -> x, x -> 1.0, 4.0); + assert(Round(real(o)) = 4); end. diff --git a/TestSuite/lambdas_generics2.pas b/TestSuite/lambdas_generics2.pas index 8a96da517..524cf087e 100644 --- a/TestSuite/lambdas_generics2.pas +++ b/TestSuite/lambdas_generics2.pas @@ -1,4 +1,4 @@ -uses System, System.Collections.Generic, System.Linq; +uses System, System.Collections.Generic, System.Linq; type Customer = class public diff --git a/TestSuite/lambdas_generics5.pas b/TestSuite/lambdas_generics5.pas index db67c93e4..6acd907e7 100644 --- a/TestSuite/lambdas_generics5.pas +++ b/TestSuite/lambdas_generics5.pas @@ -1,8 +1,9 @@ -begin +begin var a := new System.Collections.Generic.List(); a.Add('abc'); a.Add('def'); var b := a.SelectMany(x -> x).Select(x -> x); foreach var c in b do writeln(c); + assert(b.SequenceEqual(Seq('a','b','c','d','e','f'))); end. \ No newline at end of file diff --git a/TestSuite/lambdas_in_generics_1.pas b/TestSuite/lambdas_in_generics_1.pas index 241cee31c..ff057dbb9 100644 --- a/TestSuite/lambdas_in_generics_1.pas +++ b/TestSuite/lambdas_in_generics_1.pas @@ -1,9 +1,9 @@ -function psd(e: IEnumerable): IEnumerable; where T:constructor; +function psd(e: IEnumerable): IEnumerable; where T:constructor; begin result := e.OrderBy(x -> x); end; begin var ttt := psd(Seq(1,2,4,2,3,5,6)); - writeln(ttt); + assert(ttt.SequenceEqual(Seq(1,2,2,3,4,5,6))); end. \ No newline at end of file diff --git a/TestSuite/property6.pas b/TestSuite/property6.pas index 5b579fccd..e307c853f 100644 --- a/TestSuite/property6.pas +++ b/TestSuite/property6.pas @@ -1,11 +1,13 @@ type TBaseClass = abstract class property p1: byte read write; abstract; + property p2: byte read; abstract; end; TClass = class(TBaseClass) b: byte; property p1: byte read b write b; override; + property p2: byte read b; override; end; TClass2 = class(TBaseClass) @@ -13,13 +15,16 @@ function getb := b; procedure setb(value: byte) := b := value; property p1: byte read getb write setb; override; + property p2: byte read getb; override; end; begin var o: TBaseClass := new TClass; o.p1 := 2; assert(o.p1 = 2); + assert(o.p2 = 2); o := new TClass2; o.p1 := 2; assert(o.p1 = 2); + assert(o.p2 = 2); end. \ No newline at end of file diff --git a/TreeConverter/TreeConversion/syntax_tree_visitor.cs b/TreeConverter/TreeConversion/syntax_tree_visitor.cs index 0b06bbbf2..3adf48099 100644 --- a/TreeConverter/TreeConversion/syntax_tree_visitor.cs +++ b/TreeConverter/TreeConversion/syntax_tree_visitor.cs @@ -18728,6 +18728,7 @@ namespace PascalABCCompiler.TreeConverter expression_node qq = null; delegated_methods dm = null; common_type_node delegate_type = null; + int err_cnt = ErrorsList.Count; try { qq = convert_strong(ff.dereferencing_value); @@ -18738,6 +18739,8 @@ namespace PascalABCCompiler.TreeConverter } catch (Exception e) { + if (ErrorsList.Count != err_cnt)//delete fake errors + ErrorsList.RemoveRange(err_cnt, ErrorsList.Count - err_cnt); // Погасить все исключения. Значит, не вывелось, и в правой части лямбды - не вызов процедуры, а скорее всего приведение типа T(x) // К сожалению, сюда попадает случай a->a.Print() где a до более позднего этапа не определяется // Плохо, но лучше пока не получается