From c05030ec9ef97f12522ce141e9eca3e58641b52e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=91=D0=BE=D0=BD=D0=B4=D0=B0=D1=80=D0=B5=D0=B2=20=D0=98?= =?UTF-8?q?=D0=B2=D0=B0=D0=BD?= Date: Sun, 3 Feb 2019 12:35:17 +0100 Subject: [PATCH] fix #1695 --- CodeCompletion/SymTable.cs | 59 ++- .../intellisense_tests/PABCExtensions.pas | 44 +- TestSuite/intellisense_tests/PABCSystem.pas | 418 +++++++++++++----- TestSuite/intellisense_tests/delegates3.pas | 5 + TestSuite/intellisense_tests/indexer2.pas | 2 +- 5 files changed, 407 insertions(+), 121 deletions(-) create mode 100644 TestSuite/intellisense_tests/delegates3.pas diff --git a/CodeCompletion/SymTable.cs b/CodeCompletion/SymTable.cs index 18e223c14..2fba92348 100644 --- a/CodeCompletion/SymTable.cs +++ b/CodeCompletion/SymTable.cs @@ -1789,6 +1789,47 @@ namespace CodeCompletion } } + private ProcScope beginInvokeMethod; + private ProcScope endInvokeMethod; + + public ProcScope BeginInvokeMethod + { + get + { + if (beginInvokeMethod == null) + { + beginInvokeMethod = new ProcScope("BeginInvoke", target); + beginInvokeMethod.declaringType = parent; + beginInvokeMethod.parameters = new List(); + beginInvokeMethod.parameters.Add(new ElementScope(new SymInfo("callback",SymbolKind.Parameter,"callback"), TypeTable.get_compiled_type(typeof(AsyncCallback)),beginInvokeMethod)); + beginInvokeMethod.parameters.Add(new ElementScope(new SymInfo("object", SymbolKind.Parameter, "object"), TypeTable.obj_type, beginInvokeMethod)); + beginInvokeMethod.return_type = TypeTable.get_compiled_type(typeof(IAsyncResult)); + beginInvokeMethod.is_virtual = true; + beginInvokeMethod.Complete(); + } + return beginInvokeMethod; + } + } + + public ProcScope EndInvokeMethod + { + get + { + if (endInvokeMethod == null) + { + endInvokeMethod = new ProcScope("EndInvoke", target); + endInvokeMethod.declaringType = parent; + endInvokeMethod.parameters = new List(); + endInvokeMethod.parameters.Add(new ElementScope(new SymInfo("result", SymbolKind.Parameter, "result"), TypeTable.get_compiled_type(typeof(IAsyncResult)), endInvokeMethod)); + + //endInvokeMethod.return_type = TypeTable.get_compiled_type(typeof(IAsyncResult)); + endInvokeMethod.is_virtual = true; + endInvokeMethod.Complete(); + } + return endInvokeMethod; + } + } + public override TypeScope GetInstance(List gen_args, bool exact = false) { return this; @@ -1797,8 +1838,12 @@ namespace CodeCompletion public override List FindOverloadNames(string name) { List lst = new List(); - if (string.Compare(name, InvokeMethod.name, true) == 0) + if (string.Compare(name, "Invoke", true) == 0) lst.Add(InvokeMethod); + else if (string.Compare(name, "BeginInvoke", true) == 0) + lst.Add(BeginInvokeMethod); + else if (string.Compare(name, "EndInvoke", true) == 0) + lst.Add(EndInvokeMethod); else lst.AddRange(parent.FindOverloadNames(name)); return lst; @@ -1807,8 +1852,12 @@ namespace CodeCompletion public override List FindOverloadNamesOnlyInType(string name) { List lst = new List(); - if (string.Compare(name, InvokeMethod.name, true) == 0) + if (string.Compare(name, "Invoke", true) == 0) lst.Add(InvokeMethod); + else if (string.Compare(name, "BeginInvoke", true) == 0) + lst.Add(BeginInvokeMethod); + else if (string.Compare(name, "EndInvoke", true) == 0) + lst.Add(EndInvokeMethod); else lst.AddRange(parent.FindOverloadNamesOnlyInType(name)); return lst; @@ -1818,6 +1867,8 @@ namespace CodeCompletion { List lst = new List(); lst.Add(InvokeMethod.si); + lst.Add(BeginInvokeMethod.si); + lst.Add(EndInvokeMethod.si); lst.AddRange(parent.GetNames()); return lst.ToArray(); } @@ -1846,6 +1897,8 @@ namespace CodeCompletion { List lst = new List(); lst.Add(InvokeMethod.si); + lst.Add(BeginInvokeMethod.si); + lst.Add(EndInvokeMethod.si); lst.AddRange(parent.GetNamesAsInObject()); return lst.ToArray(); } @@ -1854,6 +1907,8 @@ namespace CodeCompletion { List lst = new List(); lst.Add(InvokeMethod.si); + lst.Add(BeginInvokeMethod.si); + lst.Add(EndInvokeMethod.si); lst.AddRange(parent.GetNamesAsInObject(ev)); return lst.ToArray(); } diff --git a/TestSuite/intellisense_tests/PABCExtensions.pas b/TestSuite/intellisense_tests/PABCExtensions.pas index cf94366e4..ff99028ea 100644 --- a/TestSuite/intellisense_tests/PABCExtensions.pas +++ b/TestSuite/intellisense_tests/PABCExtensions.pas @@ -11,18 +11,30 @@ uses PABCSystem; //>> Подпрограммы для работы с типизированными файлами # Subroutines for typed files // ----------------------------------------------------- -/// Открывает типизированный файл и возвращает значение для инициализации файловой переменной -function OpenBinary(fname: string): file of T; +/// Открывает бестиповой файл и возвращает значение для инициализации файловой переменной +function OpenBinary(fname: string): file; begin PABCSystem.Reset(Result, fname); end; -/// Создаёт или обнуляет типизированный файл и возвращает значение для инициализации файловой переменной -function CreateBinary(fname: string): file of T; +/// Создаёт или обнуляет бестиповой файл и возвращает значение для инициализации файловой переменной +function CreateBinary(fname: string): file; begin PABCSystem.Rewrite(Result, fname); end; +/// Открывает бестиповой файл в заданной кодировке и возвращает значение для инициализации файловой переменной +function OpenBinary(fname: string; en: Encoding): file; +begin + PABCSystem.Reset(Result, fname, en); +end; + +/// Создаёт или обнуляет бестиповой файл в заданной кодировке и возвращает значение для инициализации файловой переменной +function CreateBinary(fname: string; en: Encoding): file; +begin + PABCSystem.Rewrite(Result, fname, en); +end; + /// Открывает типизированный файл и возвращает значение для инициализации файловой переменной function OpenFile(fname: string): file of T; begin @@ -32,7 +44,23 @@ end; /// Создаёт или обнуляет типизированный файл и возвращает значение для инициализации файловой переменной function CreateFile(fname: string): file of T; begin - PABCSystem.Rewrite(Result, fname); + var res: file of T; + PABCSystem.Rewrite(res, fname); + Result := res; +end; + +/// Открывает типизированный файл в заданной кодировке и возвращает значение для инициализации файловой переменной +function OpenFile(fname: string; en: Encoding): file of T; +begin + PABCSystem.Reset(Result, fname, en); +end; + +/// Создаёт или обнуляет типизированный файл в заданной кодировке и возвращает значение для инициализации файловой переменной +function CreateFile(fname: string; en: Encoding): file of T; +begin + var res: file of T; + PABCSystem.Rewrite(res, fname, en); + Result := res; end; /// Открывает типизированный файл целых и возвращает значение для инициализации файловой переменной @@ -59,10 +87,10 @@ begin Result := CreateFile&(fname); end; -/// Открывает типизированный файл, возвращает последовательность его элементов и закрывает его +/// Открывает типизированный файл, записывает в него последовательность элементов ss и закрывает его procedure WriteElements(fname: string; ss: sequence of T); begin - var f := CreateBinary&(fname); + var f := CreateFile&(fname); foreach var x in ss do f.Write(x); f.Close @@ -117,7 +145,7 @@ end; /// Открывает типизированный файл, возвращает последовательность его элементов и закрывает его function ReadElements(fname: string): sequence of T; begin - var f := OpenBinary&(fname); + var f := OpenFile&(fname); while not f.Eof do begin var x := f.Read; diff --git a/TestSuite/intellisense_tests/PABCSystem.pas b/TestSuite/intellisense_tests/PABCSystem.pas index cd2221ec0..2903ac5d5 100644 --- a/TestSuite/intellisense_tests/PABCSystem.pas +++ b/TestSuite/intellisense_tests/PABCSystem.pas @@ -488,8 +488,10 @@ type ///- f.Write(a,b,...) /// Выводит значения a,b,... в двоичный файл procedure Write(params vals: array of object); - /// Устанавливает файловый указатель на начало файла + /// Открывает существующий двоичный файл на чтение и запись. Устанавливает файловый указатель на начало файла procedure Reset; + /// Открывает двоичный файл на чтение и запись. Если файл не существовал, он создаётся, если существовал, он обнуляется + procedure Rewrite; /// Возвращает имя файла function Name: string; /// Возвращает полное имя файла @@ -529,7 +531,11 @@ type /// Устанавливает текущую позицию файлового указателя в бестиповом файле на элемент с номером n procedure Seek(n: int64); /// Возвращает или устанавливает текущую позицию файлового указателя в бестиповом файле - property Position: int64 read GetFilePos write Seek; + property Position: int64 read GetFilePos write Seek; + /// Записывает данные из байтового массива в бестиповой файл + procedure WriteBytes(a: array of byte); + /// Считывает указанное количество байтов из бестипового файла в байтовый массив + function ReadBytes(count: integer): array of byte; end; //{{{doc: Начало секции интерфейса для документации }}} @@ -638,15 +644,32 @@ function ReadReal3: (real, real, real); function ReadChar3: (char, char, char); /// Возвращает кортеж из трёх значений типа string, введенных с клавиатуры function ReadString3: (string, string, string); -/// Возвращает кортеж из двух значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnInteger3: (integer, integer, integer); -/// Возвращает кортеж из двух значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnReal3: (real, real, real); -/// Возвращает кортеж из двух значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnChar3: (char, char, char); -/// Возвращает кортеж из двух значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnString3: (string, string, string); +/// Возвращает кортеж из четырёх значений типа integer, введенных с клавиатуры +function ReadInteger4: (integer, integer, integer, integer); +/// Возвращает кортеж из четырёх значений типа real, введенных с клавиатуры +function ReadReal4: (real, real, real, real); +/// Возвращает кортеж из четырёх значений типа char, введенных с клавиатуры +function ReadChar4: (char, char, char, char); +/// Возвращает кортеж из четырёх значений типа string, введенных с клавиатуры +function ReadString4: (string, string, string, string); +/// Возвращает кортеж из четырёх значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnInteger4: (integer, integer, integer, integer); +/// Возвращает кортеж из четырёх значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnReal4: (real, real, real, real); +/// Возвращает кортеж из четырёх значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnChar4: (char, char, char, char); +/// Возвращает кортеж из четырёх значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnString4: (string, string, string, string); + /// Возвращает кортеж из двух значений типа integer, введенных с клавиатуры function ReadInteger2(prompt: string): (integer, integer); /// Возвращает кортеж из двух значений типа real, введенных с клавиатуры @@ -672,15 +695,31 @@ function ReadReal3(prompt: string): (real, real, real); function ReadChar3(prompt: string): (char, char, char); /// Возвращает кортеж из трёх значений типа string, введенных с клавиатуры function ReadString3(prompt: string): (string, string, string); -/// Возвращает кортеж из двух значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnInteger3(prompt: string): (integer, integer, integer); -/// Возвращает кортеж из двух значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnReal3(prompt: string): (real, real, real); -/// Возвращает кортеж из двух значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnChar3(prompt: string): (char, char, char); -/// Возвращает кортеж из двух значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода +/// Возвращает кортеж из трёх значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода function ReadlnString3(prompt: string): (string, string, string); +/// Возвращает кортеж из четырёх значений типа integer, введенных с клавиатуры +function ReadInteger4(prompt: string): (integer, integer, integer, integer); +/// Возвращает кортеж из четырёх значений типа real, введенных с клавиатуры +function ReadReal4(prompt: string): (real, real, real, real); +/// Возвращает кортеж из четырёх значений типа char, введенных с клавиатуры +function ReadChar4(prompt: string): (char, char, char, char); +/// Возвращает кортеж из четырёх значений типа string, введенных с клавиатуры +function ReadString4(prompt: string): (string, string, string, string); +/// Возвращает кортеж из четырёх значений типа integer, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnInteger4(prompt: string): (integer, integer, integer, integer); +/// Возвращает кортеж из четырёх значений типа real, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnReal4(prompt: string): (real, real, real, real); +/// Возвращает кортеж из четырёх значений типа char, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnChar4(prompt: string): (char, char, char, char); +/// Возвращает кортеж из четырёх значений типа string, введенных с клавиатуры, и переходит на следующую строку ввода +function ReadlnString4(prompt: string): (string, string, string, string); /// Выводит приглашение к вводу и возвращает значение типа integer, введенное с клавиатуры function ReadInteger(prompt: string): integer; @@ -984,6 +1023,23 @@ procedure Rewrite(f: AbstractBinaryFile); /// Связывает файловую переменную f с файлом name на диске и открывает двоичный файл на чтение и запись, при этом обнуляя его содержимое. ///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file procedure Rewrite(f: AbstractBinaryFile; name: string); + +///- procedure Reset(f: двоичный файл; en: Encoding); +/// Открывает двоичный файл на чтение и запись в заданной кодировке. +///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file +procedure Reset(f: AbstractBinaryFile; en: Encoding); +///- procedure Reset(f: двоичный файл; name: string; en: Encoding); +/// Связывает файловую переменную f с файлом name на диске и открывает двоичный файл на чтение и запись в заданной кодировке. +///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file +procedure Reset(f: AbstractBinaryFile; name: string; en: Encoding); +///- procedure Rewrite(f: двоичный файл; en: Encoding); +/// Открывает двоичный файл на чтение и запись в заданной кодировке, при этом обнуляя его содержимое. Если файл существовал, он обнуляется. +///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file +procedure Rewrite(f: AbstractBinaryFile; en: Encoding); +///- procedure Rewrite(f: двоичный файл; name: string; en: Encoding); +/// Связывает файловую переменную f с файлом name на диске и открывает двоичный файл на чтение и запись в заданной кодировке, при этом обнуляя его содержимое. +///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file +procedure Rewrite(f: AbstractBinaryFile; name: string; en: Encoding); ///- procedure Truncate(f: двоичный файл); /// Усекает двоичный файл, отбрасывая все элементы с позиции файлового указателя. ///Двоичный файл - это либо типизированный файл file of T, либо бестиповой файл file @@ -1675,12 +1731,12 @@ function Length(a: System.Array): integer; ///- function Length(a: array of T; dim: integer): integer; /// Возвращает длину динамического массива по размерности dim function Length(a: System.Array; dim: integer): integer; -///- procedure SetLength(var a: array of T); +///- procedure SetLength(var a: array of T; n: integer); /// Устанавливает длину одномерного динамического массива. Старое содержимое сохраняется -//procedure SetLength(var a: System.Array); -///- procedure SetLength(var a: array of T; n1,n2,...: integer); +//procedure SetLength(var a: array of T; n: integer); +///- procedure SetLength(var a: array [,...,] of T; n1,n2,...: integer); /// Устанавливает размеры n-мерного динамического массива. Старое содержимое сохраняется -//procedure SetLength(var a: System.Array); +//procedure SetLength(var a: array[,...,] of T; n: integer); ///- function Copy(a: array of T): array of T; /// Создаёт копию динамического массива function Copy(a: System.Array): System.Array; @@ -1716,10 +1772,8 @@ procedure Shuffle(l: List); function Range(a, b: integer): sequence of integer; /// Возвращает последовательность символов от c1 до c2 function Range(c1, c2: char): sequence of char; -/// Возвращает последовательность вещественных в точках разбиения отрезка [a,b] на n равных частей (Используйте Partition) -function Range(a, b: real; n: integer): sequence of real; /// Возвращает последовательность вещественных в точках разбиения отрезка [a,b] на n равных частей -function Partition(a, b: real; n: integer): sequence of real; +function PartitionPoints(a, b: real; n: integer): sequence of real; /// Возвращает последовательность целых от a до b с шагом step function Range(a, b, step: integer): sequence of integer; /// Возвращает последовательность указанных элементов @@ -1836,7 +1890,6 @@ function ReadMatrInteger(m, n: integer): array [,] of integer; /// Возвращает матрицу m на n вещественных, введенных с клавиатуры function ReadMatrReal(m, n: integer): array [,] of real; - // ----------------------------------------------------- //>> Подпрограммы для создания кортежей # Subroutines for tuple generation // ----------------------------------------------------- @@ -1854,6 +1907,7 @@ function Rec(x1: T1; x2: T2; x3: T3; x4: T4; x5: T5; x6: ///-- function Rec(x1: T1; x2: T2; x3: T3; x4: T4; x5: T5; x6: T6; x7: T7): (T1, T2, T3, T4, T5, T6, T7); + // ----------------------------------------------------- //>> Короткие функции Lst, LLst, HSet, SSet, Dict, KV # Short functions Lst, HSet, SSet, Dict, KV // ----------------------------------------------------- @@ -1947,9 +2001,11 @@ var DefaultEncoding: Encoding; ///-- PrintDelimDefault: string := ' '; + ///-- + PrintMatrixWithFormat: boolean := True; -///-- var +///-- __CONFIG__: Dictionary := new Dictionary; // Вспомогательные подпрограммы. Из раздела интерфейса не убирать!!! @@ -2199,7 +2255,7 @@ procedure __FinalizeModule__; // DQNToNullable for dot_question_node // ----------------------------------------------------- -function DQNToNullable(v: integer): Nullable; +function DQNToNullable(v: T): Nullable; where T: record; implementation @@ -2235,6 +2291,7 @@ const PARAMETER_TO_OUT_OF_RANGE = 'Параметр to за пределами диапазона!!The to parameter out of bounds'; ARR_LENGTH_MUST_BE_MATCH_TO_MATR_SIZE = 'Размер одномерного массива не согласован с размером двумерного массива!!The 1-dim array length does not match 2-dim array size'; INITELEM_COUNT_MUST_BE_EQUAL_TO_MATRIX_ELEMS_COUNT = 'Количество инициализирующих элементов не совпадает с количеством элементов матрицы!!The number of elements in init list must be equal to the number of elements in matrix'; + TYPED_FILE_CANBE_OPENED_IN_SINGLEBYTE_ENCODING_ONLY = 'При открытии типизированного файла можно указывать только однобайтную кодировку!!Typed file can be opened in single byte encoding only'; // ----------------------------------------------------- // WINAPI @@ -3934,7 +3991,7 @@ begin end; end; -function Partition(a, b: real; n: integer): sequence of real; +function PartitionPoints(a, b: real; n: integer): sequence of real; begin Result := Range(a, b, n) end; @@ -4991,6 +5048,7 @@ function ReadlnChar2 := (ReadChar, ReadlnChar); function ReadlnString2 := (ReadString, ReadlnString); + function ReadInteger3 := (ReadInteger, ReadInteger, ReadInteger); function ReadReal3 := (ReadReal, ReadReal, ReadReal); @@ -5007,6 +5065,24 @@ function ReadlnChar3 := (ReadChar, ReadChar, ReadlnChar); function ReadlnString3 := (ReadString, ReadString, ReadlnString); + +function ReadInteger4 := (ReadInteger, ReadInteger, ReadInteger, ReadInteger); + +function ReadReal4 := (ReadReal, ReadReal, ReadReal, ReadReal); + +function ReadChar4 := (ReadChar, ReadChar, ReadChar, ReadChar); + +function ReadString4 := (ReadString, ReadString, ReadString, ReadString); + +function ReadlnInteger4 := (ReadInteger, ReadInteger, ReadInteger, ReadlnInteger); + +function ReadlnReal4 := (ReadReal, ReadReal, ReadReal, ReadlnReal); + +function ReadlnChar4 := (ReadChar, ReadChar, ReadChar, ReadlnChar); + +function ReadlnString4 := (ReadString, ReadString, ReadString, ReadlnString); + + function ReadInteger2(prompt: string) := (ReadInteger(prompt), ReadInteger); function ReadReal2(prompt: string) := (ReadReal(prompt), ReadReal); @@ -5023,6 +5099,7 @@ function ReadlnChar2(prompt: string) := (ReadChar(prompt), ReadlnChar); function ReadlnString2(prompt: string) := (ReadString(prompt), ReadlnString); + function ReadInteger3(prompt: string) := (ReadInteger(prompt), ReadInteger, ReadInteger); function ReadReal3(prompt: string) := (ReadReal(prompt), ReadReal, ReadReal); @@ -5040,6 +5117,22 @@ function ReadlnChar3(prompt: string) := (ReadChar(prompt), ReadChar, ReadlnChar) function ReadlnString3(prompt: string) := (ReadString(prompt), ReadString, ReadlnString); +function ReadInteger4(prompt: string) := (ReadInteger(prompt), ReadInteger, ReadInteger, ReadInteger); + +function ReadReal4(prompt: string) := (ReadReal(prompt), ReadReal, ReadReal, ReadReal); + +function ReadChar4(prompt: string) := (ReadChar(prompt), ReadChar, ReadChar, ReadChar); + +function ReadString4(prompt: string) := (ReadString(prompt), ReadString, ReadString, ReadString); + +function ReadlnInteger4(prompt: string) := (ReadInteger(prompt), ReadInteger, ReadInteger, ReadlnInteger); + +function ReadlnReal4(prompt: string) := (ReadReal(prompt), ReadReal, ReadReal, ReadlnReal); + +function ReadlnChar4(prompt: string) := (ReadChar(prompt), ReadChar, ReadChar, ReadlnChar); + +function ReadlnString4(prompt: string) := (ReadString(prompt), ReadString, ReadString, ReadlnString); + // Read with prompt function ReadInteger(prompt: string): integer; @@ -5471,16 +5564,24 @@ end; procedure Text.Print(params o: array of Object); begin - foreach var s in o do - PABCSystem.Write(Self, s, ' '); + if PrintDelimDefault<>'' then + foreach var s in o do + PABCSystem.Write(Self, s, PrintDelimDefault) + else + foreach var s in o do + PABCSystem.Write(Self, s) end; procedure Text.Println(params o: array of Object); begin if o.Length <> 0 then begin - for var i:=0 to o.Length-2 do - PABCSystem.Write(Self, o[i], ' '); + if PrintDelimDefault<>'' then + for var i:=0 to o.Length-2 do + PABCSystem.Write(Self, o[i], PrintDelimDefault) + else + for var i:=0 to o.Length-2 do + PABCSystem.Write(Self, o[i]); PABCSystem.Write(Self, o.Last); end; PABCSystem.Writeln(Self); @@ -5585,6 +5686,11 @@ begin PABCSystem.Reset(Self); end; +procedure AbstractBinaryFile.Rewrite; +begin + PABCSystem.Rewrite(Self); +end; + function AbstractBinaryFile.Name: string; begin Result := fi.Name @@ -5612,6 +5718,24 @@ function BinaryFile.Size: int64 := PABCSystem.FileSize(Self); procedure BinaryFile.Seek(n: int64) := PABCSystem.Seek(Self, n); +procedure BinaryFile.WriteBytes(a: array of byte); +begin + if Self.fi = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); + if Self.fs = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED)); + Self.bw.Write(a); +end; + +function BinaryFile.ReadBytes(count: integer): array of byte; +begin + if Self.fi = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); + if Self.fs = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED)); + Result := Self.br.ReadBytes(count) +end; + // ----------------------------------------------------- // Eoln - Eof // ----------------------------------------------------- @@ -5827,7 +5951,7 @@ end; procedure WritelnFormat(f: Text; formatstr: string; params args: array of object); begin var s := Format(formatstr, args); - writeln(f, s); + Writeln(f, s); end; // ----------------------------------------------------- @@ -5835,35 +5959,45 @@ end; // ----------------------------------------------------- procedure Print(s: string); begin - write(s, ' '); + if PrintDelimDefault<>'' then + Write(s, PrintDelimDefault) + else Write(s) end; procedure Print(params args: array of object); begin if args.Length = 0 then exit; - for var i := 0 to args.length - 1 do - write(args[i], ' '); + if PrintDelimDefault<>'' then + for var i := 0 to args.length - 1 do + Write(args[i], PrintDelimDefault) + else + for var i := 0 to args.length - 1 do + Write(args[i]) end; procedure Println(params args: array of object); begin Print(args); - writeln; + Writeln; end; procedure Print(f: Text; params args: array of object); begin if args.Length = 0 then exit; - for var i := 0 to args.length - 1 do - write(f, args[i], ' '); + if PrintDelimDefault<>'' then + for var i := 0 to args.length - 1 do + Write(f, args[i], PrintDelimDefault) + else + for var i := 0 to args.length - 1 do + Write(f, args[i]) end; procedure Println(f: Text; params args: array of object); begin Print(f, args); - writeln(f); + Writeln(f); end; // ----------------------------------------------------- // Text files @@ -5882,10 +6016,7 @@ begin f.sr := new StreamReader(f.fi.FullName, DefaultEncoding); end; -procedure AssignFile(f: Text; name: string); -begin - Assign(f, name); -end; +procedure AssignFile(f: Text; name: string) := Assign(f, name); procedure Close(f: Text); begin @@ -5908,15 +6039,9 @@ begin else raise new IOException(GetTranslation(FILE_NOT_OPENED)); end; -procedure CloseFile(f: Text); -begin - Close(f); -end; +procedure CloseFile(f: Text) := Close(f); -procedure Reset(f: Text); -begin - Reset(f, DefaultEncoding) -end; +procedure Reset(f: Text) := Reset(f, DefaultEncoding); procedure Reset(f: Text; en: Encoding); begin @@ -5938,15 +6063,12 @@ begin end; end; -procedure Reset(f: Text; name: string); -begin - Reset(f, name, DefaultEncoding) -end; +procedure Reset(f: Text; name: string) := Reset(f, name, DefaultEncoding); procedure Reset(f: Text; name: string; en: Encoding); begin - assign(f, name); - reset(f, en); + Assign(f, name); + Reset(f, en); end; procedure Rewrite(f: Text); @@ -5984,10 +6106,7 @@ begin Rewrite(f, en); end; -procedure Append(f: Text); -begin - Append(f, DefaultEncoding) -end; +procedure Append(f: Text) := Append(f, DefaultEncoding); procedure Append(f: Text; en: Encoding); begin @@ -5996,10 +6115,7 @@ begin f.sw := new StreamWriter(f.fi.FullName, True, en); end; -procedure Append(f: Text; name: string); -begin - Append(f, name, DefaultEncoding) -end; +procedure Append(f: Text; name: string) := Append(f, name, DefaultEncoding); procedure Append(f: Text; name: string; en: Encoding); begin @@ -6007,10 +6123,7 @@ begin Append(f, en); end; -function OpenRead(fname: string): Text; -begin - Result := OpenRead(fname, DefaultEncoding) -end; +function OpenRead(fname: string): Text := OpenRead(fname, DefaultEncoding); function OpenRead(fname: string; en: Encoding): Text; begin @@ -6019,10 +6132,7 @@ begin Result := f; end; -function OpenWrite(fname: string): Text; -begin - Result := OpenWrite(fname, DefaultEncoding) -end; +function OpenWrite(fname: string): Text := OpenWrite(fname, DefaultEncoding); function OpenWrite(fname: string; en: Encoding): Text; begin @@ -6031,10 +6141,7 @@ begin Result := f; end; -function OpenAppend(fname: string): Text; -begin - Result := OpenAppend(fname, DefaultEncoding) -end; +function OpenAppend(fname: string): Text := OpenAppend(fname, DefaultEncoding); function OpenAppend(fname: string; en: Encoding): Text; begin @@ -6192,10 +6299,7 @@ begin f.fi := System.IO.FileInfo.Create(name); end; -procedure AssignFile(f: AbstractBinaryFile; name: string); -begin - Assign(f, name); -end; +procedure AssignFile(f: AbstractBinaryFile; name: string) := Assign(f, name); procedure Close(f: AbstractBinaryFile); begin @@ -6213,10 +6317,7 @@ begin end; end; -procedure CloseFile(f: AbstractBinaryFile); -begin - Close(f); -end; +procedure CloseFile(f: AbstractBinaryFile) := Close(f); procedure Reset(f: AbstractBinaryFile; en: Encoding); begin @@ -6248,6 +6349,8 @@ end; procedure Rewrite(f: AbstractBinaryFile; en: Encoding); begin + if (f is TypedFile) and not en.IsSingleByte then + raise new System.IO.IOException(GetTranslation(TYPED_FILE_CANBE_OPENED_IN_SINGLEBYTE_ENCODING_ONLY)); if f.fi = nil then raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); if f.fs = nil then @@ -6340,7 +6443,7 @@ begin else if t.IsEnum then Result := f.br.ReadInt32 else if t.IsValueType then begin - elem := Activator.CreateInstance(t); + elem := Activator.CreateInstance(t,true); fa := t.GetFields(System.Reflection.BindingFlags.GetField or System.Reflection.BindingFlags.Instance or System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.NonPublic); for var i := 0 to fa.Length - 1 do if {not fa[i].IsStatic and} not fa[i].IsLiteral then @@ -6350,10 +6453,14 @@ begin else if t = typeof(string) then begin - var len := f.br.ReadByte(); - var chh := f.br.ReadChars(len); + if f is TypedFile then + begin + var len := f.br.ReadByte(); + var chh := f.br.ReadChars(len); - Result := new string(chh); + Result := new string(chh); + end + else Result := f.br.ReadString(); if (f is TypedFile) and ((f as TypedFile).offsets <> nil) and ((f as TypedFile).offsets.Length > 0) then begin f.br.BaseStream.Seek((f as TypedFile).offsets[ind] - (Result as string).Length, SeekOrigin.Current); @@ -6443,8 +6550,12 @@ begin else if t = typeof(string) then begin //var tmp := f.bw.BaseStream.Position; - f.bw.Write(byte(string(val).Length)); - f.bw.Write(string(val).ToArray); + if f is TypedFile then + begin + f.bw.Write(byte(string(val).Length)); + f.bw.Write(string(val).ToArray); + end + else f.bw.Write(string(val)); if (f is TypedFile) and ((f as TypedFile).offsets <> nil) and ((f as TypedFile).offsets.Length > 0) then begin f.bw.Write(new byte[(f as TypedFile).offsets[ind] - (val as string).Length]); @@ -6859,7 +6970,10 @@ begin //result:= Convert.ToString(integer(p), 16); if p = nil then result := 'nil' - else result := '$' + integer(p).ToString('X'); + else if Environment.Is64BitProcess then + result := '$' + int64(p).ToString('X') + else + result := '$' + integer(p).ToString('X') end; procedure Exec(filename: string); @@ -7916,8 +8030,8 @@ function StrToReal(s: string) := Convert.ToDouble(s, nfi); function StrToFloat(s: string) := StrToReal(s); function TryStrToInt64(s: string; var value: int64) := int64.TryParse(s, value); -function TryStrToReal(s: string; var value: real) := real.TryParse(s,System.Globalization.NumberStyles.Float,nil,value); -function TryStrToSingle(s: string; var value: single) := single.TryParse(s,System.Globalization.NumberStyles.Float,nil,value); +function TryStrToReal(s: string; var value: real) := real.TryParse(s,System.Globalization.NumberStyles.Float,new Globalization.NumberFormatInfo,value); +function TryStrToSingle(s: string; var value: single) := single.TryParse(s,System.Globalization.NumberStyles.Float,new Globalization.NumberFormatInfo,value); function TryStrToFloat(s: string; var value: real) := TryStrToReal(s, value); function TryStrToFloat(s: string; var value: single) := TryStrToSingle(s, value); @@ -8395,6 +8509,12 @@ begin Result := Self; end; +function Print(Self: int64): int64; extensionmethod; +begin + PABCSystem.Print(Self); + Result := Self; +end; + function Print(Self: real): real; extensionmethod; begin PABCSystem.Print(Self); @@ -8419,12 +8539,24 @@ begin Result := Self; end; +function Print(Self: string): string; extensionmethod; +begin + PABCSystem.Print(Self); + Result := Self; +end; + function Println(Self: integer): integer; extensionmethod; begin PABCSystem.Println(Self); Result := Self; end; +function Println(Self: int64): int64; extensionmethod; +begin + PABCSystem.Println(Self); + Result := Self; +end; + function Println(Self: real): real; extensionmethod; begin PABCSystem.Println(Self); @@ -8449,6 +8581,11 @@ begin Result := Self; end; +function Println(Self: string): string; extensionmethod; +begin + PABCSystem.Println(Self); + Result := Self; +end; //------------------------------------------------------------------------------ @@ -8552,6 +8689,22 @@ begin end; end; +/// Возвращает произведение элементов последовательности +function Product(Self: sequence of real): real; extensionmethod; +begin + Result := 1.0; + foreach var x in Self do + Result *= x; +end; + +/// Возвращает произведение элементов последовательности +function Product(Self: sequence of integer): integer; extensionmethod; +begin + Result := 1; + foreach var x in Self do + Result *= x; +end; + /// Возвращает отсортированную по возрастанию последовательность function Sorted(Self: sequence of T): sequence of T; extensionmethod; begin @@ -8679,7 +8832,7 @@ begin yield func(x, y) end; -/// Разбивает последовательности на две в позиции ind +/// Разбивает последовательность на две в позиции ind. Реализуется двухпроходным алгоритмом function SplitAt(Self: sequence of T; ind: integer): (sequence of T, sequence of T); extensionmethod; begin Result := (Self.Take(ind), Self.Skip(ind)); @@ -8689,13 +8842,13 @@ end; // ToDo: SequenceCompare -/// Разделяет последовательности на две по заданному условию +/// Разделяет последовательность на две по заданному условию. Реализуется двухпроходным алгоритмом function Partition(Self: sequence of T; cond: T->boolean): (sequence of T, sequence of T); extensionmethod; begin Result := (Self.Where(cond), Self.Where(x -> not cond(x))); end; -/// Разделяет последовательности на две по заданному условию, в котором участвует индекс +/// Разделяет последовательность на две по заданному условию, в котором участвует индекс. Реализуется двухпроходным алгоритмом function Partition(Self: sequence of T; cond: (T,integer)->boolean): (sequence of T, sequence of T); extensionmethod; begin Result := (Self.Where(cond), Self.Where((x, i)-> not cond(x, i))); @@ -8731,19 +8884,19 @@ begin Result := Self.Zip(a, (x, y)-> (x, y)).Zip(b, (p, z)-> (p[0], p[1], z)).Zip(c, (p, z)-> (p[0], p[1], p[2], z)); end; -/// Разъединяет последовательность двухэлементных кортежей на две последовательности +/// Разъединяет последовательность двухэлементных кортежей на две последовательности. Реализуется двухпроходным алгоритмом function UnZipTuple(Self: sequence of (T, T1)): (sequence of T, sequence of T1); extensionmethod; begin Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1])) end; -/// Разъединяет последовательность трехэлементных кортежей на три последовательности +/// Разъединяет последовательность трехэлементных кортежей на три последовательности. Реализуется многопроходным алгоритмом function UnZipTuple(Self: sequence of (T, T1, T2)): (sequence of T, sequence of T1, sequence of T2); extensionmethod; begin Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2])) end; -/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности +/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности. Реализуется многопроходным алгоритмом function UnZipTuple(Self: sequence of (T, T1, T2, T3)): (sequence of T, sequence of T1, sequence of T2, sequence of T3); extensionmethod; begin Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2]), Self.Select(x -> x[3])) @@ -9046,7 +9199,7 @@ begin end; /// Возвращает индекс первого минимального элемента начиная с позиции index -function IndexMin(Self: IList; index: integer := 0): integer; extensionmethod;where T: IComparable; +function IndexMin(Self: IList; index: integer := 0): integer; extensionmethod; where T: IComparable; begin var min := Self[index]; Result := index; @@ -9059,7 +9212,7 @@ begin end; /// Возвращает индекс первого максимального элемента начиная с позиции index -function IndexMax(self: IList; index: integer := 0): integer; extensionmethod;where T: System.IComparable; +function IndexMax(self: IList; index: integer := 0): integer; extensionmethod; where T: System.IComparable; begin var max := Self[index]; Result := index; @@ -9072,7 +9225,7 @@ begin end; /// Возвращает индекс последнего минимального элемента -function LastIndexMin(Self: IList): integer; extensionmethod;where T: System.IComparable; +function LastIndexMin(Self: IList): integer; extensionmethod; where T: System.IComparable; begin var min := Self[Self.Count - 1]; Result := Self.Count - 1; @@ -9085,7 +9238,7 @@ begin end; /// Возвращает индекс последнего минимального элемента в диапазоне [0,index-1] -function LastIndexMin(Self: IList; index: integer): integer; extensionmethod;where T: System.IComparable; +function LastIndexMin(Self: IList; index: integer): integer; extensionmethod; where T: System.IComparable; begin var min := Self[index]; Result := index; @@ -9098,7 +9251,7 @@ begin end; /// Возвращает индекс последнего максимального элемента -function LastIndexMax(Self: IList): integer; extensionmethod;where T: System.IComparable; +function LastIndexMax(Self: IList): integer; extensionmethod; where T: System.IComparable; begin var max := Self[Self.Count - 1]; Result := Self.Count - 1; @@ -9111,7 +9264,7 @@ begin end; /// Возвращает индекс последнего минимального элемента в диапазоне [0,index-1] -function LastIndexMax(Self: IList; index: integer): integer; extensionmethod;where T: System.IComparable; +function LastIndexMax(Self: IList; index: integer): integer; extensionmethod; where T: System.IComparable; begin var max := Self[index]; Result := index; @@ -9382,9 +9535,9 @@ begin begin for var j := 0 to Self.ColCount - 1 do begin - var elem := Self[i, j]; - var s := StructuredObjectToString(elem); - Write(s.PadLeft(w)); + if PrintMatrixWithFormat then + Write(StructuredObjectToString(Self[i, j]).PadLeft(w)) + else Print(Self[i, j]); end; Writeln; end; @@ -9397,7 +9550,11 @@ begin for var i := 0 to Self.RowCount - 1 do begin for var j := 0 to Self.ColCount - 1 do - Write(FormatValue(Self[i, j], w, f)); + begin + if PrintMatrixWithFormat then + Write(FormatValue(Self[i, j], w, f)) + else Print(Self[i, j]); + end; Writeln; end; Result := Self; @@ -9511,6 +9668,21 @@ begin yield (Self[i, j], i, j) end; +/// Возвращает по заданному двумерному массиву последовательность (a[i,j],i,j) +function ElementsWithIndices(Self: array [,] of T): sequence of (T, integer, integer); extensionmethod := Self.ElementsWithIndexes; + +/// Возвращает по заданному двумерному массиву последовательность индексов элементов, удовлетворяющих заданному условию +function IndexesOf(Self: array [,] of T; cond: T -> boolean): sequence of (integer, integer); extensionmethod; +begin + for var i := 0 to Self.RowCount - 1 do + for var j := 0 to Self.ColCount - 1 do + if cond(Self[i,j]) then + yield (i, j) +end; + +/// Возвращает по заданному двумерному массиву последовательность индексов элементов, удовлетворяющих заданному условию +function IndicesOf(Self: array [,] of T; cond: T -> boolean): sequence of (integer, integer); extensionmethod := Self.IndexesOf(cond); + /// Возвращает по заданному двумерному массиву последовательность его элементов по строкам function ElementsByRow(Self: array [,] of T): sequence of T; extensionmethod; begin @@ -9569,6 +9741,22 @@ begin Self[i, j] := f(i, j); end; +/// Применяет действие к каждому элементу двумерного массива +procedure &ForEach(Self: array [,] of T; act: T -> ()); extensionmethod; +begin + for var i := 0 to Self.RowCount - 1 do + for var j := 0 to Self.ColCount - 1 do + act(Self[i, j]); +end; + +/// Применяет действие к каждому элементу двумерного массива +procedure &ForEach(Self: array [,] of T; act: (T,integer,integer) -> ()); extensionmethod; +begin + for var i := 0 to Self.RowCount - 1 do + for var j := 0 to Self.ColCount - 1 do + act(Self[i, j],i,j); +end; + // ----------------------------------------------------- //>> Фиктивная секция YYY - не удалять! # YYY // ----------------------------------------------------- @@ -9697,7 +9885,7 @@ begin end;} /// Возвращает минимальный элемент -function Min(Self: array of T): T; extensionmethod;where T: System.IComparable; +function Min(Self: array of T): T; extensionmethod; where T: System.IComparable; begin Result := Self[0]; for var i := 1 to Self.Length - 1 do @@ -9706,7 +9894,7 @@ begin end; /// Возвращает максимальный элемент -function Max(Self: array of T): T; extensionmethod;where T: System.IComparable; +function Max(Self: array of T): T; extensionmethod; where T: System.IComparable; begin Result := Self[0]; for var i := 1 to Self.Length - 1 do @@ -9957,6 +10145,9 @@ function Low(Self: System.Array); extensionmethod := Low(Self); /// Возвращает последовательность индексов одномерного массива function Indexes(Self: array of T): sequence of integer; extensionmethod := Range(0, Self.Length - 1); +/// Возвращает последовательность индексов одномерного массива +function Indices(Self: array of T): sequence of integer; extensionmethod := Self.Indexes; + /// Возвращает последовательность индексов элементов одномерного массива, удовлетворяющих условию function IndexesOf(Self: array of T; cond: T->boolean): sequence of integer; extensionmethod; begin @@ -9965,6 +10156,9 @@ begin yield i; end; +/// Возвращает последовательность индексов элементов одномерного массива, удовлетворяющих условию +function IndicesOf(Self: array of T; cond: T->boolean): sequence of integer; extensionmethod := Self.IndexesOf(cond); + /// Возвращает последовательность индексов элементов одномерного массива, удовлетворяющих условию function IndexesOf(Self: array of T; cond: (T,integer) ->boolean): sequence of integer; extensionmethod; begin @@ -9973,6 +10167,9 @@ begin yield i; end; +/// Возвращает последовательность индексов элементов одномерного массива, удовлетворяющих условию +function IndicesOf(Self: array of T; cond: (T,integer) ->boolean): sequence of integer; extensionmethod := Self.IndexesOf(cond); + ///-- function CreateSliceFromArrayInternal(Self: array of T; from, step, count: integer): array of T; begin @@ -10898,7 +11095,7 @@ begin TypeCode.UInt64: Result := sizeof(UInt64); TypeCode.SByte: Result := sizeof(SByte); TypeCode.Single: Result := sizeof(Single); - else if t.IsEnum then result := sizeof(integer); + else if t.IsEnum then Result := sizeof(integer); end//; //end else @@ -11417,7 +11614,8 @@ begin //ci.NumberFormat := nfi; //System.Globalization.CultureInfo.CurrentCulture := ci; - // System.Threading.Thread.CurrentThread.CurrentCulture := new System.Globalization.CultureInfo('en-US'); + // SSM 10/11/18 восстановил эту строку чтобы в главном потоке в вещественных была точка + System.Threading.Thread.CurrentThread.CurrentCulture := new System.Globalization.CultureInfo('en-US'); //rnd := new System.Random; StartTime := DateTime.Now; output := new TextFile(); @@ -11456,9 +11654,9 @@ end; // DQNToNullable for dot_question_node: implementation // ----------------------------------------------------- -function DQNToNullable(v: integer): System.Nullable; +function DQNToNullable(v: T): System.Nullable; where T: record; begin - Result := new System.Nullable(v); + Result := new System.Nullable(v); end; initialization diff --git a/TestSuite/intellisense_tests/delegates3.pas b/TestSuite/intellisense_tests/delegates3.pas new file mode 100644 index 000000000..4827fd0c5 --- /dev/null +++ b/TestSuite/intellisense_tests/delegates3.pas @@ -0,0 +1,5 @@ +begin + var d: procedure := procedure->Sleep(1000); + d.BeginInvoke{@function BeginInvoke(callback: AsyncCallback; object: Object): IAsyncResult; virtual;@}(nil,nil); + d.EndInvoke{@procedure EndInvoke(result: IAsyncResult); virtual;@}(nil); +end. \ No newline at end of file diff --git a/TestSuite/intellisense_tests/indexer2.pas b/TestSuite/intellisense_tests/indexer2.pas index 487f3b802..33bb3eac7 100644 --- a/TestSuite/intellisense_tests/indexer2.pas +++ b/TestSuite/intellisense_tests/indexer2.pas @@ -1,5 +1,5 @@ begin ReadlnString .ToWords[0] - .Println{@(расширение sequence of T) function Println(): sequence of T;@} + .Println{@(расширение) function string.Println(): string;@} end. \ No newline at end of file