Merge branch 'master' of https://github.com/pascalabcnet/pascalabcnet …

…into test

Compiler/Compiler.cs

@@ -2903,9 +2903,9 @@ private string GetReferenceFileName(string FileName, SyntaxTree.SourceContext sc
             try
             {
                 var FullFileName = Path.Combine(curr_path, FileName);
-                if (System.IO.File.Exists(FullFileName))
+                if (File.Exists(FullFileName))
                 {
-                    var NewFileName = Path.Combine(CompilerOptions.OutputDirectory, Path.GetFileName(FullFileName));
+                    var NewFileName = Path.GetFullPath(Path.Combine(CompilerOptions.OutputDirectory, Path.GetFileName(FullFileName)));
                     if (FullFileName != NewFileName)
                     {
                         if (overwrite)

Configuration/GlobalAssemblyInfo.cs

@@ -15,7 +15,7 @@ internal static class RevisionClass
 	public const string Major = "3";
 	public const string Minor = "9";
 	public const string Build = "0";
-	public const string Revision = "3495";
+	public const string Revision = "3499";
 
         public const string MainVersion = Major + "." + Minor;
 	public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

Configuration/Version.defs

@@ -1,4 +1,4 @@
 %MINOR%=9
-%REVISION%=3495
+%REVISION%=3499
 %COREVERSION%=0
 %MAJOR%=3

Release/pabcversion.txt

@@ -1 +1 @@
-3.9.0.3495
+3.9.0.3499

ReleaseGenerators/PascalABCNET_version.nsh

@@ -1 +1 @@
-!define VERSION '3.9.0.3495'
+!define VERSION '3.9.0.3499'

TestSuite/CompilationSamples/LightPT.pas

@@ -169,7 +169,10 @@ procedure CheckInput(a: array of System.Type);
 procedure CheckOutput(params arr: array of object);
 /// Проверить значения при выводе. Сообщения ColoredMessage гасить. Нужно для повторных вызовов CheckOutput
 procedure CheckOutputSilent(params arr: array of object);
-
+/// Проверить значения при выводе
+procedure CheckOutput(a: ObjectList);
+/// Проверить значения при выводе. Сообщения ColoredMessage гасить. Нужно для повторных вызовов CheckOutput
+procedure CheckOutputSilent(a: ObjectList);
 
 /// Проверить, что данные не вводились
 procedure CheckInputIsEmpty;
@@ -943,7 +946,8 @@ function IsLightPT: boolean;
 end; 
 
 /// надо ли пополнять список ввода в функциях, используемых для ввода
-function NeedAddDataToInputList: boolean := IsLightPT and ((TestMode = tmNone) or (TestMode = tmAutoTest));
+function NeedAddDataToInputList: boolean 
+  := IsLightPT and ((TestMode = tmNone) or (TestMode = tmAutoTest));
 
 /// Полный путь к папке auth-файла
 function FindAuthDat: string;
@@ -1720,6 +1724,11 @@ procedure GenerateTests<T1,T2,T3>(params a: array of (T1,T2,T3));
 /// Возвращает случайное целое в диапазоне от a до b
 function Random(a, b: integer): integer;
 begin
+  // Есть три состояния:
+  // 1. Вызов в основной программе (первый запуск) - TestMode = tmNone
+  // 2. Вызов в основной программе (последующие запуски) - TestMode = tmTest
+  // 3. Вызов в функции GenerateTestData - TestMode = tmGenTest - тогда срабатывает обычная ArrRandomInteger
+  //    как и в случае 1.  
   if TestMode = tmTest then
     Result := InputList.ReadTestDataInt // считать следующее данное из заполненного в GenTestMode InputList
   else Result := PABCSystem.Random(a, b);
@@ -1885,17 +1894,13 @@ function ArrRandomInteger(n: integer; a: integer; b: integer): array of integer;
   // Есть три состояния:
   // 1. Вызов в основной программе (первый запуск) - TestMode = tmNone
   // 2. Вызов в основной программе (последующие запуски) - TestMode = tmTest
-  // 3. Вызов в функции GenerateTestData - TestMode = tmGenTest - это только в состоянии TestMode = True
-  {if GenTest then
-  begin
-    Result := PABCSystem.ArrRandomInteger(n, a, b); // приходится вызывать дважды!
-    exit;
-  end;}
+  // 3. Вызов в функции GenerateTestData - TestMode = tmGenTest - тогда срабатывает обычная ArrRandomInteger
+  //    как и в случае 1.  
   if TestMode = tmTest then
     Result := InputList.ReadTestDataIntArr(n)
   else Result := PABCSystem.ArrRandomInteger(n, a, b); 
 
-  if NeedAddDataToInputList then // IsLightPT and (TestMode = tmNone)
+  if NeedAddDataToInputList then // IsLightPT and ((TestMode = tmNone) or (TestMode = tmAutoTest))
   for var i:=0 to n-1 do
     InputList.Add(Result[i]);
 end;
@@ -2139,23 +2144,42 @@ procedure ColoredMessage(msg: string);
   CreateNewLineBeforeMessage := False;
 end;
 
-procedure CheckOutputHelper(i0: integer; params arr: array of object);
-  procedure OutputTestResult;
+function FlattenElement(x: object): List<object>;
+begin
+  var res := new List<object>;
+  if x is IEnumerable<object> (var xen) then
+    foreach var ob in xen do
+      res.AddRange(FlattenElement(ob))
+  else if x is System.Collections.IEnumerable (var xx) then
   begin
-    ColoredMessage($'Основной запуск верный',MsgColorGray);
-    ColoredMessage($'Ошибочное решение на тесте:',MsgColorOrange);
-    ColoredMessage($'Тестовые данные      : {InputList.JoinToString}',MsgColorGray);
-    ColoredMessage($'Полученный результат : {OutputList.JoinToString}',MsgColorGray);
-    if i0 = 0 then
-      ColoredMessage($'Правильный результат : {arr.JoinToString}',MsgColorGray)
-    else ColoredMessage($'Правильный результат : {(OutputList[:i0]+arr).JoinToString}',MsgColorGray)
-  end;
+    var en := xx.GetEnumerator;
+    while en.MoveNext do
+      res.Add(en.Current)
+  end    
+  else res.Add(x);
+  Result := res;  
+end;
+
+procedure OutputTestResult(i0: integer; arr: array of object);
+begin
+  ColoredMessage($'Основной запуск верный',MsgColorGray);
+  ColoredMessage($'Ошибочное решение на тесте:',MsgColorOrange);
+  ColoredMessage($'Тестовые данные      : {InputList.JoinToString}',MsgColorGray);
+  ColoredMessage($'Полученный результат : {OutputList.JoinToString}',MsgColorGray);
+  if i0 = 0 then
+    ColoredMessage($'Правильный результат : {arr.JoinToString}',MsgColorGray)
+  else ColoredMessage($'Правильный результат : {(OutputList[:i0]+arr).JoinToString}',MsgColorGray)
+end;
 
+procedure CheckOutputHelper(i0: integer; params arr: array of object);
 begin
   if (TaskResult = InitialTask) and CancelMessagesIfInitial
      or (TaskResult = BadInitialTask) then
     exit;
-
+
+  // SSM 28.06.24 - вытягиваем в линию выходные данные
+  arr := arr.SelectMany(x -> FlattenElement(x)).ToArray;
+
   // Если мы попали сюда, то OutputList.Count >= InitialOutputList.Count
   var mn := Min(arr.Length, OutputList.Count - i0);
 
@@ -2167,7 +2191,7 @@ procedure CheckOutputHelper(i0: integer; params arr: array of object);
     then 
     begin
       if TestNumber > 0 then
-        OutputTestResult
+        OutputTestResult(i0,arr)
       else
       begin
         if i > InitialOutputList.Count then
@@ -2181,7 +2205,7 @@ procedure CheckOutputHelper(i0: integer; params arr: array of object);
       if i >= InitialOutputList.Count then // ? Если первое данное неправильное - всё равно попадаем сюда!!!
       begin
         if TestNumber > 0 then
-          OutputTestResult
+          OutputTestResult(i0,arr)
         else
         begin
           if i > InitialOutputList.Count then
@@ -2199,7 +2223,7 @@ procedure CheckOutputHelper(i0: integer; params arr: array of object);
   if arr.Length <> OutputList.Count - i0 then
   begin  
     if TestNumber > 0 then
-      OutputTestResult
+      OutputTestResult(i0,arr)
     else
     if OutputList.Count > 0 then begin
       if arr.Length > OutputList.Count - i0 then // выведено меньше чем надо
@@ -2218,13 +2242,17 @@ procedure CheckOutput(params arr: array of object);
   CheckOutputHelper(0,arr);
 end;
 
+procedure CheckOutput(a: ObjectList) := CheckOutputSeq(a);
+
 procedure CheckOutputSilent(params arr: array of object);
 begin
   Silent := True;
   CheckOutput(arr);
   Silent := False;
 end;
 
+procedure CheckOutputSilent(a: ObjectList) := CheckOutputSeqSilent(a);
+
 procedure CheckOutputAfterInitial(params arr: array of object);
 begin
   CheckOutputHelper(InitialOutputList.Count,arr);
@@ -2311,7 +2339,7 @@ procedure CheckOutputString(str: string);
   IntAr2 = array [,] of integer;
   RealAr2 = array [,] of real;
 
-function FlattenElement(x: object): List<object>; 
+{function FlattenElement(x: object): List<object>; 
 begin
   var lst := new List<object>;
   if x is IntAr (var iarr) then
@@ -2328,7 +2356,7 @@ function FlattenElement(x: object): List<object>;
     lst.AddRange(lrarr.Select(x -> object(x)))
   else lst.Add(x);
   Result := lst;
-end;
+end;}
 
 procedure FlattenOutput;
 begin
@@ -2634,6 +2662,7 @@ procedure CheckMyPT;
     TName := ConvertTaskName(TaskName);
     TestMode := tmNone;
     TestNumber := 0;
+    FlattenOutput; // SSM 28.06.24 
     CheckTask(TName); // может выдавать сообщения, предваряющие неверное решение, в CheckOutput. 
     if {not IsPT and not IsRobot and not IsDrawMan and} (TestCount > 0) then // То это LightPT - т.к. только в LightPT TestCount м.б. > 0
     begin
@@ -2660,6 +2689,7 @@ procedure CheckMyPT;
           //InputList := InputList; 
           //OutputList := OutputList; 
 
+          FlattenOutput; // SSM 28.06.24 - и перед каждым тестом
           CheckTask(TName);
           if TaskResult = BadSolution then
             break; // хоть один тест неудачный - выходим!

TestSuite/CompilationSamples/PABCSystem.pas

@@ -5016,7 +5016,9 @@ function operator**(x: BigInteger; y: integer): BigInteger; extensionmethod := P
 //------------------------------------------------------------------------------
 //          Операции для BigInteger
 //------------------------------------------------------------------------------
-function BigInteger.operator/(p: BigInteger; q: real) := real(p)/q;
+function operator/(p: BigInteger; q: real); extensionmethod := real(p)/q;
+
+// function operator/(p: BigInteger; q: integer); extensionmethod := real(p)/q;
 
 function BigInteger.operator/(q: real; p: BigInteger) := q/real(p);
 
@@ -5050,7 +5052,7 @@ procedure BigInteger.operator*=(var p: BigInteger; q: BigInteger) := p := p * q;
 
 procedure BigInteger.operator-=(var p: BigInteger; q: BigInteger) := p := p - q;
 
-function BigInteger.operator div(p: BigInteger; q: integer) := BigInteger.Divide(p,q);
+//function BigInteger.operator div(p: BigInteger; q: integer) := BigInteger.Divide(p,q);
 
 function BigInteger.operator mod(p: BigInteger; q: integer) := BigInteger.Remainder(p,q);
 
@@ -5215,7 +5217,34 @@ function Range(a, b, step: real): sequence of real;
     raise new System.ArgumentException('step = 0');
   if (step > 0) and (b < a) or (step < 0) and (b > a) then
     exit;
-  var n := Round(Abs(b - a) / step);
+  if a = b then 
+  begin
+    yield a;
+    exit;
+  end;
+  // SSM 30/06/24
+  // Шкалируем [a,b] к отрезку [0,1]
+  var stepScaled := decimal(step) / (decimal(a) - decimal(b));
+  if stepScaled < 0 then
+    stepScaled := -stepScaled;
+  // Находим n - количество частей (левая точка последней части может не входить)
+  var n := decimal.ToInt32(decimal.Round(1/stepScaled));
+  //Println('-->',stepScaled,n);
+  // Возможны 3 ситуации:
+  // 1) - stepScaled * n < 1 - 1e-14 - тогда надо делать n+1 шаг
+  // 2) - stepScaled * n и диапазоне [1 - 1e-14, 1 + 1e-14] - тогда надо делать n+1 шаг и последнюю точку примагничивать к b
+  // 3) - stepScaled * n > 1 + 1e-14 - тогда надо делать n шагов
+  // Сделаем n шагов, а потом решим, делать ли последний шаг
+  for var i:=0 to n-1 do
+    yield a + i * step; // нельзя просто прибавлять step - при больших a,b они просто не будут меняться
+  var delta := decimal(1e-14); // относительная погрешность относительно 1 
+  if (stepScaled * n >= 1 - delta) and (stepScaled * n <= 1 + delta) then
+    yield b // вернуть ровно b - то, ради чего всё затевалось
+  else if stepScaled * n < 1 - delta then
+    yield a + n * step; // что ж, step задан неверно и мы "не долетаем" до b
+  // Если "перелетаем" b, то ничего и не возвращаем на конце
+  // Старый алгоритм
+  {var n := Round(Abs(b - a) / step);
   var delta := n / Abs(b - a) * 1e-14;
   var bplus := b + delta;
   var bminus := b - delta;
@@ -5238,7 +5267,7 @@ function Range(a, b, step: real): sequence of real;
     end;
     if a > bminus then
       yield b;
-  end
+  end}
 end;
 
 function ArrRandom(n: integer; a: integer; b: integer): array of integer;