From a03d33b586eb52551f5ba9216b9450b17387716e Mon Sep 17 00:00:00 2001 From: Mikhalkovich Stanislav Date: Tue, 8 Mar 2022 21:41:46 +0300 Subject: [PATCH] 3.8.3 --- Configuration/GlobalAssemblyInfo.cs | 4 +- Configuration/Version.defs | 4 +- Release/pabcversion.txt | 2 +- ReleaseGenerators/PascalABCNET_version.nsh | 2 +- .../StandardSyntaxConverter.cs | 6 +- .../SugarVisitors/LoopDesugarVisitor.cs | 11 ++- .../SugarVisitors/NewRangeDesugarVisitor.cs | 2 +- TestSuite/CompilationSamples/PABCSystem.pas | 93 ++++++++++++++++++- TestSuite/CompilationSamples/School.pas | 25 ++--- TestSuite/CompilationSamples/WPFObjects.pas | 4 +- TestSuite/for_step2.pas | 8 ++ TestSuite/foreach_index1.pas | 17 ++++ TestSuite/foreach_index2.pas | 10 ++ 13 files changed, 161 insertions(+), 27 deletions(-) create mode 100644 TestSuite/for_step2.pas create mode 100644 TestSuite/foreach_index1.pas create mode 100644 TestSuite/foreach_index2.pas diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 8d26abf84..bdbaa6bee 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -14,8 +14,8 @@ internal static class RevisionClass { public const string Major = "3"; public const string Minor = "8"; - public const string Build = "2"; - public const string Revision = "3086"; + public const string Build = "3"; + public const string Revision = "3090"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 7e3a3b34b..9c5df6a1f 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=2 -%REVISION%=3086 +%COREVERSION%=3 +%REVISION%=3090 %MINOR%=8 %MAJOR%=3 diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index f68bae829..f2a9354ec 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.8.2.3086 +3.8.3.3090 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index f5da4c4be..d85a34d45 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.8.2.3086' +!define VERSION '3.8.3.3090' diff --git a/SyntaxTreeConverters/StandardSyntaxConverter.cs b/SyntaxTreeConverters/StandardSyntaxConverter.cs index 57e471a12..a01a5f8c8 100644 --- a/SyntaxTreeConverters/StandardSyntaxConverter.cs +++ b/SyntaxTreeConverters/StandardSyntaxConverter.cs @@ -40,12 +40,12 @@ namespace PascalABCCompiler.SyntaxTreeConverters StandOutExprWithLambdaInForeachSequenceAndNestedLambdasVisitor.New.ProcessNode(root); VarNamesInMethodsWithSameNameAsClassGenericParamsReplacer.New.ProcessNode(root); // SSM bug fix #1147 FindOnExceptVarsAndApplyRenameVisitor.New.ProcessNode(root); -#if DEBUG - //new SimplePrettyPrinterVisitor("E:/projs/out.txt").ProcessNode(root); -#endif // loop LoopDesugarVisitor.New.ProcessNode(root); +#if DEBUG + new SimplePrettyPrinterVisitor("D:/out.txt").ProcessNode(root); +#endif // tuple_node TupleVisitor.New.ProcessNode(root); diff --git a/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs b/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs index 391256a3c..e32311004 100644 --- a/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs +++ b/SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs @@ -99,7 +99,12 @@ namespace SyntaxVisitors.SugarVisitors var IncIh = new method_call(new ident("Inc"), exlist, i.source_context); var stlist = new statement_list(fn.statements, fn.statements.source_context); var pc = new procedure_call(IncIh, IncIh.source_context); - stlist.Add(pc); + var ig0 = new bin_expr(j.TypedClone(), new int32_const(1), Operators.Greater, i.source_context); + var ifpc = new if_node(ig0, pc, null, ig0.source_context); + + stlist.Insert(0, ifpc); + //stlist.Add(pc); + var semCheck1 = new semantic_check_sugared_statement_node(typeof(for_node), new List { a,b }, a.source_context); @@ -162,9 +167,9 @@ namespace SyntaxVisitors.SugarVisitors if (fe.index != null && !fe.index.name.StartsWith("##")) // Повторно обходить ## не надо - он для семантики { var newindex = new ident("##" + fe.index, fe.index.source_context); // нам нужно это имя на семантике для контроля неизменения переменной внутри цикла - var indexvar = new var_statement(fe.index, new int32_const(0), fe.index.source_context); + var indexvar = new var_statement(fe.index, new int32_const(-1), fe.index.source_context); var IncIndex = new assign(fe.index.TypedClone(), new int32_const(1), Operators.AssignmentAddition); - var forstat = new statement_list(fe.stmt, IncIndex); + var forstat = new statement_list(IncIndex, fe.stmt); var fe2 = new foreach_stmt(fe.identifier, fe.type_name, fe.in_what, forstat, newindex, fe.source_context); var stat = new statement_list(indexvar,fe2); ReplaceUsingParent(fe, stat); diff --git a/SyntaxVisitors/SugarVisitors/NewRangeDesugarVisitor.cs b/SyntaxVisitors/SugarVisitors/NewRangeDesugarVisitor.cs index 7915d2d75..3acb54f70 100644 --- a/SyntaxVisitors/SugarVisitors/NewRangeDesugarVisitor.cs +++ b/SyntaxVisitors/SugarVisitors/NewRangeDesugarVisitor.cs @@ -59,7 +59,7 @@ namespace SyntaxVisitors.SugarVisitors public override void visit(foreach_stmt fe) { - if (fe.in_what is diapason_expr_new diap) + if (fe.in_what is diapason_expr_new diap && fe.index == null) { var from = diap.left; var typ = fe.type_name; diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index ec35137a1..6d446a917 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -1501,6 +1501,11 @@ function GetEXEFileName: string; /// Преобразует указатель к строковому представлению function PointerToString(p: pointer): string; +/// Для типа System.Type возвращает имя типа объекта +function TypeToTypeName(t: System.Type): string; +/// Возвращает имя типа объекта +function TypeName(o: Object): string; + /// Запускает программу или документ с именем fileName procedure Exec(fileName: string); /// Запускает программу или документ с именем fileName и параметрами командной строки args @@ -7611,7 +7616,6 @@ begin TypeCode.UInt64: Result := ReadUInt64; TypeCode.SByte: Result := ReadSByte; TypeCode.Single: Result := ReadSingle; - end; end else if t.IsEnum then Result := f.br.ReadInt32 @@ -13136,6 +13140,93 @@ begin Result := L.Select(i -> i - 1) end; +/// Для типа System.Type возвращает имя типа объекта +function TypeToTypeName(t: System.Type): string; +begin + if t.IsPrimitive then + case System.Type.GetTypeCode(t) of + TypeCode.Boolean: Result := 'boolean'; + TypeCode.Char: Result := 'char'; + TypeCode.Byte: Result := 'byte'; + TypeCode.Int16: Result := 'smallint'; + TypeCode.Int32: Result := 'integer'; + TypeCode.Int64: Result := 'int64'; + TypeCode.UInt16: Result := 'word'; + TypeCode.UInt32: Result := 'longword'; + TypeCode.UInt64: Result := 'uint64'; + TypeCode.SByte: Result := 'shortint'; + TypeCode.Double: Result := 'real'; + TypeCode.Single: Result := 'single'; + end + else if t = typeof(string) then + Result := 'string' + else if t = typeof(decimal) then + Result := 'decimal' + else if t.IsArray then + begin + var ts := t.ToString; + var dims := ts.MatchValue('\[,*\]'); + if dims = '[]' then + dims := '' + else dims := dims + ' '; + Result := 'array ' + dims + 'of ' + TypeToTypeName(t.GetElementType); + end + else if t.IsGenericType then + begin + var name := t.ToString.MatchValue('\w+(?=`)'); + var ss := t.GetGenericArguments.Select(x->TypeToTypeName(x)); + if name = 'Tuple' then + Result := '('+ss.JoinToString(',')+')' + else if name = 'Func' then + begin + if ss.Count = 1 then + Result := '() -> '+ ss.Last + else if ss.Count = 2 then + Result := ss.First + ' -> '+ ss.Last + else + Result := '('+ss.SkipLast.JoinToString(',')+') -> '+ ss.Last; + end + else if name = 'Action' then + begin + if ss.Count = 1 then + Result := ss.First + ' -> ()' + else + Result := '('+ss.JoinToString(',')+') -> ()'; + end + else Result := name + '<'+ss.JoinToString(',')+'>' + end + else + begin + //Всё остальное + var s := t.ToString; + if s = 'System.Action' then + begin + Result := 'procedure'; + exit; + end; + var ind := s.LastIndexOf('.'); + if ind >= 0 then + s := s.Substring(ind + 1); + Result := s; + end; +end; + +/// Возвращает имя типа объекта +function TypeName(o: Object): string; +begin + if o = nil then + Result := 'nil' + else if o is System.Reflection.Pointer then + Result := 'pointer' + else if o.GetType.GetField('NullBasedArray') <> nil then + begin + // неточно для двумерных массивов + var fi := o.GetType.GetField('NullBasedArray'); + var f := fi.GetValue(o).GetType; + Result := TypeToTypeName(f); + end + else Result := TypeToTypeName(o.GetType); +end; ///-- function CreateSliceFromStringInternal(Self: string; from, step, count: integer): string; diff --git a/TestSuite/CompilationSamples/School.pas b/TestSuite/CompilationSamples/School.pas index 626442edd..50093872a 100644 --- a/TestSuite/CompilationSamples/School.pas +++ b/TestSuite/CompilationSamples/School.pas @@ -970,6 +970,17 @@ end; procedure SwapSubstr(var Self: string; ss1, ss2: string); extensionmethod := SwapSubstr(Self, ss1, ss2); +function InternalConvertTupleString(s: string): string; +begin + var tt := '([\w.`<>\[\],()]+?)'; + s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)'); + s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)'); + s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)'); + s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)'); + s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)'); + Result := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)'); +end; + function InternalConvertTypeString(s: string): string; begin s := s.Replace('System.Int32','integer'); @@ -984,18 +995,8 @@ begin s := Regex.Replace(s,$'{tt}\[,\]','array [,] of $1'); s := Regex.Replace(s,$'System.Collections.Generic.(Dictionary|SortedDictionary)`2\[{tt},{tt}\]','$1<$2,$3>'); s := Regex.Replace(s,$'System.Collections.Generic.(List|Stack|Queue|HashSet|SortedSet)`1\[{tt}\]','$1<$2>'); - s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)'); - s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)'); - s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)'); - s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)'); - s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)'); - s := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)'); - s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)'); - s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)'); - s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)'); - s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)'); - s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)'); - s := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)'); + s := InternalConvertTupleString(s); + s := InternalConvertTupleString(s); Result := s; end; diff --git a/TestSuite/CompilationSamples/WPFObjects.pas b/TestSuite/CompilationSamples/WPFObjects.pas index 28c327eba..1de672ddb 100644 --- a/TestSuite/CompilationSamples/WPFObjects.pas +++ b/TestSuite/CompilationSamples/WPFObjects.pas @@ -275,7 +275,7 @@ type /// Угол поворота графического объекта (по часовой стрелке) property RotateAngle: real read InvokeReal(()->rot.Angle) write Invoke(procedure->begin rot.CenterX := Width/2; rot.CenterY := Height/2; rot.Angle := value end); /// Множитель масштабирования объекта - property ScaleFactor: real read InvokeReal(()->sca.ScaleX) write Invoke(()->begin (sca.ScaleX, sca.ScaleY) := (value,value); end); + property ScaleFactor: real read InvokeReal(()->sca.ScaleX) write Invoke(()->begin sca.CenterX := Width/2; sca.CenterY := Height/2; (sca.ScaleX, sca.ScaleY) := (value,value); end); // Центр поворота графического объекта - запретил, т.к. это будет сбивать координаты объекта {property RotateCenter: Point read Invoke&(()->new Point(rot.CenterX,rot.CenterY)) @@ -366,6 +366,8 @@ type procedure AnimScaleP(a,sec: real); begin var an := new DoubleAnimation(a, System.TimeSpan.FromSeconds(sec)); + sca.CenterX := Width / 2; + sca.CenterY := Height / 2; sca.BeginAnimation(ScaleTransform.ScaleXProperty, an, HandoffBehavior.Compose); sca.BeginAnimation(ScaleTransform.ScaleYProperty, an, HandoffBehavior.Compose); end; diff --git a/TestSuite/for_step2.pas b/TestSuite/for_step2.pas new file mode 100644 index 000000000..b3223fe8e --- /dev/null +++ b/TestSuite/for_step2.pas @@ -0,0 +1,8 @@ +begin + var l := new List; + for var i:=1 to 5 step 2 do + begin + l.Add(i); + end; + Assert(l.SequenceEqual(Arr(1,3,5))); +end. \ No newline at end of file diff --git a/TestSuite/foreach_index1.pas b/TestSuite/foreach_index1.pas new file mode 100644 index 000000000..5b0659510 --- /dev/null +++ b/TestSuite/foreach_index1.pas @@ -0,0 +1,17 @@ +begin + var l := new List; + foreach var x in Arr(1,3,5) index i do + begin + l.Add(x); + l.Add(i); + end; + Assert(l.SequenceEqual(Arr(1,0,3,1,5,2))); + + l := new List; + foreach var x in 1..3 index i do + begin + l.Add(x); + l.Add(i); + end; + Assert(l.SequenceEqual(Arr(1,0,2,1,3,2))); +end. \ No newline at end of file diff --git a/TestSuite/foreach_index2.pas b/TestSuite/foreach_index2.pas new file mode 100644 index 000000000..f203a665b --- /dev/null +++ b/TestSuite/foreach_index2.pas @@ -0,0 +1,10 @@ +begin + var l := new List; + foreach var x in Arr(1,3,5) index i do + begin + l.Add(x); + l.Add(i); + continue; + end; + Assert(l.SequenceEqual(Arr(1,0,3,1,5,2))); +end. \ No newline at end of file