3.8.3

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 Build = "3";
-	public const string Revision = "3086";
+	public const string Revision = "3090";
 
         public const string MainVersion = Major + "." + Minor;
 	public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

Configuration/Version.defs

@@ -1,4 +1,4 @@
-%COREVERSION%=2
+%COREVERSION%=3
-%REVISION%=3086
+%REVISION%=3090
 %MINOR%=8
 %MAJOR%=3

Release/pabcversion.txt

@@ -1 +1 @@
-3.8.2.3086
+3.8.3.3090

ReleaseGenerators/PascalABCNET_version.nsh

@@ -1 +1 @@
-!define VERSION '3.8.2.3086'
+!define VERSION '3.8.3.3090'

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);

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<syntax_tree_node> { 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);

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;

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;

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 := InternalConvertTupleString(s);
-  s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)');
+  s := InternalConvertTupleString(s);
-  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)');
   Result := s;
 end;
 

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&<Point>(()->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;

TestSuite/for_step2.pas

@@ -0,0 +1,8 @@
+begin
+  var l := new List<integer>;
+  for var i:=1 to 5 step 2 do
+  begin  
+    l.Add(i);
+  end;  
+  Assert(l.SequenceEqual(Arr(1,3,5)));
+end.

TestSuite/foreach_index1.pas

@@ -0,0 +1,17 @@
+begin
+  var l := new List<integer>;
+  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<integer>;
+  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.

TestSuite/foreach_index2.pas

@@ -0,0 +1,10 @@
+begin
+  var l := new List<integer>;
+  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.