/// Модуль LightPT автоматической легковесной проверки заданий unit LightPT; {$reference System.Net.Http.dll} {$reference System.Security.dll} interface uses System.Runtime.InteropServices; var ServerAddr := 'https://air.mmcs.sfedu.ru/pascalabc'; {==============================================================} { Класс для формирования вывода } {==============================================================} type /// Класс для формирования вывода ObjectList = class lst := new List; public static function New: ObjectList := ObjectList.Create; procedure Add(o: object) := lst.Add(o); function AddRange(sq: sequence of integer): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddRange(sq: sequence of real): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddRange(sq: sequence of string): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddRange(sq: sequence of char): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddRange(sq: sequence of boolean): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddRange(sq: sequence of object): ObjectList; begin lst.AddRange(sq); Result := Self end; function AddRange(sq: sequence of System.Type): ObjectList; begin lst.AddRange(sq.Select(x -> object(x))); Result := Self end; function AddFill(n: integer; elem: object): ObjectList; begin lst.AddRange(ArrFill(n,elem)); Result := Self end; function AddArithm(n: integer; a0,step: integer): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x+step).Select(x -> object(x))); Result := Self end; function AddArithm(n: integer; a0,step: real): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x+step).Select(x -> object(x))); Result := Self end; function AddFib(n: integer): ObjectList; begin lst.AddRange(ArrGen(n,1,1,(x,y)->x+y).Select(x -> object(x))); Result := Self end; function AddGeom(n: integer; a0,step: integer): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x*step).Select(x -> object(x))); Result := Self end; function AddGeom(n: integer; a0,step: real): ObjectList; begin lst.AddRange(ArrGen(n,a0,x->x*step).Select(x -> object(x))); Result := Self end; end; {==================================================================================} { Сервисные типы } {==================================================================================} type MessageColorT = (MsgColorGreen, MsgColorRed, MsgColorOrange, MsgColorMagenta, MsgColorGray); TaskStatus = (NotUnderControl, Solved, IOError, BadSolution, PartialSolution, InitialTask, BadInitialTask, InitialTaskPT4, ErrFix, Demo); // Короткий результат для БД {==================================================================================} { Переопределенные функций стандартного модуля с заполнением ввода и вывода } {==================================================================================} /// Возвращает случайное целое в диапазоне от a до b function Random(a, b: integer): integer; /// Возвращает случайное целое в диапазоне от 0 до n-1 function Random(n: integer): integer; /// Возвращает случайное вещественное в диапазоне [0..1) function Random: real; /// Возвращает случайное вещественное в диапазоне [a,b) function Random(a, b: real): real; /// Возвращает случайное вещественное в диапазоне [a,b] c количеством значащих цифр после точки, равным digits function RandomReal(a, b: real; digits: integer := 1): real; /// Возвращает случайный символ в диапазоне от a до b function Random(a, b: char): char; /// Возвращает случайное целое в диапазоне function Random(diap: IntRange): integer; /// Возвращает случайное вещественное в диапазоне function Random(diap: RealRange): real; /// Возвращает случайный символ в диапазоне function Random(diap: CharRange): char; /// Возвращает кортеж из двух случайных целых в диапазоне от a до b function Random2(a, b: integer): (integer, integer); /// Возвращает кортеж из двух случайных вещественных в диапазоне от a до b function Random2(a, b: real): (real, real); /// Возвращает кортеж из двух случайных символов в диапазоне от a до b function Random2(a, b: char): (char, char); /// Возвращает кортеж из двух случайных целых в диапазоне function Random2(diap: IntRange): (integer, integer); /// Возвращает кортеж из двух случайных символов в диапазоне function Random2(diap: CharRange): (char, char); /// Возвращает кортеж из двух случайных вещественных в диапазоне function Random2(diap: RealRange): (real, real); /// Возвращает кортеж из трех случайных целых в диапазоне от a до b function Random3(a, b: integer): (integer, integer, integer); /// Возвращает кортеж из трех случайных вещественных в диапазоне от a до b function Random3(a, b: real): (real, real, real); /// Возвращает кортеж из трех случайных символов в диапазоне от a до b function Random3(a, b: char): (char, char, char); /// Возвращает кортеж из трех случайных целых в диапазоне function Random3(diap: IntRange): (integer, integer, integer); /// Возвращает кортеж из трех случайных вещественных в диапазоне function Random3(diap: RealRange): (real, real, real); /// Возвращает кортеж из трех случайных символов в диапазоне function Random3(diap: CharRange): (char, char, char); /// Возвращает массив размера n, заполненный случайными целыми значениями в диапазоне от a до b function ArrRandomInteger(n: integer; a: integer; b: integer): array of integer; /// Возвращает массив размера n, заполненный случайными целыми значениями в диапазоне от 0 до 100 function ArrRandomInteger(n: integer): array of integer; /// Возвращает массив размера n, заполненный случайными вещественными значениями в диапазоне от a до b function ArrRandomReal(n: integer; a: real; b: real; digits: integer := 1): array of real; /// Возвращает массив размера n, заполненный случайными вещественными значениями в диапазоне от 0 до 10 function ArrRandomReal(n: integer; digits: integer := 1): array of real; /// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями function MatrRandomInteger(m: integer; n: integer; a: integer; b: integer): array [,] of integer; /// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями function MatrRandomInteger(m: integer; n: integer): array [,] of integer; /// Возвращает двумерный массив размера m x n, заполненный случайными вещественными значениями function MatrRandomReal(m: integer; n: integer; a: real; b: real; digits: integer := 2): array [,] of real; /// Возвращает двумерный массив размера m x n, заполненный случайными вещественными значениями function MatrRandomReal(m: integer; n: integer): array [,] of real; /// Возвращает двумерный массив размера m x n, заполненный элементами gen(i,j) //function MatrGen(m, n: integer; gen: (integer,integer)->T): array [,] of T; /// Выводит приглашение к вводу и возвращает значение типа integer, введенное с клавиатуры function ReadInteger(prompt: string): integer; /// Выводит приглашение к вводу и возвращает значение типа integer, введенное с клавиатуры function ReadlnInteger(prompt: string): integer; /// Выводит приглашение к вводу и возвращает два значения типа integer, введенные с клавиатуры function ReadInteger2(prompt: string): (integer, integer); /// Выводит приглашение к вводу и возвращает два значения типа integer, введенные с клавиатуры function ReadlnInteger2(prompt: string): (integer, integer); /// Выводит приглашение к вводу и возвращает три значения типа integer, введенные с клавиатуры function ReadInteger3(prompt: string): (integer, integer, integer); /// Выводит приглашение к вводу и возвращает три значения типа integer, введенные с клавиатуры function ReadlnInteger3(prompt: string): (integer, integer, integer); /// Выводит приглашение к вводу и возвращает три значения типа integer, введенные с клавиатуры function ReadInteger4(prompt: string): (integer, integer, integer, integer); /// Выводит приглашение к вводу и возвращает три значения типа integer, введенные с клавиатуры function ReadlnInteger4(prompt: string): (integer, integer, integer, integer); /// Выводит приглашение к вводу и возвращает значение типа real, введенное с клавиатуры function ReadReal(prompt: string): real; /// Выводит приглашение к вводу и возвращает значение типа real, введенное с клавиатуры function ReadlnReal(prompt: string): real; /// Выводит приглашение к вводу и возвращает два значения типа real, введенные с клавиатуры function ReadReal2(prompt: string): (real, real); /// Выводит приглашение к вводу и возвращает два значения типа real, введенные с клавиатуры function ReadlnReal2(prompt: string): (real, real); /// Выводит приглашение к вводу и возвращает три значения типа real, введенные с клавиатуры function ReadReal3(prompt: string): (real, real, real); /// Выводит приглашение к вводу и возвращает три значения типа real, введенные с клавиатуры function ReadlnReal3(prompt: string): (real, real, real); /// Выводит приглашение к вводу и возвращает три значения типа real, введенные с клавиатуры function ReadReal4(prompt: string): (real, real, real, real); /// Выводит приглашение к вводу и возвращает три значения типа real, введенные с клавиатуры function ReadlnReal4(prompt: string): (real, real, real, real); /// Выводит приглашение к вводу и возвращает значение типа char, введенное с клавиатуры function ReadChar(prompt: string): char; /// Выводит приглашение к вводу и возвращает значение типа char, введенное с клавиатуры function ReadlnChar(prompt: string): char; /// Выводит приглашение к вводу и возвращает значение типа string, введенное с клавиатуры function ReadString(prompt: string): string; /// Выводит приглашение к вводу и возвращает значение типа string, введенное с клавиатуры function ReadlnString(prompt: string): string; ///- procedure Print(a,b,...); /// Выводит значения a,b,... на экран, после каждого значения выводит пробел procedure Print(params args: array of object); ///- procedure Println(a,b,...); /// Выводит значения a,b,... на экран, после каждого значения выводит пробел и переходит на новую строку procedure Println(params args: array of object); /// Выводит значение экран и выводит пробел procedure Print(ob: object); /// Выводит значение экран и выводит пробел procedure Print(s: string); /// Выводит значение экран и выводит пробел procedure Print(c: char); {=========================================================================} { Сервисные процедуры } {=========================================================================} // Вывести цветовое сообщение в окно вывода procedure ColoredMessage(msg: string; color: MessageColorT); // Вывести сообщение красным цветом в окно вывода procedure ColoredMessage(msg: string); function ToObjArray(a: sequence of integer): array of object; function ToObjArray(a: sequence of real): array of object; function ToObjArray(a: sequence of string): array of object; function ToObjArray(a: sequence of char): array of object; function ToObjArray(a: sequence of boolean): array of object; {=========================================================================} { Основные процедуры для проверки правильности ввода-вывода } {=========================================================================} // Самые часто используемые: CheckOutput // CheckInput заменено на CheckData /// Проверить типы вводимых данных. Пользуйтесь CheckData(Input := cInt * 2) procedure CheckInput(a: array of System.Type); /// Проверить значения при выводе. Основной способ проверки procedure CheckOutput(params arr: array of object); /// Проверить значения при выводе. Сообщения ColoredMessage гасить. Нужно для повторных вызовов CheckOutput procedure CheckOutputSilent(params arr: array of object); /// Проверить значения при выводе. Основной способ проверки procedure CheckOutput(a: ObjectList); /// Проверить значения при выводе. Сообщения ColoredMessage гасить. Нужно для повторных вызовов CheckOutput procedure CheckOutputSilent(a: ObjectList); /// Проверить, что данные не вводились. Пользуйтесь CheckData(Empty) procedure CheckInputIsEmpty; /// Проверить, что помимо начального ввода других данных не вводилось procedure CheckInputIsInitial; /// Синоним CheckInput procedure CheckInputTypes(a: array of System.Type); /// Проверить количество вводимых данных procedure CheckInputCount(n: integer); /// Проверить количество вводимых данных procedure CheckInput2Count(i: integer); /// Проверить количество выводимых данных procedure CheckOutput2Count(i: integer); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of integer); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of real); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of string); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of char); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of boolean); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of object); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: sequence of word); /// Проверить последовательность значений при выводе procedure CheckOutputSeq(a: ObjectList); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of integer); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of real); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of string); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of char); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of boolean); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of object); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: sequence of word); /// Проверить последовательность значений при выводе. Не выводить сообщения ColoredMessages procedure CheckOutputSeqSilent(a: ObjectList); /// Проверить вывод в виде строки procedure CheckOutputString(str: string); /// Сравнить типы выведенных значений с указанными procedure CompareTypeWithOutput(params a: array of System.Type); /// Сравнить два значения function CompareValues(o1, o2: Object): boolean; /// Сравнить два массива function CompareArrValues(a,lst: array of object): boolean; /// Сравнить значения с выводом function CompareValuesWithOutput(params a: array of object): boolean; {============================================================================================} { Подпрограммы для проверки начального ввода-вывода, представленного в заготовке задания } {============================================================================================} /// Проверить типы данных начального ввода, начального вывода и ввода. Если ввод Input = nil, то он совпадает с начальным вводом procedure CheckData(InitialInput: array of System.Type := nil; InitialOutput: array of System.Type := nil; Input: array of System.Type := nil); procedure CheckInitialIO; procedure CheckInitialIOIsEmpty; procedure InitialOutput(a: array of System.Type); procedure InitialInput(a: array of System.Type); //procedure CheckInitialOutputValues(params a: array of object); - тут значений быть не должно! procedure CheckInitialOutput(params a: array of System.Type); procedure CheckInitialInput(params a: array of System.Type); procedure CheckInitialOutputSeq(a: sequence of System.Type); procedure CheckInitialInputSeq(a: sequence of System.Type); procedure CheckInitialIOSeqs(input,output: sequence of System.Type); procedure CheckOutputAfterInitial(params arr: array of object); // проверить только то, что после исходного вывода procedure CheckOutputAfterInitial(a: ObjectList); procedure CheckOutputAfterInitialSilent(params arr: array of object); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of integer); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of real); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of string); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of boolean); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of char); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: sequence of object); /// Проверить последовательность значений при выводе после начального вывода procedure CheckOutputAfterInitialSeq(seq: ObjectList); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of integer); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of real); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of string); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of boolean); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of char); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: sequence of object); /// Проверить последовательность значений при выводе после начального вывода. Не выводить сообщения ColoredMessages procedure CheckOutputAfterInitialSeqSilent(seq: ObjectList); {=========================================================} { Функции для проверки элементов ввода-вывода } {=========================================================} /// i-тый элемент ввода - целое function IsInt(i: integer): boolean; /// i-тый элемент ввода - вещественное function IsRe(i: integer): boolean; /// i-тый элемент ввода - строка function IsStr(i: integer): boolean; /// i-тый элемент ввода - логическое function IsBoo(i: integer): boolean; /// i-тый элемент ввода - символ function IsChr(i: integer): boolean; /// i-тый элемент вывода - целое function OutIsInt(i: integer): boolean; /// i-тый элемент вывода - вещественное function OutIsRe(i: integer): boolean; /// i-тый элемент вывода - строка function OutIsStr(i: integer): boolean; /// i-тый элемент вывода - логическое function OutIsBoo(i: integer): boolean; /// i-тый элемент вывода - символ function OutIsChr(i: integer): boolean; /// i-тый элемент ввода как целое function Int(i: integer): integer; /// i-тый элемент ввода как вещественное function Re(i: integer): real; /// i-тый элемент ввода как строка function Str(i: integer): string; /// i-тый элемент ввода как логическое function Boo(i: integer): boolean; /// i-тый элемент ввода как символ function Chr(i: integer): char; /// i-тый элемент вывода как целое function OutInt(i: integer): integer; /// i-тый элемент вывода как вещественное function OutRe(i: integer): real; /// i-тый элемент вывода как строка function OutBoo(i: integer): boolean; /// i-тый элемент вывода как логическое function OutChr(i: integer): char; /// i-тый элемент вывода как символ function OutStr(i: integer): string; /// Следующий элемент ввода как целое function Int: integer; /// Следующий элемент ввода как вещественное function Re: real; /// Следующий элемент ввода как строка function Str: string; /// Следующий элемент ввода как логическое function Boo: boolean; /// Следующий элемент ввода как символ function Chr: char; /// Следующие два элемента ввода как целые function Int2: (integer, integer); /// Следующие два элемента ввода как вещественные function Re2: (real, real); /// Следующие n элементов ввода как массив целых function IntArr(n: integer): array of integer; /// Следующие n элементов ввода как массив вещественных function ReArr(n: integer): array of real; /// Следующие n элементов ввода как массив логических function BooArr(n: integer): array of boolean; /// Следующие n элементов ввода как массив символов function ChrArr(n: integer): array of char; /// Следующие n элементов ввода как массив строк function StrArr(n: integer): array of string; // функции, возвращающие входные и выходные списки, а также их срезы, приведенные к нужному типу function InputListAsIntegers: array of integer; function InputListAsReals: array of real; function InputListAsBooleans: array of boolean; function InputListAsChars: array of char; function InputListAsStrings: array of string; function OutputListAsIntegers: array of integer; function OutputListAsReals: array of real; function OutputListAsBooleans: array of boolean; function OutputListAsChars: array of char; function OutputListAsStrings: array of string; function InSliceIntArr(a,b: integer): array of integer; function InSliceReArr(a,b: integer): array of real; function InSliceBooArr(a,b: integer): array of boolean; function InSliceChrArr(a,b: integer): array of char; function InSliceStrArr(a,b: integer): array of string; /// Срез элементов вывода от a до b как массив целых function OutSliceIntArr(a,b: integer): array of integer; /// Срез элементов вывода от a до b как массив вещественных function OutSliceReArr(a,b: integer): array of real; /// Срез элементов вывода от a до b как массив логических function OutSliceBooArr(a,b: integer): array of boolean; /// Срез элементов вывода от a до b как массив символов function OutSliceChrArr(a,b: integer): array of char; /// Срез элементов вывода от a до b как массив строк function OutSliceStrArr(a,b: integer): array of string; {=========================================================} { Тип TestCell и функции для генерации тестов } {=========================================================} type [StructLayout(LayoutKind.Explicit)] /// Ячейка генерации данных для тестов TestCell = class public [FieldOffset(0)] typ: System.Type; [FieldOffset(8)] a: integer; [FieldOffset(12)] b: integer; [FieldOffset(8)] ra: real; [FieldOffset(16)] rb: real; [FieldOffset(24)] digits: integer; [FieldOffset(8)] ca: char; [FieldOffset(10)] cb: char; constructor (typ: System.Type); begin Self.typ := typ; end; function GenerateData: object; begin if typ = typeof(integer) then Result := Random(a,b) else if typ = typeof(char) then Result := Random(ca,cb) else if typ = typeof(real) then Result := RandomReal(ra,rb,digits) else if typ = typeof(boolean) then Result := Random(2)=0 ? False : True else Result := nil; end; end; /// Сгенерировать по последовательности спецификаций в тестовых ячейках список данных для теста function GenValuesByTestCells(a: sequence of TestCell): List; /// Сгенерировать целую тестовую ячейку function tInt(a: integer := 1; b: integer := 10): TestCell; /// Сгенерировать вещественную тестовую ячейку function tRe(ra: real := 1; rb: Real := 10; digits: integer := 0): TestCell; /// Сгенерировать символьную тестовую ячейку function tChr(ca: char := 'а'; cb: char := 'я'): TestCell; /// Сгенерировать логическую тестовую ячейку function tBoo: TestCell; {=========================================================} { Процедуры генерации ошибок } {=========================================================} /// Генерация ошибки неверного количества входных значений procedure ErrorInputCount(Count, n: integer); /// Генерация ошибки неверного количества выходных значений procedure ErrorOutputCount(Count, n: integer); /// Генерация ошибки неверного типа n-того входного значения procedure ErrorInputType(n: integer; ExpectedType, ActualType: string); /// Генерация ошибки неверного типа n-того выходного значения procedure ErrorOutputType(n: integer; ExpectedType, ActualType: string); {=========================================================} { Процедура генерации автоматических тестов } {=========================================================} function AutoTest: integer->(); /// Генерация автоматических тестов - повторно вызывается заполнение из основной программы. Не использовать если в основной программе есть Read!!! procedure GenerateAutoTests(n: integer); /// Генерация тестов по описанию тестовых данных procedure GenerateTests(n: integer; testcells: sequence of TestCell); /// Генерация тестов по набору значений тестовых данных procedure GenerateTests(params a: array of integer); /// Генерация тестов по набору значений тестовых данных procedure GenerateTests(params a: array of real); /// Генерация тестов по набору значений тестовых данных procedure GenerateTests(params a: array of string); /// Генерация тестов по набору значений тестовых данных procedure GenerateTests(params a: array of char); /// Генерация тестов по набору значений тестовых данных procedure GenerateTests(params a: array of boolean); /// Генерация тестов по набору кортежей тестовых данных procedure GenerateTests(params a: array of (T1,T2)); /// Генерация тестов по набору кортежей тестовых данных procedure GenerateTests(params a: array of (T1,T2,T3)); {=========================================================} { Фильтрация выходного списка } {=========================================================} /// Преобразование строк и символов, являющихся числами, в числа в OutputList procedure ConvertStringsToNumbersInOutputList; /// Если в OutputList массивы, вытянуть их в единый список procedure FlattenOutput; /// Очистить выходной список от пробелов, возникающих в методах расширения типа a.Print. Очень редко очищать не надо при решении задач на символы с пробелами procedure ClearOutputListFromSpaces; /// Отфильтровать в выходном списке только числа procedure FilterOnlyNumbers; /// Отфильтровать в выходном списке только числа и логические procedure FilterOnlyNumbersAndBools; var TaskResult: TaskStatus := NotUnderControl; // Записывается в БД /// Строка, содержащая вывод. Нужна для проверки решения как многострочной строки OutputString := new StringBuilder; /// Список выведенных элементов OutputList := new List; /// Список введенных элементов InputList := new List; /// Список типов элементов, выведенных в заготовке задания (cRe, cInt и т.д.) InitialOutputList := new List; /// Список типов элементов, введенных в заготовке задания InitialInputList := new List; /// Ссылка на основную процедуру проверки в модуле Task CheckTask: procedure(name: string); /// Погасить сообщения о неверном вводе-выводе если задача содержит только начальный ввод-вывод CancelMessagesIfInitial := True; /// Тихий режим - сообщения ColoredMessage гасятся. Нужен для обработки нескольких вызовов CheckOutput Silent := False; /// Целый тип для проверки ввода-вывода function cInt: System.Type; /// Вещественный тип для проверки ввода-вывода function cRe: System.Type; /// Строковый тип для проверки ввода-вывода function cStr: System.Type; /// Логический тип для проверки ввода-вывода function cBool: System.Type; /// Символьный тип для проверки ввода-вывода function cChar: System.Type; type /// Константа для обозначения пустого ввода или вывода EmptyType = (Empty); TestModeType = (tmNone, tmTest, tmGenTest, tmAutoTest); var TestCount := 0; GenerateTestData: integer -> () := nil; TestMode: TestModeType := tmNone; TestNumber: integer; /// Включить дополнительные сообщения о записи в удаленную базу данных procedure SetMessagesOn; /// Выключить дополнительные сообщения о записи в удаленную базу данных procedure SetMessageOff; /// Шифрование строки function EncryptString(src: string): string; implementation uses __RedirectIOMode; uses System.Management; uses System.Security.Cryptography; uses System.IO; uses System; uses System.Net.Http; uses System.Threading.Tasks; // Исключения - для вывода сообщения // TaskResult - для базы данных // Запоминать исключение в глобальной переменной TaskException - для доп. параметров для БД в формате // ПодтипИсключения(парам1,...,парамn) // Эту строку также можно писать в БД как доп параметры TaskResultInfo // Чем хороши исключения - их можно делать разными с абсолютно разными параметрами // Сервисная функция - чтобы можно было вводу, начальному вводу или начальному выводу в CheckData присвоить Empty вместо nil function operator implicit(Self: EmptyType): array of System.Type; extensionmethod := nil; const lightptname = 'lightpt.dat'; type LightPTException = class(Exception) function Info: string; virtual := 'NoInfo'; end; var CreateNewLineBeforeMessage := False; TaskResultInfo: string; // доп. информация о результате. Как правило пуста. Или содержит TaskException.Info. Или содержит для Solved и BadSolution информацию о модуле: Robot, Drawman, PT4 TaskException: LightPTException := new LightPTException; WriteInfoCallBack: procedure (LessonName,TaskName,TaskPlatform: string; result: TaskStatus; AdditionalInfo: string); LessonName: string := ''; TaskNamesMap := new Dictionary; // Дополнительные сообщения о записи в удаленную базу данных additionalMessages := False; {=========================================================} { Типы, связанные с сетью } {=========================================================} type UserTypeEnum = (None, Student, Teacher, Admin); ServerAccessProvider = class private client: HTTPClient; public ServerAddr: string; auto property ShortFIO: string; auto property FullFIO: string; auto property Password: string; auto property Group: string; auto property UserType: UserTypeEnum; constructor (ServerAddr: string); begin Self.ServerAddr := ServerAddr; System.Net.ServicePointManager.SecurityProtocol := System.Net.SecurityProtocolType(3072); client := new HttpClient(); client.Timeout := TimeSpan.FromSeconds(10); end; function SendPostRequest(FullFIO, Password, LessonName, TaskName, TaskPlatform, TaskResult, text, TaskResultInfo: string): Task; begin var values := Dict( ( 'shortFIO', '' ), ( 'FIO', FullFIO ), ( 'taskName', TaskName ), ( 'lessonName', LessonName ), ( 'taskPlatform', TaskPlatform ), ( 'taskResult', TaskResult ), ( 'taskResultInfo', TaskResultInfo ), ( 'content', text ), ( 'password', Password ) ); var content := new FormUrlEncodedContent(values); var response := client.PostAsync(ServerAddr + '/add.php', content); Result := response.Result.Content.ReadAsStringAsync(); end; end; {=========================================================} { Типы исключений при решении } {=========================================================} type InputCountException = class(LightPTException) // Ровно Count Count: integer; // Count - сколько введено n: integer; // n - сколько требуется ввести constructor(Count, n: integer); begin Self.Count := Count; Self.n := n; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'InputCount({Count},{n})'; end; InputCount2Exception = class(LightPTException) // Не меньше Count Count: integer; // Count - сколько введено i: integer; // i - какой номер требуется ввести (с нуля) constructor(Count, i: integer); begin Self.Count := Count; Self.i := i; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'InputCount2({Count},{i})'; end; InputCountTest2Exception = class(LightPTException) // Не меньше Count Count: integer; // Count - сколько введено i: integer; // i - какой номер требуется ввести (с нуля) constructor(Count, i: integer); begin Self.Count := Count; Self.i := i; end; function Info: string; override := $'InputCountTest2({Count},{i})'; end; InputTypeException = class(LightPTException) n: integer; // номер параметра ExpectedType, ActualType: string; constructor(n: integer; ExpectedType, ActualType: string); begin Self.n := n; Self.ExpectedType := ExpectedType; Self.ActualType := ActualType; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'InputType({n},{ExpectedType},{ActualType})'; end; InputTypeTestException = class(LightPTException) n: integer; // номер параметра ExpectedType, ActualType: string; constructor(n: integer; ExpectedType, ActualType: string); begin Self.n := n; Self.ExpectedType := ExpectedType; Self.ActualType := ActualType; end; function Info: string; override := $'InputTypeTest({n},{ExpectedType},{ActualType})'; end; OutputCountException = class(LightPTException) // Ровно Count Count: integer; // Count - сколько выведено n: integer; // n - сколько требуется вывести constructor(Count, n: integer); begin Self.Count := Count; Self.n := n; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'OutputCount({Count},{n})'; end; OutputCount2Exception = class(LightPTException) // Ровно Count Count: integer; // Count - сколько выведено i: integer; // n - какой номер требуется вывести constructor(Count, i: integer); begin Self.Count := Count; Self.i := i; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'Output2Count({Count},{i})'; end; OutputTypeException = class(LightPTException) n: integer; // номер параметра ExpectedType, ActualType: string; constructor(n: integer; ExpectedType, ActualType: string); begin Self.n := n; Self.ExpectedType := ExpectedType; Self.ActualType := ActualType; TaskResult := IOError; TaskException := Self; end; function Info: string; override := $'OutputType({n},{ExpectedType},{ActualType})'; end; NotInTestGenModeException = class(LightPTException) FuncName: string; constructor (FuncName: string) := Self.Funcname := Funcname; end; NotInTestModeException = class(LightPTException) FuncName: string; constructor (FuncName: string) := Self.Funcname := Funcname; end; InputTestCountMismatchException = class(LightPTException); InputTestTypesMismatchException = class(LightPTException); var CurPosInInputList := 0; CurPosInInputListInTestMode := 0; TaskName := ExtractFileName(System.Environment.GetCommandLineArgs[0]).Replace('.exe', ''); {=========================================================} { Функции для генерации тестов } {=========================================================} /// Сгенерировать по последовательности спецификаций в тестовых ячейках список данных для теста function GenValuesByTestCells(a: sequence of TestCell): List; begin Result := a.Select(tc -> tc.GenerateData).ToList; end; /// Сгенерировать целую тестовую ячейку function tInt(a: integer; b: integer): TestCell; begin Result := new TestCell(typeof(integer)); Result.a := a; Result.b := b; end; /// Сгенерировать вещественную тестовую ячейку function tRe(ra: real; rb: real; digits: integer): TestCell; begin Result := new TestCell(typeof(real)); Result.ra := ra; Result.rb := rb; Result.digits := digits; end; /// Сгенерировать символьную тестовую ячейку function tChr(ca: char; cb: char): TestCell; begin Result := new TestCell(typeof(char)); Result.ca := ca; Result.cb := cb; end; /// Сгенерировать логическую тестовую ячейку function tBoo: TestCell; begin Result := new TestCell(typeof(boolean)); end; function operator*(cell: TestCell; n: integer): array of TestCell; extensionmethod; begin Result := ArrFill(n,cell) end; function operator*(n: integer; cell: TestCell): array of TestCell; extensionmethod; begin Result := ArrFill(n,cell) end; function operator*(cell: System.Type; n: integer): array of System.Type; extensionmethod; begin Result := ArrFill(n,cell) end; function operator*(n: integer; cell: System.Type): array of System.Type; extensionmethod; begin Result := ArrFill(n,cell) end; {=========================================================} { Сервисные функции } {=========================================================} procedure ErrorInputCount(Count, n: integer) := raise new InputCountException(Count,n); procedure ErrorOutputCount(Count, n: integer) := raise new OutputCountException(Count,n); procedure ErrorInputType(n: integer; ExpectedType, ActualType: string) := raise new InputTypeException(n,ExpectedType,ActualType); procedure ErrorOutputType(n: integer; ExpectedType, ActualType: string) := raise new OutputTypeException(n,ExpectedType,ActualType); function AutoTest: integer->() := testnum -> (TestMode := tmAutoTest); procedure GenerateAutoTests(n: integer); begin TestCount := n; GenerateTestData := AutoTest; end; procedure GenerateTests(n: integer; testcells: sequence of TestCell); begin // Нужно сравнить типы в InputList и здесь. При несоотверствии бросить исключение // Это можно делать только здесь - где количество входных данных заранее известно // В задачах где вначале вводится n, а потом массив из n элементов, это не работает - количество данных меняется от теста нк тесту var testTypes := testcells.Select(ts -> ts.typ).ToArray; var inputTypes := InputList.Select(ob -> ob.GetType).ToArray; if (testTypes.Length <> inputTypes.Length) then raise new InputTestCountMismatchException; for var i:=0 to testTypes.Length - 1 do if (testTypes[i] <> inputTypes[i]) then raise new InputTestTypesMismatchException; TestCount := n; GenerateTestData := tnum -> begin InputList := GenValuesByTestCells(testcells); end; end; var _isPT, _isRobot, _isDrawman, _isLightPT: boolean; _IsPTcalculated := False; _IsLightPTcalculated := False; _IsRobotcalculated := False; _IsDrawmancalculated := False; /// Является ли задание заданием для задачника PT function IsPT: boolean; begin if _IsPTcalculated then Result := _isPT else Result := System.Type.GetType('PT4.PT4') <> nil; _isPT := Result; _IsPTcalculated := True; end; /// Является ли задание заданием для Робота function IsRobot: boolean; begin if _IsRobotcalculated then Result := _isRobot else Result := System.Type.GetType('RobotField.RobotField') <> nil; _isRobot := Result; _IsRobotcalculated := True; end; /// Является ли задание заданием для Чертежника function IsDrawman: boolean; begin if _IsDrawmancalculated then Result := _isDrawman else Result := System.Type.GetType('DrawManField.DrawManField') <> nil; _isDrawman := Result; _IsDrawmancalculated := True; end; /// Является ли задание заданием для легковесного задачника function IsLightPT: boolean; begin if _IsLightPTcalculated then Result := _IsLightPT else Result := not IsPT and not IsRobot and not IsDrawman; _IsLightPT := Result; _IsLightPTcalculated := True; end; /// надо ли пополнять список ввода в функциях, используемых для ввода function NeedAddDataToInputList: boolean := IsLightPT and ((TestMode = tmNone) or (TestMode = tmAutoTest)); /// Полный путь к папке auth-файла function FindAuthDat: string; begin var auth := 'auth.dat'; Result := ''; // В текущем каталоге if FileExists(auth) then Result := ExpandFileName(auth) // Если нет, в каталоге уровня выше else if FileExists(System.IO.Path.Combine('..',auth)) then begin Result := ExpandFileName(System.IO.Path.Combine('..',auth)) end // Если нет, в корневом каталоге сетевого диска - Это не работает на старых Win 10 куда не устанавливается NET 4/7/1 {else begin var fullname := ExpandFileName(auth); var drive := ExtractFileDrive(fullname); var di := new System.IO.DriveInfo(drive); if di.DriveType = System.IO.DriveType.Network then begin var af := System.IO.Path.Combine(di.RootDirectory.FullName,auth); if FileExists(af) then Result := af; end end;} end; {=================================================================} { Функции для шифрования-дешифрования при записи в auth.dat } {=================================================================} // На некоторых компьютерах давала сбой, поэтому просто возвращает константу function ProcessorId: string; begin {var mbs := new ManagementObjectSearcher('Select ProcessorId From Win32_processor'); var mbsList := mbs.Get(); Result := ''; foreach var mo: ManagementObject in mbsList do begin var pId := mo['ProcessorId']; if pId <> nil then Result := pId.ToString() else Result := 'AAAAAAAAAAAAAAAA'; break; end;} Result := 'AAAAAAAAAAAAAAAA'; end; function Encrypt(src: string): array of byte; // записать в файл begin var ae := Aes.Create(); var key := Encoding.UTF8.GetBytes(ProcessorId); var crypt := ae.CreateEncryptor(key, key); var ms := new MemoryStream(); var cs := new CryptoStream(ms, crypt, CryptoStreamMode.Write); var sw := new StreamWriter(cs); sw.Write(src); sw.Close; cs.Close; ms.Close; Result := ms.ToArray; end; function EncryptString(src: string): string; begin var bytes := Encrypt(src); Result := Convert.ToBase64String(bytes); end; function Decrypt(data: array of byte): string; begin if data = nil then begin Result := ''; exit end; var ae := Aes.Create(); var key := Encoding.UTF8.GetBytes(ProcessorId); var crypt := ae.CreateDecryptor(key, key); var ms := new MemoryStream(data); var cs := new CryptoStream(ms, crypt, CryptoStreamMode.Read); var sr := new StreamReader(cs); var text := sr.ReadToEnd; sr.Close; cs.Close; ms.Close; Result := text; end; {=========================================================} { Функции для проверки ввода-вывода } {=========================================================} function cInt := typeof(integer); function cRe := typeof(real); function cStr := typeof(string); function cBool := typeof(boolean); function cChar := typeof(char); procedure CheckData(InitialInput, InitialOutput, Input: array of System.Type); begin CheckInitialIOSeqs(InitialInput, InitialOutput); if Input = nil then CheckInputIsInitial else CheckInput(Input); end; procedure CheckInitialIO; begin if (OutputList.Count = InitialOutputList.Count) and (InputList.Count = InitialInputList.Count) then TaskResult := InitialTask else if (InputList.Count < InitialInputList.Count) or (InputList.Count = InitialInputList.Count) and (OutputList.Count < InitialOutputList.Count) then TaskResult := BadInitialTask; end; procedure CheckInitialIOIsEmpty := CheckInitialIO; procedure InitialOutput(a: array of System.Type); begin InitialOutputList.Clear; if a<>nil then InitialOutputList.AddRange(a); end; procedure InitialInput(a: array of System.Type); begin InitialInputList.Clear; if a<>nil then InitialInputList.AddRange(a); end; function CompareValues(o1, o2: Object): boolean; begin if (o1 is real) and (o2 is real) then begin var r1 := real(o1); var r2 := real(o2); Result := Abs(r1 - r2) < 0.0001; exit; end; Result := o1.Equals(o2); end; function CompareArrValues(a,lst: array of object): boolean; begin Result := True; if a.Length <> OutputList.Count then Result := False; for var i := 0 to a.Length - 1 do if not CompareValues(a[i], lst[i]) then begin Result := False; exit; end; end; function CompareValuesWithOutput(params a: array of object): boolean := CompareArrValues(a,OutputList.ToArray); {procedure CheckInitialOutputValues(params a: array of object); begin if CompareArrValues(a,OutputList.ToArray) then TaskResult := InitialTask; end;} // По сути отдельные функции - это неправильно. Необходим CheckInitialInputOutput procedure CheckInitialOutput(params a: array of System.Type); begin InitialOutput(a); CheckInitialIO; end; procedure CheckInitialInput(params a: array of System.Type); begin InitialInput(a); CheckInitialIO; end; procedure CheckInitialOutputSeq(a: sequence of System.Type) := CheckInitialOutput(a.ToArray); procedure CheckInitialInputSeq(a: sequence of System.Type) := CheckInitialInput(a.ToArray); procedure CheckInitialIOSeqs(input,output: sequence of System.Type); begin InitialInput(input?.ToArray); InitialOutput(output?.ToArray); CheckInitialIO; end; procedure CheckInputCount(n: integer); begin if InputList.Count <> n then raise new InputCountException(InputList.Count, n) end; procedure CheckInput2Count(i: integer); begin if InputList.Count <= i then raise new InputCount2Exception(InputList.Count, i + 1) end; procedure CheckInputTest2Count(i: integer); begin if InputList.Count <= i then raise new InputCountTest2Exception(InputList.Count, i + 1) end; procedure CheckOutput2Count(i: integer); begin if OutputList.Count <= i then raise new OutputCount2Exception(OutputList.Count, i + 1) end; function IsInt(i: integer) := InputList[i] is integer; function IsRe(i: integer) := InputList[i] is real; function IsStr(i: integer) := InputList[i] is string; function IsBoo(i: integer) := InputList[i] is boolean; function IsChr(i: integer) := InputList[i] is char; function OutIsInt(i: integer) := OutputList[i] is integer; function OutIsRe(i: integer) := OutputList[i] is real; function OutIsStr(i: integer) := OutputList[i] is string; function OutIsBoo(i: integer) := OutputList[i] is boolean; function OutIsChr(i: integer) := OutputList[i] is char; function Int(i: integer): integer; begin CheckInput2Count(i); if not IsInt(i) then raise new InputTypeException(i + 1, 'integer', TypeName(InputList[i])); Result := integer(InputList[i]); end; function Re(i: integer): real; begin CheckInput2Count(i); if not IsRe(i) then raise new InputTypeException(i + 1, 'real', TypeName(InputList[i])); Result := real(InputList[i]); end; function Str(i: integer): string; begin CheckInput2Count(i); if not IsStr(i) then raise new InputTypeException(i + 1, 'string', TypeName(InputList[i])); Result := string(InputList[i]); end; function Boo(i: integer): boolean; begin CheckInput2Count(i); if not IsBoo(i) then raise new InputTypeException(i + 1, 'boolean', TypeName(InputList[i])); Result := boolean(InputList[i]); end; function Chr(i: integer): char; begin CheckInput2Count(i); if not IsChr(i) then raise new InputTypeException(i + 1, 'char', TypeName(InputList[i])); Result := char(InputList[i]); end; function IntTest(i: integer): integer; begin CheckInputTest2Count(i); if not IsInt(i) then raise new InputTypeTestException(i + 1, 'integer', TypeName(InputList[i])); Result := integer(InputList[i]); end; function ReTest(i: integer): real; begin CheckInputTest2Count(i); if not IsRe(i) then raise new InputTypeTestException(i + 1, 'real', TypeName(InputList[i])); Result := real(InputList[i]); end; function StrTest(i: integer): string; begin CheckInputTest2Count(i); if not IsStr(i) then raise new InputTypeTestException(i + 1, 'string', TypeName(InputList[i])); Result := string(InputList[i]); end; function BooTest(i: integer): boolean; begin CheckInputTest2Count(i); if not IsBoo(i) then raise new InputTypeTestException(i + 1, 'boolean', TypeName(InputList[i])); Result := boolean(InputList[i]); end; function ChrTest(i: integer): char; begin CheckInputTest2Count(i); if not IsChr(i) then raise new InputTypeTestException(i + 1, 'char', TypeName(InputList[i])); Result := char(InputList[i]); end; function OutInt(i: integer): integer; begin CheckOutput2Count(i); if not OutIsInt(i) then raise new OutputTypeException(i + 1, 'integer', TypeName(OutputList[i])); Result := integer(OutputList[i]); end; function OutRe(i: integer): real; begin CheckOutput2Count(i); if not OutIsRe(i) then raise new OutputTypeException(i + 1, 'real', TypeName(OutputList[i])); Result := real(OutputList[i]); end; function OutBoo(i: integer): boolean; begin CheckOutput2Count(i); if not OutIsBoo(i) then raise new OutputTypeException(i + 1, 'boolean', TypeName(OutputList[i])); Result := boolean(OutputList[i]); end; function OutChr(i: integer): char; begin CheckOutput2Count(i); if not OutIsChr(i) then raise new OutputTypeException(i + 1, 'char', TypeName(OutputList[i])); Result := char(OutputList[i]); end; function OutStr(i: integer): string; begin CheckOutput2Count(i); if not OutIsStr(i) then raise new OutputTypeException(i + 1, 'string', TypeName(OutputList[i])); Result := string(OutputList[i]); end; function Int: integer; begin Result := Int(CurPosInInputList); CurPosInInputList += 1; end; function Re: real; begin Result := Re(CurPosInInputList); CurPosInInputList += 1; end; function Str: string; begin Result := Str(CurPosInInputList); CurPosInInputList += 1; end; function Boo: boolean; begin Result := Boo(CurPosInInputList); CurPosInInputList += 1; end; function Chr: char; begin Result := Chr(CurPosInInputList); CurPosInInputList += 1; end; function IntTest: integer; begin Result := IntTest(CurPosInInputListInTestMode); CurPosInInputListInTestMode += 1; end; function ReTest: real; begin Result := ReTest(CurPosInInputListInTestMode); CurPosInInputListInTestMode += 1; end; function StrTest: string; begin Result := StrTest(CurPosInInputListInTestMode); CurPosInInputListInTestMode += 1; end; function BooTest: boolean; begin Result := BooTest(CurPosInInputListInTestMode); CurPosInInputListInTestMode += 1; end; function ChrTest: char; begin Result := ChrTest(CurPosInInputListInTestMode); CurPosInInputListInTestMode += 1; end; function Int2: (integer, integer) := (Int, Int); function Re2: (real, real) := (Re, Re); function IntArr(n: integer): array of integer := (1..n).Select(x -> Int).ToArray; function ReArr(n: integer): array of real := (1..n).Select(x -> Re).ToArray; function BooArr(n: integer): array of boolean := (1..n).Select(x -> Boo).ToArray; function ChrArr(n: integer): array of char := (1..n).Select(x -> Chr).ToArray; function StrArr(n: integer): array of string := (1..n).Select(x -> Str).ToArray; // функции, возвращающие входные и выходные списки, а также их срезы, приведенные к нужному типу function InputListAsIntegers: array of integer := InputList.Select((x,i) -> Int(i)).ToArray; function InputListAsReals: array of real := InputList.Select((x,i) -> Re(i)).ToArray; function InputListAsBooleans: array of boolean := InputList.Select((x,i) -> Boo(i)).ToArray; function InputListAsChars: array of char := InputList.Select((x,i) -> Chr(i)).ToArray; function InputListAsStrings: array of string := InputList.Select((x,i) -> Str(i)).ToArray; function OutputListAsIntegers: array of integer := OutputList.Select((x,i) -> OutInt(i)).ToArray; function OutputListAsReals: array of real := OutputList.Select((x,i) -> OutRe(i)).ToArray; function OutputListAsBooleans: array of boolean := OutputList.Select((x,i) -> OutBoo(i)).ToArray; function OutputListAsChars: array of char := OutputList.Select((x,i) -> OutChr(i)).ToArray; function OutputListAsStrings: array of string := OutputList.Select((x,i) -> OutStr(i)).ToArray; function InSliceIntArr(a,b: integer): array of integer := (a..b).Select(i->Int(i)).ToArray; function InSliceReArr(a,b: integer): array of real := (a..b).Select(i->Re(i)).ToArray; function InSliceBooArr(a,b: integer): array of boolean := (a..b).Select(i->Boo(i)).ToArray; function InSliceChrArr(a,b: integer): array of char := (a..b).Select(i->Chr(i)).ToArray; function InSliceStrArr(a,b: integer): array of string := (a..b).Select(i->Str(i)).ToArray; function OutSliceIntArr(a,b: integer): array of integer := (a..b).Select(i->OutInt(i)).ToArray; function OutSliceReArr(a,b: integer): array of real := (a..b).Select(i->OutRe(i)).ToArray; function OutSliceBooArr(a,b: integer): array of boolean := (a..b).Select(i->OutBoo(i)).ToArray; function OutSliceChrArr(a,b: integer): array of char := (a..b).Select(i->OutChr(i)).ToArray; function OutSliceStrArr(a,b: integer): array of string := (a..b).Select(i->OutStr(i)).ToArray; function ConvertOne(ob: Object): Object; begin Result := ob; if ob is string then begin var s := string(ob); var ival: integer; var rval: real; if s.TryToInteger(ival) then Result := ival else if s.TryToReal(rval) then Result := rval end else if ob is char then begin var s := ''+char(ob); var ival: integer; if s.TryToInteger(ival) then Result := ival end end; procedure ConvertStringsToNumbersInOutputList; begin for var i:=0 to OutputList.Count - 1 do OutputList[i] := ConvertOne(OutputList[i]); end; function ToObjArray(a: sequence of integer): array of object := a.Select(x -> object(x)).ToArray; function ToObjArray(a: sequence of real): array of object := a.Select(x -> object(x)).ToArray; function ToObjArray(a: sequence of string): array of object := a.Select(x -> object(x)).ToArray; function ToObjArray(a: sequence of char): array of object := a.Select(x -> object(x)).ToArray; function ToObjArray(a: sequence of boolean): array of object := a.Select(x -> object(x)).ToArray; function ToObjArray(a: sequence of word): array of object := a.Select(x -> object(x)).ToArray; {============================================} { Методы расширения для List } {============================================} /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of integer); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of real); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of string); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of char); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of boolean); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of word); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(ToObjArray(data)); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: sequence of object); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.AddRange(data.ToArray); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: integer); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.Add(data); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: real); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.Add(data); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: string); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.Add(data); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: char); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.Add(data); end; /// Заполняет InputList в GenerateTestData. Вызывать только в GenerateTestData! procedure AddTestData(Self: List; data: boolean); extensionmethod; begin if TestMode <> tmGenTest then raise new NotInTestGenModeException('AddTestData'); Self.Add(data); end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataInt(Self: List): integer; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataInt'); Result := IntTest; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataReal(Self: List): real; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataReal'); Result := ReTest; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataString(Self: List): string; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataString'); Result := StrTest; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataChar(Self: List): char; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataChar'); Result := ChrTest; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataBoolean(Self: List): boolean; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataBoolean'); Result := BooTest; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataIntArr(Self: List; n: integer): array of integer; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataIntArr'); Result := (1..n).Select(x->IntTest).ToArray; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataReArr(Self: List; n: integer): array of real; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataReArr'); Result := (1..n).Select(x->ReTest).ToArray; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataStrArr(Self: List; n: integer): array of string; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataStrArr'); Result := (1..n).Select(x->StrTest).ToArray; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataChrArr(Self: List; n: integer): array of char; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataChrArr'); Result := (1..n).Select(x->ChrTest).ToArray; end; /// Только для InputList и только во время тестирования!!! TestMode = tmTest! Это внутренний метод - разработчику тестов не вызывать!!! function ReadTestDataBooArr(Self: List; n: integer): array of boolean; extensionmethod; begin if TestMode <> tmTest then raise new NotInTestModeException('ReadTestDataBooArr'); Result := (1..n).Select(x->BooTest).ToArray; end; function SliceAsInt(Self: List; a,b: integer): array of integer; extensionmethod := Self[a:b].Select(x->integer(x)).ToArray; function SliceAsReal(Self: List; a,b: integer): array of real; extensionmethod := Self[a:b].Select(x->real(x)).ToArray; function SliceAsString(Self: List; a,b: integer): array of string; extensionmethod := Self[a:b].Select(x->string(x)).ToArray; function SliceAsChar(Self: List; a,b: integer): array of char; extensionmethod := Self[a:b].Select(x->char(x)).ToArray; function SliceAsBoolean(Self: List; a,b: integer): array of boolean; extensionmethod := Self[a:b].Select(x->boolean(x)).ToArray; {=========================================================} { Сервисные функции - продолжение } {=========================================================} procedure GenerateTests(params a: array of integer); begin if InputList.Count <> 1 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(integer) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin InputList.AddTestData(a[tnum-1]); end; end; procedure GenerateTests(params a: array of real); begin if InputList.Count <> 1 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(real) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin InputList.AddTestData(a[tnum-1]); end; end; procedure GenerateTests(params a: array of string); begin if InputList.Count <> 1 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(string) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin InputList.AddTestData(a[tnum-1]); end; end; procedure GenerateTests(params a: array of char); begin if InputList.Count <> 1 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(char) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin InputList.AddTestData(a[tnum-1]); end; end; procedure GenerateTests(params a: array of boolean); begin if InputList.Count <> 1 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(boolean) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin InputList.AddTestData(a[tnum-1]); end; end; procedure GenerateTests(params a: array of (T1,T2)); begin if InputList.Count <> 2 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(T1) then raise new InputTestTypesMismatchException; if InputList[1].GetType <> typeof(T2) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin var tt := a[tnum-1]; InputList.AddTestData(|object(tt[0]),object(tt[1])|); end; end; procedure GenerateTests(params a: array of (T1,T2,T3)); begin if InputList.Count <> 2 then raise new InputTestCountMismatchException; if InputList[0].GetType <> typeof(T1) then raise new InputTestTypesMismatchException; if InputList[1].GetType <> typeof(T2) then raise new InputTestTypesMismatchException; if InputList[2].GetType <> typeof(T3) then raise new InputTestTypesMismatchException; TestCount := a.Length; GenerateTestData := tnum -> begin var tt := a[tnum-1]; InputList.AddTestData(|object(tt[0]),object(tt[1]),object(tt[2])|); end; end; {=========================================================================} { Переопределенные функции PABCSystem с заполнением ввода и вывода } {=========================================================================} /// Возвращает случайное целое в диапазоне от a до b function Random(a, b: integer): integer; begin // Есть три состояния: // 1. Вызов в основной программе (первый запуск) - TestMode = tmNone // 2. Вызов в основной программе (последующие запуски) - TestMode = tmTest // 3. Вызов в функции GenerateTestData - TestMode = tmGenTest - тогда срабатывает обычная ArrRandomInteger // как и в случае 1. if TestMode = tmTest then Result := InputList.ReadTestDataInt // считать следующее данное из заполненного в GenTestMode InputList else Result := PABCSystem.Random(a, b); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайное целое в диапазоне от 0 до n-1 function Random(n: integer): integer; begin if TestMode = tmTest then Result := InputList.ReadTestDataInt else Result := PABCSystem.Random(n); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайное вещественное в диапазоне [0..1) function Random: real; begin if TestMode = tmTest then Result := InputList.ReadTestDataReal else Result := PABCSystem.Random; if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайное вещественное в диапазоне [a,b) function Random(a, b: real): real; begin if TestMode = tmTest then Result := InputList.ReadTestDataReal else Result := PABCSystem.Random(a, b); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайный символ в диапазоне от a до b function Random(a, b: char): char; begin if TestMode = tmTest then Result := InputList.ReadTestDataChar else Result := PABCSystem.Random(a, b); if NeedAddDataToInputList then InputList.Add(Result); end; function RandomReal(a, b: real; digits: integer): real; begin if TestMode = tmTest then Result := InputList.ReadTestDataReal else Result := PABCSystem.RandomReal(a, b, digits); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайное целое в диапазоне function Random(diap: IntRange): integer; begin if TestMode = tmTest then Result := InputList.ReadTestDataInt else Result := PABCSystem.Random(diap); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайное вещественное в диапазоне function Random(diap: RealRange): real; begin if TestMode = tmTest then Result := InputList.ReadTestDataReal else Result := PABCSystem.Random(diap); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает случайный символ в диапазоне function Random(diap: CharRange): char; begin if TestMode = tmTest then Result := InputList.ReadTestDataChar else Result := PABCSystem.Random(diap); if NeedAddDataToInputList then InputList.Add(Result); end; /// Возвращает кортеж из двух случайных целых в диапазоне от a до b function Random2(a, b: integer): (integer, integer); begin Result := (Random(a, b), Random(a, b)); end; /// Возвращает кортеж из двух случайных вещественных в диапазоне от a до b function Random2(a, b: real): (real, real); begin Result := (Random(a, b), Random(a, b)); end; /// Возвращает кортеж из двух случайных символов в диапазоне от a до b function Random2(a, b: char): (char, char); begin Result := (Random(a, b), Random(a, b)); end; /// Возвращает кортеж из двух случайных целых в диапазоне function Random2(diap: IntRange): (integer, integer); begin Result := (Random(diap), Random(diap)); end; /// Возвращает кортеж из двух случайных символов в диапазоне function Random2(diap: CharRange): (char, char); begin Result := (Random(diap), Random(diap)); end; /// Возвращает кортеж из двух случайных вещественных в диапазоне function Random2(diap: RealRange): (real, real); begin Result := (Random(diap), Random(diap)); end; /// Возвращает кортеж из трех случайных целых в диапазоне от a до b function Random3(a, b: integer): (integer, integer, integer); begin Result := (Random(a, b), Random(a, b), Random(a, b)); end; /// Возвращает кортеж из трех случайных вещественных в диапазоне от a до b function Random3(a, b: real): (real, real, real); begin Result := (Random(a, b), Random(a, b), Random(a, b)); end; /// Возвращает кортеж из трех случайных символов в диапазоне от a до b function Random3(a, b: char): (char, char, char); begin Result := (Random(a, b), Random(a, b), Random(a, b)); end; /// Возвращает кортеж из трех случайных целых в диапазоне function Random3(diap: IntRange): (integer, integer, integer); begin Result := (Random(diap), Random(diap), Random(diap)); end; /// Возвращает кортеж из трех случайных вещественных в диапазоне function Random3(diap: RealRange): (real, real, real); begin Result := (Random(diap), Random(diap), Random(diap)); end; /// Возвращает кортеж из трех случайных символов в диапазоне function Random3(diap: CharRange): (char, char, char); begin Result := (Random(diap), Random(diap), Random(diap)); end; /// Возвращает массив размера n, заполненный случайными целыми значениями в диапазоне от a до b function ArrRandomInteger(n: integer; a: integer; b: integer): array of integer; begin // Есть три состояния: // 1. Вызов в основной программе (первый запуск) - TestMode = tmNone // 2. Вызов в основной программе (последующие запуски) - TestMode = tmTest // 3. Вызов в функции GenerateTestData - TestMode = tmGenTest - тогда срабатывает обычная ArrRandomInteger // как и в случае 1. if TestMode = tmTest then Result := InputList.ReadTestDataIntArr(n) else Result := PABCSystem.ArrRandomInteger(n, a, b); if NeedAddDataToInputList then // IsLightPT and ((TestMode = tmNone) or (TestMode = tmAutoTest)) for var i:=0 to n-1 do InputList.Add(Result[i]); end; /// Возвращает массив размера n, заполненный случайными целыми значениями в диапазоне от 0 до 100 function ArrRandomInteger(n: integer): array of integer := ArrRandomInteger(n,0,100); /// Возвращает массив размера n, заполненный случайными вещественными значениями в диапазоне от a до b function ArrRandomReal(n: integer; a: real; b: real; digits: integer): array of real; begin if TestMode = tmTest then Result := InputList.ReadTestDataReArr(n) else Result := PABCSystem.ArrRandomReal(n, a, b, digits); if NeedAddDataToInputList then for var i:=0 to n-1 do InputList.Add(Result[i]); end; /// Возвращает массив размера n, заполненный случайными вещественными значениями в диапазоне от 0 до 10 function ArrRandomReal(n: integer; digits: integer): array of real := ArrRandomReal(n,0,10,digits); /// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями function MatrRandomInteger(m: integer; n: integer; a: integer; b: integer): array [,] of integer; begin if TestMode = tmTest then Result := Matr(m,n,InputList.ReadTestDataIntArr(m*n)) else Result := PABCSystem.MatrRandomInteger(m,n,a,b); if NeedAddDataToInputList then foreach var x in Result.ElementsByRow do InputList.Add(x); end; /// Возвращает двумерный массив размера m x n, заполненный случайными целыми значениями function MatrRandomInteger(m: integer; n: integer): array [,] of integer := MatrRandomInteger(m,n,0,100); /// Возвращает двумерный массив размера m x n, заполненный случайными вещественными значениями function MatrRandomReal(m: integer; n: integer; a: real; b: real; digits: integer): array [,] of real; begin if TestMode = tmTest then Result := Matr(m,n,InputList.ReadTestDataReArr(m*n)) else Result := PABCSystem.MatrRandomReal(m,n,a,b,digits); if NeedAddDataToInputList then foreach var x in Result.ElementsByRow do InputList.Add(x); end; function MatrRandomReal(m: integer; n: integer): array [,] of real := MatrRandomReal(m,n,0,10); procedure ReadRemainderAction; begin if not IsPT then begin OutputList.RemoveAt(OutputList.Count - 1); OutputList.RemoveAt(OutputList.Count - 1); CreateNewLineBeforeMessage := False; end; end; function ReadInteger(prompt: string): integer; begin Result := PABCSystem.ReadInteger(prompt); ReadRemainderAction; end; function ReadlnInteger(prompt: string): integer; begin Result := PABCSystem.ReadlnInteger(prompt); ReadRemainderAction; end; function ReadInteger2(prompt: string): (integer, integer); begin Result := PABCSystem.ReadInteger2(prompt); ReadRemainderAction; end; function ReadlnInteger2(prompt: string): (integer,integer); begin Result := PABCSystem.ReadlnInteger2(prompt); ReadRemainderAction; end; function ReadInteger3(prompt: string): (integer,integer,integer); begin Result := PABCSystem.ReadInteger3(prompt); ReadRemainderAction; end; function ReadlnInteger3(prompt: string): (integer,integer,integer); begin Result := PABCSystem.ReadlnInteger3(prompt); ReadRemainderAction; end; function ReadInteger4(prompt: string): (integer, integer,integer,integer); begin Result := PABCSystem.ReadInteger4(prompt); ReadRemainderAction; end; function ReadlnInteger4(prompt: string): (integer,integer,integer,integer); begin Result := PABCSystem.ReadlnInteger4(prompt); ReadRemainderAction; end; function ReadReal(prompt: string): real; begin Result := PABCSystem.ReadReal(prompt); ReadRemainderAction; end; function ReadlnReal(prompt: string): real; begin Result := PABCSystem.ReadlnReal(prompt); ReadRemainderAction; end; function ReadReal2(prompt: string): (real, real); begin Result := PABCSystem.ReadReal2(prompt); ReadRemainderAction; end; function ReadlnReal2(prompt: string): (real, real); begin Result := PABCSystem.ReadlnReal2(prompt); ReadRemainderAction; end; function ReadReal3(prompt: string): (real, real, real); begin Result := PABCSystem.ReadReal3(prompt); ReadRemainderAction; end; function ReadlnReal3(prompt: string): (real, real, real); begin Result := PABCSystem.ReadlnReal3(prompt); ReadRemainderAction; end; function ReadReal4(prompt: string): (real, real, real, real); begin Result := PABCSystem.ReadReal4(prompt); ReadRemainderAction; end; function ReadlnReal4(prompt: string): (real, real, real, real); begin Result := PABCSystem.ReadlnReal4(prompt); ReadRemainderAction; end; function ReadChar(prompt: string): char; begin Result := PABCSystem.ReadChar(prompt); ReadRemainderAction; end; function ReadlnChar(prompt: string): char; begin Result := PABCSystem.ReadlnChar(prompt); ReadRemainderAction; end; function ReadString(prompt: string): string; begin Result := PABCSystem.ReadString(prompt); ReadRemainderAction; end; function ReadlnString(prompt: string) := ReadString(prompt); ///- procedure Print(a,b,...); /// Выводит значения a,b,... на экран, после каждого значения выводит пробел procedure Print(params args: array of object); begin foreach var ob in args do begin PABCSystem.Print(ob); if not IsPT then OutputList.RemoveAt(OutputList.Count - 1) end; CreateNewLineBeforeMessage := True; end; ///- procedure Println(a,b,...); /// Выводит значения a,b,... на экран, после каждого значения выводит пробел и переходит на новую строку procedure Println(params args: array of object); begin Print(args); Writeln; if IsPT then exit; CreateNewLineBeforeMessage := False; end; /// Выводит значение экран и выводит пробел procedure Print(ob: object); begin PABCSystem.Print(ob); if IsPT then exit; OutputList.RemoveAt(OutputList.Count - 1); CreateNewLineBeforeMessage := True; end; /// Выводит значение экран и выводит пробел procedure Print(s: string); begin PABCSystem.Print(s); if IsPT then exit; OutputList.RemoveAt(OutputList.Count - 1); CreateNewLineBeforeMessage := True; end; /// Выводит значение экран и выводит пробел procedure Print(c: char); begin PABCSystem.Print(object(c)); if IsPT then exit; OutputList.RemoveAt(OutputList.Count - 1); CreateNewLineBeforeMessage := True; end; // конец переопределенных функций с заполнением ввода-вывода procedure CompareTypeWithOutput(params a: array of System.Type); begin TaskResult := Solved; var mn := Min(a.Length, OutputList.Count); for var i := 0 to mn - 1 do if a[i] <> OutputList[i].GetType then raise new OutputTypeException(i + 1, TypeToTypeName(a[i]), TypeName(OutputList[i])); if a.Length <> OutputList.Count then raise new OutputCountException(OutputList.Count, a.Length); end; /// Не меняет TaskResult если типы правильные procedure CheckInputTypes(a: array of System.Type); begin // Несоответствие количества вводимых параметров if a.Length <> InputList.Count then raise new InputCountException(InputList.Count, a.Length); for var i := 0 to a.Length - 1 do if a[i] <> InputList[i].GetType then raise new InputTypeException(i + 1, TypeToTypeName(a[i]), TypeName(InputList[i])); end; /// Синоним CheckInputTypes procedure CheckInput(a: array of System.Type) := CheckInputTypes(a); procedure CheckInputIsEmpty := CheckInputTypes(new System.Type[0]); procedure CheckInputIsInitial; begin CheckInput(InitialInputList.ToArray); end; procedure CheckInput(seq: sequence of System.Type) := CheckInputTypes(seq.ToArray); procedure CheckOutputAfterInitialSeq(seq: sequence of integer) := CheckOutputAfterInitial(ToObjArray(seq)); procedure CheckOutputAfterInitialSeq(seq: sequence of real) := CheckOutputAfterInitial(ToObjArray(seq)); procedure CheckOutputAfterInitialSeq(seq: sequence of string) := CheckOutputAfterInitial(ToObjArray(seq)); procedure CheckOutputAfterInitialSeq(seq: sequence of boolean) := CheckOutputAfterInitial(ToObjArray(seq)); procedure CheckOutputAfterInitialSeq(seq: sequence of char) := CheckOutputAfterInitial(ToObjArray(seq)); procedure CheckOutputAfterInitialSeq(seq: sequence of object) := CheckOutputAfterInitial(seq.ToArray); procedure CheckOutputAfterInitialSeq(seq: ObjectList) := CheckOutputAfterInitial(seq.lst.ToArray); procedure CheckOutputAfterInitialSeqSilent(seq: sequence of integer); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: sequence of real); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: sequence of string); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: sequence of boolean); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: sequence of char); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: sequence of object); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; procedure CheckOutputAfterInitialSeqSilent(seq: ObjectList); begin Silent := True; CheckOutputAfterInitialSeq(seq); Silent := False; end; var OutputListIsClearedFromSpaces := False; procedure ClearOutputListFromSpaces; begin if OutputListIsClearedFromSpaces then exit; OutputList := OutputList.Where(s -> (not (s is string)) or ((s as string) <> ' ')).ToList; OutputList := OutputList.Where(s -> (not (s is char)) or ((char(s)) <> ' ')).ToList; OutputListIsClearedFromSpaces := True; end; procedure FilterOnlyNumbers; begin OutputList := OutputList.Where(x -> (x is integer) or (x is real) or (x is int64)).ToList; end; procedure FilterOnlyNumbersAndBools; begin OutputList := OutputList.Where(x -> (x is integer) or (x is real) or (x is int64) or (x is boolean)).ToList; end; function MsgColorCode(color: MessageColorT): char; begin Result := #65530; // Black case color of MsgColorGreen: Result := #65535; MsgColorRed: Result := #65534; MsgColorOrange: Result := #65533; MsgColorMagenta: Result := #65532; MsgColorGray: Result := #65531; end; end; procedure ColoredMessage(msg: string; color: MessageColorT); begin if Silent then exit; if CreateNewLineBeforeMessage then Console.WriteLine; Console.WriteLine(MsgColorCode(color) + msg); CreateNewLineBeforeMessage := False; end; procedure ColoredMessage(msg: string); begin if Silent then exit; if CreateNewLineBeforeMessage then Console.WriteLine; Console.WriteLine(MsgColorCode(MsgColorRed) + msg); CreateNewLineBeforeMessage := False; end; function FlattenElement(x: object): List; begin var res := new List; if x is string then res.Add(x) else if x is IEnumerable (var xen) then foreach var ob in xen do res.AddRange(FlattenElement(ob)) else if x is System.Collections.IEnumerable (var xx) then begin var en := xx.GetEnumerator; while en.MoveNext do res.Add(en.Current) end else res.Add(x); Result := res; end; procedure OutputTestResult(i0: integer; arr: array of object); begin ColoredMessage($'Основной запуск верный',MsgColorGray); ColoredMessage($'Ошибочное решение на тесте:',MsgColorOrange); ColoredMessage($'Тестовые данные : {InputList.JoinToString}',MsgColorGray); ColoredMessage($'Полученный результат : {OutputList.JoinToString}',MsgColorGray); if i0 = 0 then ColoredMessage($'Правильный результат : {arr.JoinToString}',MsgColorGray) else ColoredMessage($'Правильный результат : {(OutputList[:i0]+arr).JoinToString}',MsgColorGray) end; procedure CheckOutputHelper(i0: integer; params arr: array of object); begin if (TaskResult = InitialTask) and CancelMessagesIfInitial or (TaskResult = BadInitialTask) then exit; // SSM 28.06.24 - вытягиваем в линию выходные данные arr := arr.SelectMany(x -> FlattenElement(x)).ToArray; // Если мы попали сюда, то OutputList.Count >= InitialOutputList.Count var mn := Min(arr.Length, OutputList.Count - i0); for var i := i0 to i0 + mn - 1 do begin // Если типы не совпадают if (arr[i-i0].GetType.Name <> 'RuntimeType') and (arr[i-i0].GetType <> OutputList[i].GetType) or (arr[i-i0].GetType.Name = 'RuntimeType') and (arr[i-i0] <> OutputList[i].GetType) then begin if TestNumber > 0 then OutputTestResult(i0,arr) else begin if i > InitialOutputList.Count then ColoredMessage('Часть выведенных данных правильная',MsgColorGray); end; raise new OutputTypeException(i + 1, TypeToTypeName(arr[i-i0].GetType), TypeName(OutputList[i])); end; // Если значения не совпадают (если задан маркер типа, то проверка значений пропускается) if (arr[i-i0].GetType.Name <> 'RuntimeType') and not CompareValues(arr[i-i0], OutputList[i]) then begin if i >= InitialOutputList.Count then // ? Если первое данное неправильное - всё равно попадаем сюда!!! begin if TestNumber > 0 then OutputTestResult(i0,arr) else begin if i > InitialOutputList.Count then ColoredMessage('Часть выведенных данных правильная',MsgColorGray); if (i0 = 0) and (arr.Length = 1) then //ColoredMessage($'Ожидалось значение {arr[i-i0]}, а выведено {OutputList[i]}',MsgColorGray) else ColoredMessage($'Элемент {i + 1}: ожидалось значение {arr[i-i0]}, а выведено {OutputList[i]}',MsgColorGray); end; end; TaskResult := BadSolution; exit; end; end; if arr.Length <> OutputList.Count - i0 then begin if TestNumber > 0 then OutputTestResult(i0,arr) else if OutputList.Count > 0 then begin if arr.Length > OutputList.Count - i0 then // выведено меньше чем надо ColoredMessage('Все выведенные данные правильны',MsgColorGray) else if arr.Length < OutputList.Count - i0 then // выведено больше чем надо ColoredMessage('Все необходимые выведенные данные правильны',MsgColorGray); end; raise new OutputCountException(OutputList.Count, arr.Length + i0); end; TaskResult := Solved; end; // Поправим сообщения об ошибке в соответствии с TestNumber procedure CheckOutput(params arr: array of object); begin CheckOutputHelper(0,arr); end; procedure CheckOutput(a: ObjectList) := CheckOutputSeq(a); procedure CheckOutputSilent(params arr: array of object); begin Silent := True; CheckOutput(arr); Silent := False; end; procedure CheckOutputSilent(a: ObjectList) := CheckOutputSeqSilent(a); procedure CheckOutputAfterInitial(params arr: array of object); begin CheckOutputHelper(InitialOutputList.Count,arr); end; procedure CheckOutputAfterInitial(a: ObjectList) := CheckOutputAfterInitialSeq(a); procedure CheckOutputAfterInitialSilent(params arr: array of object); begin Silent := True; CheckOutputAfterInitial(arr); Silent := False; end; procedure CheckOutputSeq(a: sequence of integer) := CheckOutput(ToObjArray(a)); procedure CheckOutputSeq(a: sequence of real) := CheckOutput(ToObjArray(a)); procedure CheckOutputSeq(a: sequence of string) := CheckOutput(ToObjArray(a)); procedure CheckOutputSeq(a: sequence of char) := CheckOutput(ToObjArray(a)); procedure CheckOutputSeq(a: sequence of boolean) := CheckOutput(ToObjArray(a)); procedure CheckOutputSeq(a: sequence of object) := CheckOutput(a.ToArray); procedure CheckOutputSeq(a: ObjectList) := CheckOutput(a.lst.ToArray); procedure CheckOutputSeq(a: sequence of word) := CheckOutputSeq(ToObjArray(a)); procedure CheckOutputSeqSilent(a: sequence of integer) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of real) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of string) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of char) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of boolean) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of object) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: ObjectList) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputSeqSilent(a: sequence of word) := begin Silent := True; CheckOutputSeq(a); Silent := False end; procedure CheckOutputNew(params arr: array of object) := CheckOutput(arr); procedure CheckOutputSeqNew(a: sequence of integer) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of real) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of string) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of char) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of boolean) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of object) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: sequence of word) := CheckOutputSeq(a); procedure CheckOutputSeqNew(a: ObjectList) := CheckOutputSeq(a); procedure CheckOutputString(str: string); function Char2Str(c: char): string; begin if (c = #10) or (c = #13) then Result := '''ПереходНаНовуюСтроку''' else Result := '''' + c + ''''; end; begin if (TaskResult = InitialTask) or (TaskResult = BadInitialTask) then exit; var ostr := OutputString.ToString; var mn := Min(str.Length, ostr.Length); var ind := -1; for var i := 1 to mn do begin if str[i] <> ostr[i] then begin ind := i; ColoredMessage($'Элемент {i}: ожидался символ {Char2Str(str[i])}, а выведен символ {Char2Str(ostr[i])}',MsgColorGray); TaskResult := BadSolution; exit; end; end; if ind = -1 then ind := mn; if str.Length <> ostr.Length then begin if (ind = mn) and (ind<>0) then ColoredMessage('Все выведенные данные правильны',MsgColorGray) else if ind > 0 then ColoredMessage('Часть выведенных данных правильная',MsgColorGray); raise new OutputCountException(ostr.Length, str.Length); end; TaskResult := Solved; end; type IntAr = array of integer; RealAr = array of real; IntAr2 = array [,] of integer; RealAr2 = array [,] of real; {function FlattenElement(x: object): List; begin var lst := new List; if x is IntAr (var iarr) then lst.AddRange(iarr.Select(x -> object(x))) else if x is RealAr (var rarr) then lst.AddRange(rarr.Select(x -> object(x))) else if x is IntAr2 (var iarr) then lst.AddRange(iarr.ElementsByRow.Select(x -> object(x))) else if x is RealAr2 (var rarr) then lst.AddRange(rarr.ElementsByRow.Select(x -> object(x))) else if x is List (var larr) then lst.AddRange(larr.Select(x -> object(x))) else if x is List (var lrarr) then lst.AddRange(lrarr.Select(x -> object(x))) else lst.Add(x); Result := lst; end;} procedure FlattenOutput; begin // если в OutputList массивы, вытянуть их в единый список OutputList := OutputList.SelectMany(x -> FlattenElement(x)).ToList; end; function NValues(n: integer): string; begin case n of 0: Result := n + ' значений'; 1: Result := n + ' значение'; 2, 3, 4: Result := n + ' значения'; 5..100000: Result := n + ' значений'; end; end; {=========================================================} { Итоговые функции для проверки решения } {=========================================================} procedure RobotCheckSolution; begin TaskResult := BadSolution; var t := System.Type.GetType('RobotField.RobotField'); if t<>nil then begin TaskResultInfo := 'Robot'; var f := t.GetField('RobField',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static); var IsSol := f.FieldType.GetMethod('IsSolution'); var bool := IsSol.Invoke(f.GetValue(nil),nil); if boolean(bool) then TaskResult := Solved; // RobField.TaskName var RBTaskNameInfo := f.FieldType.GetField('TaskName'); var v := string(RBTaskNameInfo.GetValue(f.GetValue(nil))); // Добавлять RB к имени задания если его там нет if not v.ToLower.StartsWith('rb') then v := v.Insert(0,'RB'); TaskName := v; end; end; procedure DrawmanCheckSolution; begin TaskResult := BadSolution; var t := System.Type.GetType('DrawManField.DrawManField'); if t<>nil then begin TaskResultInfo := 'Drawman'; var f := t.GetField('DMField',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static); var IsSol := f.FieldType.GetMethod('IsSolution'); var bool := IsSol.Invoke(f.GetValue(nil),nil); if boolean(bool) then TaskResult := Solved; // DMField.TaskName var DMTaskNameInfo := f.FieldType.GetField('TaskName'); var v := string(DMTaskNameInfo.GetValue(f.GetValue(nil))); // Добавлять DM к имени задания если его там нет if not v.ToLower.StartsWith('dm') then v := v.Insert(0,'DM'); TaskName := v; end; end; // Вызов PT4.PT4.__FinalizeModule__ отражением procedure PT4CheckSolution; begin var t := System.Type.GetType('PT4.PT4'); if t<>nil then begin var meth := t.GetMethod('__FinalizeModule__',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static); if meth <> nil then meth.Invoke(nil,nil); // var f := t.GetField('TaskName',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static); TaskName := string(f.GetValue(nil)); end; end; // Вызов PT4.PT4.GetSolutionInfo отражением function GetSolutionInfoPT4: string; begin var t := System.Type.GetType('PT4.PT4'); if t<>nil then begin var meth := t.GetMethod('GetSolutionInfo',System.Reflection.BindingFlags.Public or System.Reflection.BindingFlags.Static); if meth <> nil then Result := string(meth.Invoke(nil,nil)) else Result := ''; end; end; procedure CalcPT4Result(info: string; var TaskResult: TaskStatus; var TaskResultInfo: string); // info - строка, возвращаемая GetSolutionInfoPT4 function HasSubstr(s_ru, s_en: string): boolean; begin result := false; if Pos(s_ru, info) > 0 then result := true else if Pos(s_en, info) > 0 then result := true end; function TypeNamePT(s: string): string; begin result := ''; case s of 'логического типа', 'of logical type': result := 'boolean'; 'целого типа', 'of integer type': result := 'integer'; 'вещественного типа', 'of real-number type': result := 'real'; 'символьного типа', 'of character type': result := 'char'; 'строкового типа', 'of string type': result := 'string'; end; if result = '' then if s.startswith('типа') then result := copy(s, 6, 100) else if s.startswith('of') then begin delete(s, 1, 3); delete(s, length(s) - 4, 100); result := s; end; end; procedure ExtractParts(var p1, p2, p3: string); begin var m := Regex.Match(info, 'Для ввода (.*)-го элемента \((.*)\) использована переменная (.*).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := TypeNamePT(m.Groups[2].Value); p3 := TypeNamePT(m.Groups[3].Value); exit; end; m := Regex.Match(info, 'A variable (.*) is used for input of data item with the order number (.*) \((.*)\).'); if m.Success then begin p1 := m.Groups[2].Value; p2 := TypeNamePT(m.Groups[3].Value); p3 := TypeNamePT(m.Groups[1].Value); exit; end; m := Regex.Match(info, 'Для вывода (.*)-го элемента \((.*)\) использовано выражение (.*).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := TypeNamePT(m.Groups[2].Value); p3 := TypeNamePT(m.Groups[3].Value); exit; end; m := Regex.Match(info, 'An expression (.*) is used for output of data item with the order number (.*) \((.*)\).'); if m.Success then begin p1 := m.Groups[2].Value; p2 := TypeNamePT(m.Groups[3].Value); p3 := TypeNamePT(m.Groups[1].Value); exit; end; m := Regex.Match(info, 'Количество выведенных данных: (.*) \(из (.*)\).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := m.Groups[2].Value; p3 := ''; exit; end; m := Regex.Match(info, 'The program has output (.*) data item\(s\) \(the amount of the required items is (.*)\).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := m.Groups[2].Value; p3 := ''; exit; end; m := Regex.Match(info, 'Количество прочитанных данных: (.*) \(из (.*)\).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := m.Groups[2].Value; p3 := ''; exit; end; m := Regex.Match(info, 'The program has used (.*) input data item\(s\) \(the amount of the required items is (.*)\).'); if m.Success then begin p1 := m.Groups[1].Value; p2 := m.Groups[2].Value; p3 := ''; exit; end; end; begin // Если мы сюда зашли, то TaskResult уже под контролем. Но она и так должна быть TaskStatus.InitialTaskPT4 TaskResult := TaskStatus.InitialTaskPT4; TaskResultInfo := 'PT4'; var p1, p2, p3: string; if info = '' then exit; if HasSubstr('Задание выполнено', 'The task is solved') then //ColoredMessage('Задание выполнено', MsgColorGreen) TaskResult := TaskStatus.Solved else if HasSubstr('Ошибочное решение', 'Wrong solution') then //ColoredMessage('Неверное решение') TaskResult := TaskStatus.BadSolution else if HasSubstr('Неверно указан тип при выводе результатов', 'Invalid type is used for an output data item') then begin ExtractParts(p1, p2, p3); TaskResult := TaskStatus.IOError; TaskResultInfo := $'OutputType({p1},{p2},{p3})'; //ColoredMessage($'Ошибка вывода. При выводе {p1}-го элемента типа {p2} выведено значение типа {p3}'); end else if HasSubstr('Выведены не все результирующие данные', 'Some data are not output') then begin ExtractParts(p1, p2, p3); TaskResult := TaskStatus.IOError; TaskResultInfo := $'OutputCount({p1},{p2})'; //ColoredMessage($'Выведено {p1}, а требуется вывести {p2}', MsgColorOrange); end else if HasSubstr('Неверно указан тип при вводе исходных данных', 'Invalid type is used for an input data item') then begin ExtractParts(p1, p2, p3); TaskResult := TaskStatus.IOError; TaskResultInfo := $'InputType({p1},{p2},{p3})'; //ColoredMessage($'Ошибка ввода. При вводе {p1}-го элемента типа {p2} использована переменная типа {p3}'); end else if HasSubstr('Введены не все требуемые исходные данные', 'Some required data are not input.') then begin ExtractParts(p1, p2, p3); TaskResult := TaskStatus.IOError; TaskResultInfo := $'InputCount({p1},{p2})'; //ColoredMessage($'Введено {p1}, а требуется ввести {p2}', MsgColorOrange); end else if HasSubstr('Запуск с правильным вводом данных', 'Correct data input') then begin TaskResult := TaskStatus.PartialSolution; //ColoredMessage('Запуск с правильным вводом данных', MsgColorGray) end; {else ColoredMessage('PT4: '+info.Replace(#13#10, ' ').TrimStart().TrimEnd('.',' '));} end; function ConvertTaskName(tn: string): string; begin var TName := tn; // Если есть номер с подчеркиванием в начале, то отбросить его var ind := TName.IndexOf('_'); if (ind >= 0) and TName[1].IsDigit then // Значит, в начале - номер, он служит лишь для упорядочения файлов TName := TName.Remove(0,ind + 1); if TName.ToLower in TaskNamesMap then TName := TaskNamesMap[TName.ToLower]; Result := TName; end; procedure ClearLists; begin CurPosInInputList := 0; CurPosInInputListInTestMode := 0; OutputString.Clear; OutputList.Clear; InputList.Clear; InitialOutputList.Clear; InitialInputList.Clear; end; function InitSolveProcPair: (System.Reflection.MethodInfo, System.Reflection.MethodInfo); begin // Взял из PT.pas var asm := System.Reflection.Assembly.GetExecutingAssembly; var nm := asm.FullName; Delete(nm, Pos(',', nm), length(nm)); var prg := asm.GetType(nm+'.Program'); var solveproc := prg.GetMethod('$Main'); var initproc := prg.GetMethod('$_InitVariables_'); if (solveproc = nil) or (initproc = nil) then foreach var prg0 in asm.GetTypes() do begin prg := prg0; solveproc := prg0.GetMethod('$Main'); initproc := prg0.GetMethod('$_InitVariables_'); if (solveproc <> nil) and (initproc <> nil) then break; end; Result := (InitProc,SolveProc); end; procedure CheckMyPT; begin if CheckTask = nil then exit; var TName := TaskName; try TName := ConvertTaskName(TaskName); TestMode := tmNone; TestNumber := 0; FlattenOutput; // SSM 28.06.24 CheckTask(TName); // может выдавать сообщения, предваряющие неверное решение, в CheckOutput. if {not IsPT and not IsRobot and not IsDrawMan and} (TestCount > 0) then // То это LightPT - т.к. только в LightPT TestCount м.б. > 0 begin var (InitProc,SolveProc) := InitSolveProcPair; if (GenerateTestData <> nil) and (TaskResult = Solved) then for var i:=1 to TestCount do begin TestNumber := i; ClearLists; TestMode := tmGenTest; GenerateTestData(i); if TestMode<>tmAutoTest then TestMode := tmTest; try if InitProc<>nil then InitProc.Invoke(nil,nil); SolveProc.Invoke(nil,nil); except on e: System.Reflection.TargetInvocationException do raise e.InnerException; end; //InputList := InputList; OutputList := OutputList; FlattenOutput; // SSM 28.06.24 - и перед каждым тестом OutputListIsClearedFromSpaces := False; CheckTask(TName); if TaskResult = BadSolution then break; // хоть один тест неудачный - выходим! // Подумать над выводом ошибки при тестах end; end; Silent := False; // Если это задача из задачника, то результат будет NotUnderControl. И дальше необходимо это преобразовывать case TaskResult of Solved: ColoredMessage('Задание выполнено', MsgColorGreen); BadSolution: begin ColoredMessage('Неверное решение'); end; InitialTask: ; BadInitialTask: ColoredMessage('Вы удалили часть кода - восстановите его!', MsgColorMagenta); end; except // При тестировании тут вряд ли будут ошибки. Но могут on e: OutputTypeException do begin Silent := False; ColoredMessage($'Ошибка вывода. При выводе {e.n}-го элемента типа {e.ExpectedType} выведено значение типа {e.ActualType}'); end; on e: OutputCountException do begin Silent := False; if e.Count = 0 then ColoredMessage($'Требуется вывести {NValues(e.n)}', MsgColorGray) else ColoredMessage($'Выведено {NValues(e.Count)}, а требуется вывести {e.n}', MsgColorOrange); end; on e: OutputCount2Exception do begin Silent := False; if e.Count = 0 then ColoredMessage($'Требуется вывести по крайней мере {NValues(e.i)}', MsgColorGray) else ColoredMessage($'Выведено {NValues(e.Count)}, а требуется вывести по крайней мере {e.i}', MsgColorOrange); end; on e: InputTypeException do begin Silent := False; ColoredMessage($'Ошибка ввода. При вводе {e.n}-го элемента типа {e.ExpectedType} использована переменная типа {e.ActualType}'); end; on e: InputCountException do begin Silent := False; if e.Count = 0 then ColoredMessage($'Требуется ввести {NValues(e.n)}', MsgColorGray) else if e.n <> 0 then ColoredMessage($'Введено {NValues(e.Count)}, а требуется ввести {e.n}', MsgColorOrange) else ColoredMessage($'Введено {NValues(e.Count)}, хотя ничего вводить не требуется', MsgColorOrange); end; on e: InputCount2Exception do begin Silent := False; if e.Count = 0 then ColoredMessage($'Требуется ввести по крайней мере {NValues(e.i)}', MsgColorGray) else ColoredMessage($'Введено {NValues(e.Count)}, а требуется ввести по крайней мере {e.i}', MsgColorOrange); end; on e: NotInTestModeException do begin Silent := False; ColoredMessage($'Метод {e.FuncName} может вызываться только в режиме тестирования вне GenerateTestData! Он - внутренний и не предназначен для вызова разработчиком теста!', MsgColorOrange); end; on e: NotInTestGenModeException do begin Silent := False; ColoredMessage($'Метод {e.FuncName} может вызываться только в режиме генерации тестов (в GenerateTestData)!', MsgColorOrange); end; on e: InputCountTest2Exception do begin Silent := False; ColoredMessage($'Неверно составлен тест! Введено {NValues(e.Count)}, а требуется ввести по крайней мере {e.i}. Возможно, неверно заполнен InputList в GenerateTestData', MsgColorOrange); end; on e: InputTypeTestException do begin Silent := False; ColoredMessage($'Неверно составлен тест! При вводе {e.n}-го элемента типа {e.ExpectedType} использована переменная типа {e.ActualType}. Возможно, неверно заполнен InputList в GenerateTestData'); end; on e: InputTestCountMismatchException do begin Silent := False; ColoredMessage($'Неверно составлен тест! Несоответствие количества входных данных в тесте и основном запуске. Возможно, неверно заполнен InputList в GenerateTestData'); end; on e: InputTestTypesMismatchException do begin Silent := False; ColoredMessage($'Неверно составлен тест! Несоответствие типов входных данных в тесте и основном запуске. Возможно, неверно заполнен InputList в GenerateTestData'); end; end; // Для задачника надо вызывать процедуру __FinalizeModule__ из модуля PT4 отражением, а в модуле PT4 эту процедуру тогда не вызывть // Для задачника в CheckTaskPT надо сказать, что проверяется задача из задачника. И выводить на экран ничего не надо - только в базу. TaskResultInfo := TaskException.Info; var TaskPlatform := 'LT'; // Теперь тщательно проверяем задачник и исполнителей if IsPT then begin PT4CheckSolution; TName := TaskName; var info := GetSolutionInfoPT4; CalcPT4Result(info,TaskResult,TaskResultInfo); TaskPlatform := 'PT'; end else if IsRobot then begin RobotCheckSolution; TName := TaskName; TaskPlatform := 'RB'; end else if IsDrawman then begin DrawmanCheckSolution; TName := TaskName; TaskPlatform := 'DM'; end; // Хотелось бы писать в БД для Робота и др. имя задания в Task if WriteInfoCallBack<>nil then WriteInfoCallBack(LessonName,TName,TaskPlatform,TaskResult,TaskResultInfo); end; procedure LoadLightPTInfo; begin try var lines := ReadAllLines(lightptname); foreach var line in lines do begin if line.Trim = '' then continue; if LessonName = '' then LessonName := line.ToWords.First // первое слово else begin var (name1,name2) := Regex.Split(line,'->'); TaskNamesMap[name1.Trim.ToLower] := name2.Trim; end; end; if LessonName = '' then begin // Имя текущей папки. Плохо - в lightpt забыли написать имя урока //var ttt := ExtractFileDir(System.Environment.GetCommandLineArgs[0]); var ttt := ExpandFileName('.'); var LastDir := ttt.ToWords(System.IO.Path.DirectorySeparatorChar).LastOrDefault; // Каталог может содержать пробелы. Брать первое слово if LastDir<>nil then LessonName := LastDir.ToWords.First; end; except end; end; {=========================================================} { Процедуры для записи в базы данных } {=========================================================} procedure AdditionalMessage(message: string); begin if additionalMessages then ColoredMessage(message, MsgColorMagenta); end; procedure WriteInfoToRemoteDatabase(auth: string; LessonName, TaskName, TaskPlatform, TaskResult, text, AdditionalInfo: string); begin AdditionalMessage($'WriteInfoToRemoteDatabase начало. Урок {LessonName}, задание {TaskName}, результат {TaskResult}'); // Считать логин пароль из auth var data := System.IO.File.ReadAllBytes(auth); var arr := Decrypt(data).Split(#10); AdditionalMessage($'Логин и пароль расшифрованы'); var login,pass: string; if arr.Length >= 2 then begin login := arr[0]; pass := arr[1]; // Теперь как-то записать в БД информацию var User := new ServerAccessProvider(ServerAddr); AdditionalMessage($'Непосредственно перед SendPostRequest'); var t2 := User.SendPostRequest(login, pass, LessonName, TaskName, TaskPlatform, TaskResult, text, AdditionalInfo); var v := t2.Result; AdditionalMessage($'После SendPostRequest - результат: {v}'); v := v; if v <> 'Success' then ColoredMessage('Ошибка сервера: '+v, MsgColorGray); //Console.WriteLine(v); end; end; procedure WriteInfoToDatabases(LessonName,TaskName,TaskPlatform: string; TaskResult: TaskStatus; AdditionalInfo: string := ''); begin try System.IO.File.AppendAllText('db.txt', $'{LessonName} {TaskName} {dateTime.Now.ToString(''u'')} {TaskResult.ToString} {AdditionalInfo}' + #10); except on e: Exception do ColoredMessage('Ошибка записи в файл db.txt. Обратитесь к преподавателю',MsgColorGray); end; // Разделили ошибки записи в локальную и глобальную базу try var auth := FindAuthDat(); // файл авторизации ищется либо в текущей папке либо в папке на уровень выше var args := System.Environment.GetCommandLineArgs; if auth = '' then AdditionalMessage('Файл auth.dat не найден') else if (args.Length < 3) then AdditionalMessage('args.Length < 3') else if args[2].ToLower <> 'true' then AdditionalMessage('args[2].ToLower <> true'); if (auth <> '') and (args.Length >= 3) and (args[2].ToLower = 'true') then begin var text := ''; if (TaskResult <> InitialTask) and (args.Length >= 4) then text := args[3]; // Есть проблема паузы при плохой сети WriteInfoToRemoteDatabase(auth,LessonName,TaskName,TaskPlatform,TaskResult.ToString, text, AdditionalInfo); end except on e: System.AggregateException do begin ColoredMessage('->>',MsgColorGray); foreach var x in e.InnerExceptions do if x is HTTPRequestException then begin if x.InnerException<>nil then ColoredMessage('Ошибка сервера: '+x.InnerException.Message,MsgColorGray) else ColoredMessage('Неизвестная ошибка сервера',MsgColorGray) end else ColoredMessage('Ошибка сервера: '+x.Message,MsgColorGray); end; on e: Exception do ColoredMessage('Исключение в WriteInfoToDatabases: '+e.Message,MsgColorGray); end; end; procedure SetMessagesOn; begin additionalMessages := True; end; procedure SetMessageOff; begin additionalMessages := False; end; {===========================================================} { Переопределенные подсистемы ввода и вывода } {===========================================================} type IOLightSystem = class(__ReadSignalOISystem) public procedure write(obj: object); override; begin if TestMode = tmNone then inherited write(obj); OutputString += ObjectToString(obj); OutputList += obj; CreateNewLineBeforeMessage := True; end; procedure writeln; override; begin if TestMode = tmNone then inherited writeln; OutputString += NewLine; CreateNewLineBeforeMessage := False; end; function ReadLine: string; override; begin if TestMode = tmTest then Result := InputList.ReadTestDataString else Result := inherited ReadLine; if not NeedAddDataToInputList then exit; InputList.Add(Result); CreateNewLineBeforeMessage := False; end; procedure readln; override; begin if TestMode = tmTest then else inherited readln; CreateNewLineBeforeMessage := False; end; procedure read(var x: integer); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: real); override; begin if TestMode = tmTest then x := InputList.ReadTestDataReal else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: char); override; begin if TestMode = tmTest then x := InputList.ReadTestDataChar else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: string); override; begin if TestMode = tmTest then x := InputList.ReadTestDataString else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: byte); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: shortint); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: smallint); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: word); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: longword); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: int64); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: uint64); override; begin if TestMode = tmTest then x := InputList.ReadTestDataInt else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: single); override; begin if TestMode = tmTest then x := InputList.ReadTestDataReal else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: boolean); override; begin if TestMode = tmTest then x := InputList.ReadTestDataBoolean else inherited Read(x); if not NeedAddDataToInputList then exit; InputList.Add(x); CreateNewLineBeforeMessage := True; end; procedure read(var x: BigInteger); override; begin inherited Read(x); InputList.Add(x); CreateNewLineBeforeMessage := True; end; end; initialization // Если LightPT добавляется в конец uses, то ее секция инициализации вызывается первой // В этом случае ввод-вывод обязательно переключается, но потом он перекрывается и в основной программе не срабатывает // Но в CheckPT используется ColoredMessage, которая выводит с помощью Console.WriteLine - ей всё равно var tn := TypeName(CurrentIOSystem); if (tn = 'IOStandardSystem') or (tn = '__ReadSignalOISystem') or (tn = 'IOGraphABCSystem') then CurrentIOSystem := new IOLightSystem; WriteInfoCallBack := WriteInfoToDatabases; // Расшифровка LightPT.dat LoadLightPTInfo; finalization CheckMyPT end.