diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index 046331b44..133f68640 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 = "6"; public const string Build = "3"; - public const string Revision = "2462"; + public const string Revision = "2463"; 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 a28d46331..64557b1ab 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%COREVERSION%=3 -%REVISION%=2462 %MINOR%=6 +%REVISION%=2463 +%COREVERSION%=3 %MAJOR%=3 diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index 4abe55e59..3ef56ad31 100644 Binary files a/Localization/DefaultLang.resources and b/Localization/DefaultLang.resources differ diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 1e234ee43..f11d22642 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.6.3.2462 +3.6.3.2463 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index db8864e1f..0a290fa35 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.6.3.2462' +!define VERSION '3.6.3.2463' diff --git a/TestSuite/CompilationSamples/GraphWPF.pas b/TestSuite/CompilationSamples/GraphWPF.pas index b2bfb6b79..1f8dd321c 100644 --- a/TestSuite/CompilationSamples/GraphWPF.pas +++ b/TestSuite/CompilationSamples/GraphWPF.pas @@ -56,6 +56,8 @@ type //{{{--doc: Конец секции 1 }}} function GetBrush(c: Color): GBrush; +function GetFontFamily(name: string): FontFamily; + //{{{doc: Начало секции 2 }}} @@ -118,12 +120,12 @@ type // ----------------------------------------------------- ///!# /// Тип шрифта - FontType = class + FontOptions = class private tf := new Typeface('Arial'); sz: real := 14; c: GColor := Colors.Black; - procedure SetNameP(s: string) := tf := new Typeface(new FontFamily(s),FontStyles.Normal,FontWeights.Normal,FontStretches.Normal); + procedure SetNameP(s: string) := tf := new Typeface(GetFontFamily(s),FontStyles.Normal,FontWeights.Normal,FontStretches.Normal); function GetName := tf.FontFamily.ToString; procedure SetName(s: string) := Invoke(SetNameP,s); procedure SetFSP(fs: FontStyle); @@ -135,11 +137,11 @@ type FontStyle.Italic: s := FontStyles.Italic; FontStyle.BoldItalic: begin s := FontStyles.Italic; w := FontWeights.Bold; end; end; - tf := new Typeface(new FontFamily(Name),s,w,FontStretches.Normal); + tf := new Typeface(GetFontFamily(Name),s,w,FontStretches.Normal); end; procedure SetFS(fs: FontStyle) := Invoke(SetFSP,fs); - function TypefaceClone := tf; - function BrushConstruct := GetBrush(c); + property BrushClone: GBrush read GetBrush(c); + property TypefaceClone: Typeface read tf; public /// Цвет шрифта property Color: GColor read c write c; @@ -149,6 +151,38 @@ type property Size: real read sz write sz; /// Стиль шрифта property Style: FontStyle write SetFS; + /// Декоратор стиля шрифта + function WithStyle(fs: FontStyle): FontOptions; + begin + Result := new FontOptions; + Result.sz := sz; + Result.Color := c; + Result.Style := fs; + end; + /// Декоратор цвета шрифта + function WithColor(c: GColor): FontOptions; + begin + Result := new FontOptions; + Result.tf := tf; + Result.sz := sz; + Result.Color := c; + end; + /// Декоратор размера шрифта + function WithSize(sz: real): FontOptions; + begin + Result := new FontOptions; + Result.tf := tf; + Result.sz := sz; + Result.Color := c; + end; + /// Декоратор стиля шрифта + function WithName(name: string): FontOptions; + begin + Result := new FontOptions; + Result.sz := sz; + Result.Color := c; + Result.tf := new Typeface(GetFontFamily(name),tf.Style,tf.Weight,FontStretches.Normal); + end; end; // ----------------------------------------------------- @@ -453,6 +487,9 @@ procedure DrawText(r: GRect; text: string; c: GColor; align: Alignment := Alignm procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); /// Выводит вещественное в прямоугольник procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment := Alignment.Center; angle: real := 0.0); +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) указанным шрифтом +procedure DrawText(x, y, w, h: real; text: string; f: FontOptions; align: Alignment; angle: real); + /// Выводит строку в позицию (x,y) procedure TextOut(x, y: real; text: string; align: Alignment := Alignment.LeftTop; angle: real := 0.0); @@ -466,6 +503,8 @@ procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment := Alig procedure TextOut(x, y: real; text: real; align: Alignment := Alignment.LeftTop; angle: real := 0.0); /// Выводит вещественное в позицию (x,y) цветом c procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment := Alignment.LeftTop; angle: real := 0.0); +/// Выводит строку в позицию (x,y) указанным шрифтом +procedure TextOut(x, y: real; text: string; f: FontOptions; align: Alignment := Alignment.LeftTop; angle: real := 0.0); /// Ширина текста при выводе function TextWidth(text: string): real; @@ -477,7 +516,7 @@ function TextSize(text: string): Size; // ----------------------------------------------------- //>> Функции для вывода графиков # GraphWPF graph functions // ----------------------------------------------------- -/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом координатами x1,y1,x2,y2, +/// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; title: string := ''); /// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, в прямоугольнике, задаваемом параметрами x,y,w,h. Два последних параметра задают шаг сетки по OX и OY procedure DrawGraph(f: real -> real; a, b, min, max, x, y, w, h: real; XTicks: real; YTicks: real; title: string := ''); @@ -487,7 +526,7 @@ procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; title: stri procedure DrawGraph(f: real -> real; a, b, min, max: real; r: GRect; XTicks, YTicks: real; title: string := ''); /// Рисует график функции f, заданной на отрезке [a,b] по оси абсцисс и на отрезке [min,max] по оси ординат, на полное графическое окно procedure DrawGraph(f: real -> real; a, b, min, max: real; title: string := ''); -/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом координатами x1,y1,x2,y2, +/// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике, задаваемом параметрами x,y,w,h procedure DrawGraph(f: real -> real; a, b: real; x, y, w, h: real; title: string := ''); /// Рисует график функции f, заданной на отрезке [a,b], в прямоугольнике r procedure DrawGraph(f: real -> real; a, b: real; r: GRect; title: string := ''); @@ -529,7 +568,7 @@ var Brush: BrushType; /// Текущее перо var Pen: PenType; /// Текущий шрифт -var Font: FontType; +var Font: FontOptions; /// Главное окно var Window: WindowTypeWPF; /// Графическое окно @@ -582,6 +621,7 @@ procedure __FinalizeModule__; implementation var BrushesDict := new Dictionary; +var FontFamiliesDict := new Dictionary; function GetBrush(c: Color): GBrush; begin @@ -594,6 +634,16 @@ begin else Result := BrushesDict[c]; end; +function GetFontFamily(name: string): FontFamily; +begin + if not (name in FontFamiliesDict) then + begin + var b := new FontFamily(name); + FontFamiliesDict[name] := b; + Result := b + end + else Result := FontFamiliesDict[name]; +end; procedure Redraw(d: ()->()) := app.Dispatcher.Invoke(d); function getApp: Application := app; @@ -778,14 +828,23 @@ begin ReleaseDC(dc); end; +var RusCultureInfo := new System.Globalization.CultureInfo('ru-ru'); + function FormText(text: string) := - new FormattedText(text,new System.Globalization.CultureInfo('ru-ru'), FlowDirection.LeftToRight, - Font.TypefaceClone, Font.Size, Font.BrushConstruct); + new FormattedText(text, RusCultureInfo, FlowDirection.LeftToRight, + Font.tf, Font.Size, Font.BrushClone); -function FormTextC(text: string; c: GColor): FormattedText := - new FormattedText(text,new System.Globalization.CultureInfo('ru-ru'), FlowDirection.LeftToRight, - Font.TypefaceClone, Font.Size, GetBrush(c)); +function FormTextFont(text: string; f: FontOptions): FormattedText; +begin + var tf := new Typeface(GetFontFamily(f.Name),f.tf.Style,f.tf.Weight,f.tf.Stretch); + Result := new FormattedText(text,RusCultureInfo, FlowDirection.LeftToRight, tf, f.Size, f.BrushClone); +end; +function FormTextC(text: string; c: GColor): FormattedText; +begin + Result := new FormattedText(text,RusCultureInfo, FlowDirection.LeftToRight, Font.TypefaceClone, Font.Size, GetBrush(c)); +end; + function TextWidthP(text: string) := FormText(text).Width; function TextHeightP(text: string) := FormText(text).Height; @@ -800,60 +859,42 @@ type TextV = auto class end; end; -procedure TextPFull(x,y: real; text: string; angle,x0,y0: real); +procedure TextPFull(x,y: real; text: string; angle,x0,y0: real; f: FontOptions); begin - var dc: DrawingContext; + var ft := FormTextFont(text,f); + var dc := GetDC(); + var RT := new RotateTransform(angle,x0,y0); + dc.PushTransform(RT); if CurrentCoordType = StandardCoords then begin - dc := GetDC(); - var RT := new RotateTransform(angle,x0,y0); - dc.PushTransform(RT); - dc.DrawText(FormText(text),new Point(x,y)); - dc.Pop(); + dc.DrawText(ft,new Point(x,y)); end else begin var m := Host.RenderTransform.Value; var mt := new MatrixTransform(1/m.M11,0,0,1/m.M22,x,y); - dc := GetDC(); - var RT := new RotateTransform(angle,x0,y0); - dc.PushTransform(RT); dc.PushTransform(mt); - dc.DrawText(FormText(text),new Point(0,0)); + + dc.DrawText(ft,new Point(0,0)); + dc.Pop(); - dc.Pop(); - end; + end; + dc.Pop(); //dc.DrawRectangle(Brushes.White,nil,new GRect(new Point(x,y),TextV.Create(text).TextSize)); ReleaseDC(dc); end; procedure TextPFull(x,y: real; text: string; angle,x0,y0: real; c: Color); begin - var dc: DrawingContext; - if CurrentCoordType = StandardCoords then - begin - dc := GetDC(); - var RT := new RotateTransform(angle,x0,y0); - dc.PushTransform(RT); - dc.DrawText(FormTextC(text,c),new Point(x,y)); - dc.Pop(); - end - else - begin - var m := Host.RenderTransform.Value; - var mt := new MatrixTransform(1/m.M11,0,0,1/m.M22,x,y); - dc := GetDC(); - var RT := new RotateTransform(angle,x0,y0); - dc.PushTransform(RT); - dc.PushTransform(mt); - dc.DrawText(FormTextC(text,c),new Point(0,0)); - dc.Pop(); - dc.Pop(); - end; - //dc.DrawRectangle(Brushes.White,nil,new GRect(new Point(x,y),TextV.Create(text).TextSize)); - ReleaseDC(dc); + TextPFull(x,y,text,angle,x0,y0,Font.WithColor(c)); end; +procedure TextPFull(x,y: real; text: string; angle,x0,y0: real); +begin + TextPFull(x,y,text,angle,x0,y0,Font); +end; + + var dpic := new Dictionary; function GetBitmapImage(fname: string): BitmapImage; @@ -1082,6 +1123,7 @@ procedure FillPolygonPC(points: array of Point; c: GColor) := PolygonPFull(point procedure DrawTextP(x,y: real; text: string; angle,x0,y0: real) := TextPFull(x,y,text,angle,x0,y0); procedure DrawTextPC(x,y: real; text: string; angle,x0,y0: real; c: GColor) := TextPFull(x,y,text,angle,x0,y0,c); +procedure DrawTextPFont(x,y: real; text: string; angle,x0,y0: real; f: FontOptions) := TextPFull(x,y,text,angle,x0,y0,f); procedure EllipseNew(x,y,r1,r2: real) := InvokeVisual(DrawGeometryP,VE.Create(()->EllipseGeometry.Create(Pnt(x,y),r1,r2))); @@ -1184,6 +1226,7 @@ procedure TextOutHelper(x,y: real; text: string; angle: real; x0,y0: real) := In procedure TextOutHelper(x,y: real; text: string; angle: real; c: GColor; x0,y0: real) := InvokeVisual(DrawTextPC,x,y,text,angle,x0,y0,c); //procedure TextOut(x,y: real; number: integer; c: GColor) := TextOut(x,y,'' + number,c); //procedure TextOut(x,y: real; number: real; c: GColor) := TextOut(x,y,'' + number,c); +procedure TextOutHelper(x,y: real; text: string; angle: real; x0,y0: real; f: FontOptions) := InvokeVisual(DrawTextPFont,x,y,text,angle,x0,y0,f); procedure DrawTextHelper(var x, y, x0, y0: real; w, h: real; text: string; align: Alignment := Alignment.Center); begin @@ -1239,8 +1282,6 @@ procedure DrawText(x, y, w, h: real; text: string; c: GColor; align: Alignment; begin var (x0,y0) := (x,y); DrawTextHelper(x, y, x0, y0, w, h, text, align); - //FillCircle(x0,y0,0.1,Colors.Blue); - //FillCircle(x,y,0.1,Colors.Red); TextOutHelper(x,y,text,angle,c,x0,y0) end; /// Выводит целое в прямоугольник к координатами левого верхнего угла (x,y) @@ -1264,6 +1305,14 @@ procedure DrawText(r: GRect; number: integer; c: GColor; align: Alignment; angle /// Выводит вещественное в прямоугольник procedure DrawText(r: GRect; number: real; c: GColor; align: Alignment; angle: real) := DrawText(r.x,r.y,r.Width,r.Height,number,c,align,angle); +/// Выводит строку в прямоугольник к координатами левого верхнего угла (x,y) данным шрифтом +procedure DrawText(x, y, w, h: real; text: string; f: FontOptions; align: Alignment; angle: real); +begin + var (x0,y0) := (x,y); + DrawTextHelper(x, y, x0, y0, w, h, text, align); + TextOutHelper(x,y,text,angle,x0,y0,f) +end; + {function ConvertAlign(align: Alignment): Alignment; begin Result := align; @@ -1286,6 +1335,8 @@ procedure TextOut(x, y: real; text: integer; c: GColor; align: Alignment; angle: procedure TextOut(x, y: real; text: real; align: Alignment; angle: real) := TextOut(x, y, ''+text,align,angle); procedure TextOut(x, y: real; text: real; c: GColor; align: Alignment; angle: real) := TextOut(x, y, ''+text, c,align,angle); +procedure TextOut(x, y: real; text: string; f: FontOptions; align: Alignment; angle: real) := DrawText(x, y, 0, 0, text, f, align, angle); + type FS = auto class @@ -1295,7 +1346,9 @@ type title: string; marginY := 6; marginX := 6; - spaceBetweenTextAndGraph := 4; + XTicksPrecision := 3; + YTicksPrecision := 5; + spaceBetweenTextAndGraph := 6; constructor (a, b, min, max, x, y, w, h: real; f: real -> real; XTicks: real := 1; YTicks: real := 1; title: string := ''); begin @@ -1322,9 +1375,16 @@ type procedure CorrectBounds; begin //var digits := 5; - var tw := TextWidth('-99.9'); + if real.IsNaN(XTicks) then + XTicks := Ticks(b-a); + if real.IsNaN(YTicks) then + YTicks := Ticks(max-min); var th := TextHeight('0'); - w -= marginX * 2 + spaceBetweenTextAndGraph + tw; + var tw := GetRY0.Step(YTicks).TakeWhile(ry -> ry <= max).Select(y -> TextWidth(y.Round(YTicksPrecision).ToString)).Max; + var dd := TextWidth(b.Round(xTicksPrecision).ToString)/2; + + //var tw := TextWidth('-99.9'); + w -= marginX * 2 + spaceBetweenTextAndGraph + tw + dd; h -= marginY * 2 + spaceBetweenTextAndGraph + th; x += marginX + spaceBetweenTextAndGraph + tw; y += marginY; @@ -1335,10 +1395,6 @@ type end; mx := w / (b - a); my := h / (max - min); - if real.IsNaN(XTicks) then - XTicks := Ticks(b-a); - if real.IsNaN(YTicks) then - YTicks := Ticks(max-min); end; function Apply(xx: real) := Pnt(x + mx * (xx - a), y + my * (max - f(xx))); @@ -1347,6 +1403,26 @@ type function ScreenToRealX(xx: real) := (xx - x) / mx + a; function ScreenToRealY(yy: real) := (y + h - yy) / my + min; + function GetRX0: real; + begin + var xt := XTicks * Trunc(Abs(a)/XTicks); + var rx0: real; + if a <= 0 then + rx0 := -xt + else rx0 := xt + XTicks; + Result := rx0; + end; + + function GetRY0: real; + begin + var yt := YTicks * Trunc(Abs(min)/YTicks); + var ry0: real; + if min <= 0 then + ry0 := -yt + else ry0 := yt + YTicks; + Result := ry0; + end; + procedure Draw; var AxisColor := GrayColor(112); begin @@ -1354,40 +1430,34 @@ type CorrectBounds; Pen.Color := Colors.LightGray; var sx := mx * XTicks; - var xt := XTicks * Trunc(Abs(a)/XTicks); - var rx0: real; - if a <= 0 then - rx0 := -xt - else rx0 := xt + XTicks; - //var rx0 := a; + + var rx0 := GetRX0; + var x0 := RealToScreenX(rx0); while x0<=x+w+0.000001 do begin if Abs(rx0)<0.000001 then Line(x0,y,x0,y+h,AxisColor) else Line(x0,y,x0,y+h); - TextOut(x0,y+h+4,rx0.Round(3),Alignment.CenterTop); + TextOut(x0,y+h+4,rx0.Round(XTicksPrecision),Alignment.CenterTop); x0 += sx; rx0 += XTicks; end; var sy := my * YTicks; - var yt := YTicks * Trunc(Abs(min)/YTicks); - var ry0: real; - if min <= 0 then - ry0 := -yt - else ry0 := yt + YTicks; - //var ry0 := min; - //var y0 := y + h; + + var ry0 := GetRY0; + if title<>'' then - TextOut(x+w/2,y-spaceBetweenTextAndGraph,Title,Alignment.CenterBottom); + TextOut(x+w/2,y-spaceBetweenTextAndGraph,Title,Font.WithSize(Font.Size*1.15){.WithStyle(FontStyle.Bold)},Alignment.CenterBottom); var y0 := RealToScreenY(ry0); + while y0>=y-0.000001 do begin if Abs(ry0)<0.000001 then Line(x,y0,x+w,y0,AxisColor) else Line(x,y0,x+w,y0); - TextOut(x-4,y0,ry0.Round(5),Alignment.RightCenter); + TextOut(x-4,y0,ry0.Round(YTicksPrecision),Alignment.RightCenter); y0 -= sy; ry0 += YTicks; end; @@ -1865,7 +1935,7 @@ public begin Brush := new BrushType; Pen := new PenType; - Font := new FontType; + Font := new FontOptions; Window := new WindowTypeWPF; GraphWindow := new GraphWindowType; end; diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index 1e9bfa275..f864aad4a 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -611,6 +611,7 @@ type property Count: integer read GetCount; static function operator in(x: integer; r: IntRange): boolean := (x >= r.l) and (x <= r.h); + static function operator in(x: real; r: IntRange): boolean := (x >= r.l) and (x <= r.h); static function operator=(r1,r2: IntRange): boolean := (r1.l = r2.l) and (r1.h = r2.h); function IsEmpty: boolean := l<=h; @@ -621,7 +622,7 @@ type function GetEnumerator(): IEnumerator; function System.Collections.IEnumerable.GetEnumerator: System.Collections.IEnumerator := Self.GetEnumerator; - function ToString: string; override := $'({l},{h})'; + function ToString: string; override := $'{l}..{h}'; function Equals(o: Object): boolean; override; begin var r2 := IntRange(o); @@ -693,7 +694,7 @@ type function GetEnumerator(): IEnumerator; function System.Collections.IEnumerable.GetEnumerator: System.Collections.IEnumerator := GetEnumerator; - function ToString: string; override := $'({l},{h})'; + function ToString: string; override := $'{l}..{h}'; function Equals(o: Object): boolean; override; begin var r2 := CharRange(o); @@ -734,6 +735,33 @@ type Result := new SortedSet(System.Linq.Enumerable.Range(integer(l),Count).Select(i -> char(i))); end; end; + + /// Тип диапазона вещественных + RealRange = class + private + l,h: real; + public + constructor(l,h: real); + begin + Self.l := l; + Self.h := h; + end; + property Low: real read l; + property High: real read h; + + static function operator in(x: real; r: RealRange): boolean := (x >= r.l) and (x <= r.h); + static function operator=(r1,r2: RealRange): boolean := (r1.l = r2.l) and (r1.h = r2.h); + + function IsEmpty: boolean := l<=h; + + function ToString: string; override := $'{l}..{h}'; + function Equals(o: Object): boolean; override; + begin + var r2 := RealRange(o); + Result := (l = r2.l) and (h = r2.h); + end; + function GetHashCode: integer; override := l.GetHashCode xor h.GetHashCode; + end; ///Тип для представления индекса SystemIndex = class @@ -2666,6 +2694,8 @@ type function InternalRange(l,r: integer): IntRange; ///-- function InternalRange(l,r: char): CharRange; +///-- +function InternalRange(l,r: real): RealRange; // ----------------------------------------------------- @@ -3830,6 +3860,10 @@ begin var a := o as System.Array; Result := ArrNToString(a, new integer[a.Rank], 0); end + else if ((o.GetType = typeof(IntRange)) or (o.GetType = typeof(CharRange)) or (o.GetType = typeof(RealRange))) then + begin + Result := o.ToString + end else if o is System.Collections.IEnumerable then begin var sb := new StringBuilder(); @@ -12973,6 +13007,8 @@ function InternalRange(l,r: integer): IntRange := new IntRange(l,r); function InternalRange(l,r: char): CharRange := new CharRange(l,r); +function InternalRange(l,r: real): RealRange := new RealRange(l,r); + //------------------------------------------------------------------------------ //OMP diff --git a/TreeConverter/TreeConversion/semantic_checks_for_sugar.cs b/TreeConverter/TreeConversion/semantic_checks_for_sugar.cs index 5da51e4fa..55697791e 100644 --- a/TreeConverter/TreeConversion/semantic_checks_for_sugar.cs +++ b/TreeConverter/TreeConversion/semantic_checks_for_sugar.cs @@ -252,30 +252,45 @@ namespace PascalABCCompiler.TreeConverter var semv = convert_strong(v); var a = convertion_data_and_alghoritms.can_convert_type(semv, SystemLibrary.SystemLibrary.integer_type); var a1 = false; + var ar = false; if (!a) a1 = convertion_data_and_alghoritms.can_convert_type(semv, SystemLibrary.SystemLibrary.char_type); - if (!a && !a1) - AddError(get_location(v), "INTEGER_OR_CHAR_VALUE_EXPECTED"); + if (!a1) + ar = convertion_data_and_alghoritms.can_convert_type(semv, SystemLibrary.SystemLibrary.double_type); + if (!a && !a1 && !ar) + AddError(get_location(v), "INTEGER_OR_REAL_OR_CHAR_VALUE_EXPECTED"); var semfrom = convert_strong(from); var b = convertion_data_and_alghoritms.can_convert_type(semfrom, SystemLibrary.SystemLibrary.integer_type); var b1 = false; + var br = false; if (!b) b1 = convertion_data_and_alghoritms.can_convert_type(semfrom, SystemLibrary.SystemLibrary.char_type); - if (!b && !b1) - AddError(get_location(from), "INTEGER_OR_CHAR_VALUE_EXPECTED"); + if (!b1) + br = convertion_data_and_alghoritms.can_convert_type(semfrom, SystemLibrary.SystemLibrary.double_type); + if (!b && !b1 && !br) + AddError(get_location(from), "INTEGER_OR_REAL_OR_CHAR_VALUE_EXPECTED"); var semto = convert_strong(to); var c = convertion_data_and_alghoritms.can_convert_type(semto, SystemLibrary.SystemLibrary.integer_type); var c1 = false; + var cr = false; if (!c) c1 = convertion_data_and_alghoritms.can_convert_type(semto, SystemLibrary.SystemLibrary.char_type); - if (!c && !c1) - AddError(get_location(to), "INTEGER_OR_CHAR_VALUE_EXPECTED"); + if (!c1) + cr = convertion_data_and_alghoritms.can_convert_type(semto, SystemLibrary.SystemLibrary.double_type); + if (!c && !c1 && !cr) + AddError(get_location(to), "INTEGER_OR_REAL_OR_CHAR_VALUE_EXPECTED"); - if (b != c || c1 != b1) + var incompbound = true; + if (b && c || c1 && b1 || cr && br) + incompbound = false; + if (b && cr || c && br) + incompbound = false; + + if (incompbound) AddError(get_location(to), "INCOMPATIBLE_DIAPASON_BOUNDS_TYPES"); - if (a != b || a1 != b1) + if (a && b1 || ar && b1 || a1 && b || a1 && c) AddError(get_location(v), "INCOMPATIBLE_TYPES_OF_ELEMENT_AND_DIAPASON"); } diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index f864aad4a..78fa6ebad 100644 --- a/bin/Lib/PABCSystem.pas +++ b/bin/Lib/PABCSystem.pas @@ -2381,6 +2381,9 @@ function __WildCardsTupleEqual