From 553e7fbd2481c60d785e9a4a3833e18fed903a24 Mon Sep 17 00:00:00 2001 From: miks1965 Date: Thu, 28 Jun 2018 13:42:46 +0300 Subject: [PATCH] =?UTF-8?q?TypeClassErrors=20-=20=D0=BF=D0=B0=D0=BF=D0=BA?= =?UTF-8?q?=D0=B0=20=D0=B4=D0=BB=D1=8F=20=D0=BE=D1=88=D0=B8=D0=B1=D0=BE?= =?UTF-8?q?=D0=BA=20=D1=81=20typeclasses=20PosEx=20-=20=D0=B8=D1=81=D0=BF?= =?UTF-8?q?=D1=80=D0=B0=D0=B2=D0=BB=D0=B5=D0=BD=D0=BE=20=D0=BF=D0=BE=D0=B2?= =?UTF-8?q?=D0=B5=D0=B4=D0=B5=D0=BD=D0=B8=D0=B5=20-=20=D1=82=D0=B5=D0=BF?= =?UTF-8?q?=D0=B5=D1=80=D1=8C=20=D0=BD=D0=B5=20=D0=B3=D0=B5=D0=BD=D0=B5?= =?UTF-8?q?=D1=80=D0=B8=D1=80=D1=83=D0=B5=D1=82=D1=81=D1=8F=20=D0=B8=D1=81?= =?UTF-8?q?=D0=BA=D0=BB=D1=8E=D1=87=D0=B5=D0=BD=D0=B8=D0=B5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../TypeClassErrors/TypeClasses.pas | 114 ++++++++++++++++++ .../Typeclasses/TypeClassErrors/lesserr1.pas | 27 +++++ .../Typeclasses/TypeClassErrors/lesserr2.pas | 26 ++++ .../Typeclasses/TypeClassErrors/tc1.pas | 24 ++++ .../Typeclasses/TypeClassErrors/tc1_err1.pas | 18 +++ .../Typeclasses/TypeClassErrors/tc1_err2.pas | 28 +++++ .../Typeclasses/TypeClassErrors/tc2.pas | 10 ++ .../Typeclasses/TypeClassErrors/tc2_err3.pas | 11 ++ Configuration/GlobalAssemblyInfo.cs | 2 +- Configuration/Version.defs | 4 +- ReleaseGenerators/PascalABCNET_version.nsh | 2 +- TestSuite/CompilationSamples/PABCSystem.pas | 10 ++ bin/Lib/PABCSystem.pas | 40 ++---- 13 files changed, 283 insertions(+), 33 deletions(-) create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/TypeClasses.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/lesserr1.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/lesserr2.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/tc1.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/tc1_err1.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/tc1_err2.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/tc2.pas create mode 100644 CodeExamples/Typeclasses/TypeClassErrors/tc2_err3.pas diff --git a/CodeExamples/Typeclasses/TypeClassErrors/TypeClasses.pas b/CodeExamples/Typeclasses/TypeClassErrors/TypeClasses.pas new file mode 100644 index 000000000..b02920b31 --- /dev/null +++ b/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. \ No newline at end of file diff --git a/CodeExamples/Typeclasses/TypeClassErrors/lesserr1.pas b/CodeExamples/Typeclasses/TypeClassErrors/lesserr1.pas new file mode 100644 index 000000000..6226f9e68 --- /dev/null +++ b/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(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](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](p1,p2: T); where Ord[T]; +begin + Print(p1=p2); + Print(p1(p1,p2: T); where Ord[T]; +begin + Print(p1=p2); + Print(p1(p: T); where Num[T]; +begin + Print(Num&[T].Abs(p)); +end; + +begin + +end. \ No newline at end of file diff --git a/CodeExamples/Typeclasses/TypeClassErrors/tc2_err3.pas b/CodeExamples/Typeclasses/TypeClassErrors/tc2_err3.pas new file mode 100644 index 000000000..f30cd894c --- /dev/null +++ b/CodeExamples/Typeclasses/TypeClassErrors/tc2_err3.pas @@ -0,0 +1,11 @@ +uses TypeClasses; + +// Плохое сообщение об ошибке +procedure ppp(p: T); where Num[T]; +begin + Print(Num[T].Abs(p)); +end; + +begin + +end. \ No newline at end of file diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 42f2f4280..db8a6b68d 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/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; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index bb691bb11..df7d9118e 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=0 -%REVISION%=1677 %MINOR%=4 +%REVISION%=1678 +%COREVERSION%=0 %MAJOR%=3 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index 1034d790c..a73166aeb 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.4.0.1677' +!define VERSION '3.4.0.1678' diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index b916c42a1..dd8bcfb9a 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/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 diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index dd8bcfb9a..215c7a2a7 100644 --- a/bin/Lib/PABCSystem.pas +++ b/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;