TypeClassErrors - папка для ошибок с typeclasses

PosEx - исправлено поведение - теперь не генерируется исключение

CodeExamples/Typeclasses/TypeClassErrors/TypeClasses.pas

@@ -0,0 +1,114 @@
+unit TypeClasses;
+
+type
+  TMonth = (January, February, March, April, May, June, July, August, September, October, November, December);
+  Ordering = (_EQ, _LT, _GT);
+
+type
+  // ---Typeclasses---
+  Eq[T] = typeclass
+    function operator=(x, y: T): boolean := not (x <> y);
+    function operator<>(x, y: T): boolean := not (x = y);
+  end;
+  
+  Ord[T] = typeclass(Eq[T])
+    function compare(x, y: T): Ordering;
+    begin
+      if x = y then
+        Result := _EQ
+      else if less(x, y) then
+        Result := _LT
+      else
+        Result := _GT;
+    end;
+    
+    function Less(x, y: T): boolean := compare(x, y) = _LT;
+    function Greater(x, y: T): boolean := compare(x, y) = _GT;
+    function LessEqual(x, y: T): boolean := compare(x, y) <> _GT;
+    function GreaterEqual(x, y: T): boolean := compare(x, y) <> _LT;
+
+    function operator>(x, y: T): boolean := greater(x, y);
+    function operator<(x, y: T): boolean := less(x, y);
+    function operator>=(x, y: T): boolean := greaterEqual(x, y);
+    function operator<=(x, y: T): boolean := lessEqual(x, y);
+    
+    function Min(x, y: T): T := x < y ? x : y;
+    function Max(x, y: T): T := x > y ? y : x;
+  end;
+
+  Show[T] = typeclass
+    function Show(x: T): string;
+  end;
+  
+  Read[T] = typeclass
+    function Read(s:string): T;
+  end;
+    
+  Bounded[T] = typeclass
+    function MinBound: T;
+    function MaxBound: T;
+  end;
+  
+  Num[T] = typeclass(Eq[T], Show[T])
+    function operator+(x, y: T): T;
+    function operator-(x, y: T): T := x + negate(y);
+    function operator*(x, y: T): T;
+    function negate(x: T): T := FromInteger(0) - x;
+    function Abs(x: T): T;
+    function Sign(x: T): T;
+    function fromInteger(x: integer): T;
+  end;
+  
+// ---Instances---
+   
+  Eq[integer] = instance
+    function operator=(x, y: integer):boolean := integer.Equals(x, y);
+  end;
+  
+  Ord[integer] = instance
+    {function compare(x, y: integer): Ordering;
+    begin
+      if x = y then
+        Result := _EQ
+      else if x < y then
+        Result := _LT
+      else
+        Result := _GT;
+    end;}
+    function Less(x, y: integer): boolean := x < y;
+  end;   
+    
+  Show[boolean] = instance
+    function show(x: boolean): string := x ? 'Правда': 'Ложь';
+  end;
+  
+  Read[TMonth] = instance
+    function read(s: string): TMonth;
+    begin
+      var t := typeof(TMonth);
+      Result := TMonth(System.Enum.Parse(t, s));
+    end;
+  end;
+  
+  Bounded[integer] = instance
+    function minBound: integer := integer.MinValue;
+    function maxBound: integer := integer.MaxValue;
+  end;
+  
+  Show[integer] = instance
+    function show(x: integer): string := x.ToString();
+  end;
+   
+  Num[integer] = instance
+    function operator+(x, y: integer): integer := x + y;
+    function operator-(x, y: integer): integer := x - y;
+    function operator*(x, y: integer): integer := x * y;
+    function Negate(x: integer): integer := -x;
+    function Abs(x: integer): integer := PABCSystem.Abs(x);
+    function Sign(x: integer): integer := PABCSystem.Sign(x);
+    function FromInteger(x: integer): integer := x;
+  end;
+
+
+begin
+end.

CodeExamples/Typeclasses/TypeClassErrors/lesserr1.pas

@@ -0,0 +1,27 @@
+// Undefined FileName(0) : Нельзя использовать override в коротких функциях без явно опредленного типа возвращаемого значения
+// И выскакивает окно, тк Вы не определили Source Context
+
+type 
+  Less[T] = typeclass
+    function operator<(x, y: T): boolean;
+  end;
+  Less[integer] = instance
+    function operator<(x, y: integer) := x<y;
+  end;
+
+function MinIndex<T>(a: array of T): integer; where Less[T];
+begin
+  Result := -1;
+  var min := a[0]; 
+  for var i:=0 to a.Length - 1 do
+    if a[i]<min then
+    begin
+      Result := i;
+      min := a[i];
+    end;
+end;
+
+begin
+  var a := Arr(10,3,5,7,8); 
+  MinIndex(a).Println;
+end.

CodeExamples/Typeclasses/TypeClassErrors/lesserr2.pas

@@ -0,0 +1,26 @@
+// lesserr2.pas(23) : Невозможно вывести типы-параметры generic-подпрограммы MinIndex (укажите типы-параметры явно)
+// Дб другое сообщение об ошибке: Для типа integer не определено соответствие классу типов Less 
+type 
+  Less[T] = typeclass
+    function operator<(x, y: T): boolean;
+  end;
+  {Less[integer] = instance
+    function operator<(x, y: integer): boolean := x<y;
+  end;}
+
+function MinIndex<T>(a: array of T): integer; where Less[T];
+begin
+  Result := -1;
+  var min := a[0]; 
+  for var i:=0 to a.Length - 1 do
+    if a[i]<min then
+    begin
+      Result := i;
+      min := a[i];
+    end;
+end;
+
+begin
+  var a := Arr(10,3,5,7,8); 
+  MinIndex(a).Println;
+end.

CodeExamples/Typeclasses/TypeClassErrors/tc1.pas

@@ -0,0 +1,24 @@
+uses TypeClasses;
+
+type 
+  Person = auto class
+    name: string;
+    age: integer;
+  end;
+  
+  Ord[Person] = instance
+    function operator=(x, y: Person): boolean := x.name = y.name;
+    function Less(x, y: Person): boolean := x.name < y.name;
+  end;   
+  
+procedure ppp<T>(p1,p2: T); where Ord[T];
+begin
+  Print(p1=p2);
+  Print(p1<p2);
+end;
+
+begin
+  var p1 := new Person('Ivanov',20);
+  var p2 := new Person('Ivanov',20);
+  ppp(p1,p2);
+end.

CodeExamples/Typeclasses/TypeClassErrors/tc1_err1.pas

@@ -0,0 +1,18 @@
+uses TypeClasses;
+
+type 
+  Person = auto class
+    name: string;
+    age: integer;
+  end;
+  
+procedure ppp(p: Person); where Ord[Person];
+begin
+  
+end;
+
+begin
+  var p1 := new Person('Ivanov',20);
+  var p2 := new Person('Ivanov',20);
+  Print(p1=p2);
+end.

CodeExamples/Typeclasses/TypeClassErrors/tc1_err2.pas

@@ -0,0 +1,28 @@
+uses TypeClasses;
+
+type 
+  Person = auto class
+    name: string;
+    age: integer;
+  end;
+  
+  Eq[Person] = instance
+    function operator=(x, y: Person): boolean := x.name = y.name;
+  end;   
+
+  Ord[Person] = instance
+    //function operator=(x, y: Person): boolean := x.name = y.name;
+    function Less(x, y: Person): boolean := x.name < y.name;
+  end;   
+  
+procedure ppp<T>(p1,p2: T); where Ord[T];
+begin
+  Print(p1=p2);
+  Print(p1<p2);
+end;
+
+begin
+  var p1 := new Person('Ivanov',20);
+  var p2 := new Person('Ivanov',20);
+  ppp(p1,p2);
+end.

CodeExamples/Typeclasses/TypeClassErrors/tc2.pas

@@ -0,0 +1,10 @@
+uses TypeClasses;
+
+procedure ppp<T>(p: T); where Num[T];
+begin
+  Print(Num&[T].Abs(p));
+end;
+
+begin
+  
+end.

CodeExamples/Typeclasses/TypeClassErrors/tc2_err3.pas

@@ -0,0 +1,11 @@
+uses TypeClasses;
+
+// Плохое сообщение об ошибке
+procedure ppp<T>(p: T); where Num[T];
+begin
+  Print(Num[T].Abs(p));
+end;
+
+begin
+  
+end.

Configuration/GlobalAssemblyInfo.cs

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

Configuration/Version.defs

@@ -1,4 +1,4 @@
-%COREVERSION%=0
-%REVISION%=1677
 %MINOR%=4
+%REVISION%=1678
+%COREVERSION%=0
 %MAJOR%=3

ReleaseGenerators/PascalABCNET_version.nsh

@@ -1 +1 @@
-!define VERSION '3.4.0.1677'
+!define VERSION '3.4.0.1678'

TestSuite/CompilationSamples/PABCSystem.pas

@@ -1220,6 +1220,8 @@ function Power(x: BigInteger; y: integer): BigInteger;
 /// Возвращает x, округленное до ближайшего целого. Если вещественное находится посередине между двумя целыми, 
 ///то округление осуществляется к ближайшему четному (банковское округление): Round(2.5)=2, Round(3.5)=4
 function Round(x: real): integer;
+/// Возвращает x, округленное до ближайшего вещественного с digits знаками после десятичной точки
+function Round(x: real; digits: integer): real;
 /// Возвращает x, округленное до ближайшего длинного целого
 function RoundBigInteger(x: real): BigInteger;
 /// Возвращает целую часть вещественного числа x
@@ -7011,6 +7013,8 @@ function Power(x: BigInteger; y: integer) := BigInteger.Pow(x, y);
 
 function Round(x: real) := Convert.ToInt32(Math.Round(x));
 
+function Round(x: real; digits: integer) := Math.Round(x,digits);
+
 function RoundBigInteger(x: real) := BigInteger.Create(Math.Round(x));
 
 function Trunc(x: real) := Convert.ToInt32(Math.Truncate(x));
@@ -10000,6 +10004,12 @@ begin
   Result := Round(Self);
 end;
 
+/// Возвращает x, округленное до ближайшего вещественного с digits знаками после десятичной точки
+function Round(Self: real; digits: integer): real; extensionmethod;
+begin
+  Result := Round(Self,digits);
+end;
+
 /// Возвращает число, округленное до ближайшего длинного целого
 function RoundBigInteger(Self: real): BigInteger; extensionmethod;
 begin

bin/Lib/PABCSystem.pas

@@ -7455,17 +7455,12 @@ end;
 
 function Pos(subs, s: string; from: integer): integer;
 begin
-  if (subs = nil) or (subs.Length = 0) then
+  if (subs = nil) or (subs.Length = 0) or (from > s.Length) then
     Result := 0
   else Result := s.IndexOf(subs, from - 1, System.StringComparison.Ordinal) + 1;
 end;
 
-function PosEx(subs, s: string; from: integer): integer;
-begin
-  if (subs = nil) or (subs.Length = 0) then
-    Result := 0
-  else Result := s.IndexOf(subs, from - 1, System.StringComparison.Ordinal) + 1;
-end;
+function PosEx(subs, s: string; from: integer) := Pos(subs,s,from);
 
 function LastPos(subs, s: string): integer;
 begin
@@ -7476,20 +7471,19 @@ end;
 
 function LastPos(subs, s: string; from: integer): integer;
 begin
-  if (subs = nil) or (subs.Length = 0) then
+  if (subs = nil) or (subs.Length = 0) or (from > s.Length) then
     Result := 0
   else Result := s.LastIndexOf(subs, from - 1, System.StringComparison.Ordinal) + 1;
 end;
 
-function Pos(c: char; s: string; from: integer): integer;
+{function Pos(c: char; s: string; from: integer): integer;
 begin
+  if from > s.Length then
+    Result := 0;
   Result := s.IndexOf(c, from - 1, System.StringComparison.Ordinal) + 1;
 end;
 
-function PosEx(c: char; s: string; from: integer): integer;
-begin
-  Result := s.IndexOf(c, from - 1, System.StringComparison.Ordinal) + 1;
-end;
+function PosEx(c: char; s: string; from: integer) := Pos(c,s,from);
 
 function LastPos(c: char; s: string): integer;
 begin
@@ -7498,8 +7492,10 @@ end;
 
 function LastPos(c: char; s: string; from: integer): integer;
 begin
+  if from > s.Length then
+    Result := 0;
   Result := s.LastIndexOf(c, from - 1, System.StringComparison.Ordinal) + 1;
-end;
+end;}
 
 function Length(s: string): integer;
 begin
@@ -7530,7 +7526,7 @@ begin
     s := s.Substring(0, n)
   else if s.Length < n then
     if n <= sz then
-      s += new string(' ', n - s.Length )
+      s += new string(' ', n - s.Length)
     else 
       s += new String(' ', sz - s.Length)
 end;
@@ -7543,12 +7539,6 @@ begin
   if index > s.Length + 1 then
     index := s.Length + 1;
   s := s.Insert(index - 1, source);
-  {  try
-  s := s.Insert(index - 1, source);
-  except 
-  on e: System.Exception do
-  s := s.Insert(s.Length, source);
-  end;}
 end;
 
 procedure InsertInShortString(source: string; var s: string; index, n: integer);
@@ -7589,14 +7579,6 @@ begin
   if index + count - 1 > s.Length then
     count := s.Length - index + 1;
   Result := s.SubString(index - 1, count);
-  {  try
-  if index - 1 >= s.Length then 
-  Result := ''
-  else Result := s.SubString(index - 1, count);
-  except 
-  on e: System.Exception do
-  Result := s.Substring(index - 1, s.Length - index + 1);
-  end;}
 end;
 
 function Concat(s1, s2: string): string;