From fc73ed2a5d3991dfbf6410fa54f00af048c2e117 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=91=D0=BE=D0=BD=D0=B4=D0=B0=D1=80=D0=B5=D0=B2=20=D0=98?= =?UTF-8?q?=D0=B2=D0=B0=D0=BD?= Date: Fri, 22 Mar 2019 13:42:21 +0100 Subject: [PATCH] fix #1267 --- TestSuite/CompilationSamples/PABCSystem.pas | 36 +- TestSuite/CompilationSamples/PT4MakerNetX.pas | 1589 +++++++++++++++++ TestSuite/exceptions4.pas | 64 + .../TreeConversion/syntax_tree_visitor.cs | 9 +- 4 files changed, 1691 insertions(+), 7 deletions(-) create mode 100644 TestSuite/CompilationSamples/PT4MakerNetX.pas create mode 100644 TestSuite/exceptions4.pas diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index fd53256ce..4272c192e 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -3031,7 +3031,7 @@ begin Result.high := high; end; -[System.Diagnostics.DebuggerStepThrough] +//[System.Diagnostics.DebuggerStepThrough] function CreateObjDiapason(low, high: object): Diapason; begin Result.clow := low; @@ -3041,9 +3041,39 @@ end; [System.Diagnostics.DebuggerStepThrough] function CreateSet(params elems: array of object): TypedSet; begin + var chars := false; + var strings := false; + var others := false; + foreach var x in elems do + begin + if (x is char) or (x is Diapason) and (Diapason(x).clow is char) then + chars := true + else if x is string then + strings := true + else + begin + others := true; + break + end; + end; + Result := new TypedSet(); - for var i := 0 to elems.Length - 1 do - Result.IncludeElement(elems[i]); + + if chars and strings and not others then + foreach var x in elems do + if x is char then + Result.IncludeElement(x.ToString) + else if (x is Diapason) and (Diapason(x).clow is char) then + begin + var c1 := char(Diapason(x).clow); + var c2 := char(Diapason(x).chigh); + for var cc := c1 to c2 do + Result.IncludeElement(cc.ToString) + end + else Result.IncludeElement(x) + else + foreach var x in elems do + Result.IncludeElement(x); end; [System.Diagnostics.DebuggerStepThrough] diff --git a/TestSuite/CompilationSamples/PT4MakerNetX.pas b/TestSuite/CompilationSamples/PT4MakerNetX.pas new file mode 100644 index 000000000..7d6f981ba --- /dev/null +++ b/TestSuite/CompilationSamples/PT4MakerNetX.pas @@ -0,0 +1,1589 @@ +/// Конструктор учебных заданий для задачника Programming Taskbook. +/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018. +/// Все компоненты конструктора могут вызываться либо как классовые методы класса pt, +/// либо как обычные константы и процедуры. +unit PT4MakerNetX; + +interface + +const + OptionAllLanguages = 1; // группа доступна для всех языков + OptionPascalLanguages = 2; // группа доступна для всех реализаций Паскаля + OptionNETLanguages = 4; // группа доступна для всех NET-языков + OptionUseAddition = 8; // группа доступна только при наличии файла дополнений + OptionHideExamples = 16; // не отображать раздел с примером верного решения + +/// Процедура, с которой должно начинаться определение нового задания. +/// Должна вызываться в процедуре с именем, начинающемся с текста Task. +/// Параметр topic определяет имя подгруппы и является необязательным. +/// Параметр tasktext содержит формулировку задания; отдельные строки +/// формулировки должны разделяться символами #13, #10 или #13#10. +procedure NewTask(topic, tasktext: string); + +/// Процедура, с которой должно начинаться определение нового задания. +/// Должна вызываться в процедуре с именем, начинающемся с текста Task. +/// Параметр tasktext содержит формулировку задания; отдельные строки +/// формулировки должны разделяться символами #13, #10 или #13#10. +procedure NewTask(tasktext: string); + +/// Добавляет комментарий в новой строке раздела исходных даннных. +procedure DataComm(comm: string); + +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +procedure Data(comm: string; a: object); + +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +procedure Data(comm1: string; a1: object; comm2: string); + +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +procedure Data(comm1: string; a1: object; comm2: string; a2: object); + +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string); + +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); + +/// Добавляет последовательность логических данных в раздел исходных данных. +procedure Data(seq: sequence of boolean); + +/// Добавляет последовательность целых чисел в раздел исходных данных. +procedure Data(seq: sequence of integer); + +/// Добавляет последовательность вещественных чисел в раздел исходных данных. +procedure Data(seq: sequence of real); + +/// Добавляет последовательность символов в раздел исходных данных. +procedure Data(seq: sequence of char); + +/// Добавляет последовательность строк в раздел исходных данных. +procedure Data(seq: sequence of string); + +/// Добавляет комментарий в новой строке раздела результатов. +procedure ResComm(comm: string); + +/// Добавляет данные и комментарии в новой строке раздела результатов. +procedure Res(comm: string; a: object); + +/// Добавляет данные и комментарии в новой строке раздела результатов. +procedure Res(comm1: string; a1: object; comm2: string); + +/// Добавляет данные и комментарии в новой строке раздела результатов. +procedure Res(comm1: string; a1: object; comm2: string; a2: object); + +/// Добавляет данные и комментарии в новой строке раздела результатов. +procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string); + +/// Добавляет данные и комментарии в новой строке раздела результатов. +procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); + +/// Добавляет последовательность логических данных в раздел результатов. +procedure Res(seq: sequence of boolean); + +/// Добавляет последовательность целых чисел в раздел результатов. +procedure Res(seq: sequence of integer); + +/// Добавляет последовательность вещественных чисел в раздел результатов. +procedure Res(seq: sequence of real); + +/// Добавляет последовательность символов в раздел результатов. +procedure Res(seq: sequence of char); + +/// Добавляет последовательность строк в раздел результатов. +procedure Res(seq: sequence of string); + +/// Задает минимальную ширину поля вывода для числовых данных +/// (числа выравниваются по правому краю поля вывода, +/// т.е. при необходимости дополняются слева пробелами). +/// Если n не лежит в диапазоне 0..10, то вызов процедуры игнорируется. +/// По умолчанию минимальная ширина поля вывода полагается равной 0. +procedure SetWidth(n: integer); + +/// Задает формат отображения вещественных чисел: +/// с фиксированной точкой и n дробными знаками при n > 0, +/// с плавающей точкой и n дробными знаками при n < 0, +/// с плавающей точкой и 6 дробными знаками при n = 0. +/// Если n по модулю превосходит 10, то вызов процедуры игнорируется. +/// По умолчанию устанавливается формат с фиксированной точкой +/// и 2 дробными знаками. +procedure SetPrecision(n: integer); + +/// Задает количество тестовых запусков, выполняемых +/// для проверки правильности программы (от 2 до 10). +/// По умолчанию число тестовых запусков полагается равным 5. +procedure SetTestCount(n: integer); + +/// Задает минимально необходимое количество элементов +/// исходных данных, которое требуется ввести для правильного +/// решения задачи в случае текущего набора исходных данных. +/// При отсутствии процедуры предполагается, +/// что для правильного решения надо ввести все исходные данные. +procedure SetRequiredDataCount(n: integer); + +/// Возвращает номер текущего тестового запуска +/// (запуски нумеруются от 1). +function CurrentTest: integer; + +/// Генерирует случайное целов в диапазоне от M до N включительно. +/// Если M >= N, то возвращает M. +function Random(M, N: integer): integer; + +/// Генерирует случайное вещественное на промежутке [A, B). +/// Если промежуток [A, B) пуст, то возвращает A. +function Random(A, B: real): real; + +/// Генерирует случайную строку длины len, состоящую +/// из цифр и строчных (т.е. маленьких) латинских букв. +function RandomName(len: integer): string; + +/// Создает новую группу с кратким описанием GroupDescription, +/// информацией об авторе GroupAuthor и набором необязательных опций, объединяемых операцией or. +/// Имя группы определяется по имени библиотеки (путем отбрасывания префикса PT4). +/// В группу включаются задания, определенные в процедурах, имена которых начинаются с текста Task. +/// Процедура NewGroup должна быть вызвана в процедуре inittaskgroup без параметров, которую +/// необходимо описать в библиотеке с группой заданий (все буквы в имени inittaskgroup - строчные). +procedure NewGroup(GroupDescription, GroupAuthor: string; Options: integer := 0); + +/// Обеспечивает регистрацию созданной группы в электронном задачнике. +/// Процедура ActivateNET(S) должна быть вызвана в процедуре activate(S: string), +/// которую необходимо описать в библиотеке с группой заданий (все буквы в имени activate - строчные). +procedure ActivateNET(S: string); + +/// Импортирует в создаваемую группу существующее задание +/// из группы GroupName с номером TaskNumber. Должна вызываться +/// в процедуре с именем, начинающемся с текста Task. +procedure UseTask(GroupName: string; TaskNumber: integer); + +/// Возвращает массив из 116 русских слов. +function GetWords: array of string; +/// Возвращает массив из 116 английских слов. +function GetEnWords: array of string; +/// Возвращает массив из 61 русского предложения. +function GetSentences: array of string; +/// Возвращает массив из 61 английского предложения. +function GetEnSentences: array of string; +/// Возвращает массив из 85 русских многострочных текстов. +/// Каждая строка текста оканчивается символами #13#10. +function GetTexts: array of string; +/// Возвращает массив из 85 английских многострочных текстов. +/// Каждая строка текста оканчивается символами #13#10. +function GetEnTexts: array of string; + +/// Возвращает случайное русское слово из массива, +/// входящего в конструктор учебных заданий. +function RandomWord: string; +/// Возвращает случайное английское слово из массива, +/// входящего в конструктор учебных заданий. +function RandomEnWord: string; +/// Возвращает случайное русское предложение из массива, +/// входящего в конструктор учебных заданий. +function RandomSentence: string; +/// Возвращает случайное английское предложение из массива, +/// входящего в конструктор учебных заданий. +function RandomEnSentence: string; +/// Возвращает случайный русский многострочный текст из массива, +/// входящего в конструктор учебных заданий. +/// Каждая строка текста оканчивается символами #13#10. +function RandomText: string; +/// Возвращает случайный английский многострочный текст из массива, +/// входящего в конструктор учебных заданий. +/// Каждая строка текста оканчивается символами #13#10. +function RandomEnText: string; + + +/// Добавляет в задание исходный файл целых чисел +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. +procedure DataFileInteger(FileName: string); +/// Добавляет в задание исходный файл вещественных чисел +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. +procedure DataFileReal(FileName: string); +/// Добавляет в задание исходный символьный файл +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. Символы должны +/// храниться в файле в однобайтной кодировке. +procedure DataFileChar(FileName: string); +/// Добавляет в задание исходный строковый файл +/// с элементами типа ShortString и именем FileName +/// и отображает его содержимое в разделе исходных данных. +/// Длина элементов файла не должна превосходить 70 символов. +/// Строки должны храниться в файле в однобайтной кодировке. +procedure DataFileString(FileName: string); +/// Добавляет в задание исходный текстовый файл +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. Длина каждой строки +/// текстового файла не должна превосходить 70 символов. +/// Текст должен храниться в файле в однобайтной кодировке. +procedure DataText(FileName: string; LineCount: integer := 4); + +/// Добавляет в задание результирующий файл целых чисел +/// с именем FileName и отображает его содержимое в разделе результатов. +procedure ResFileInteger(FileName: string); +/// Добавляет в задание результирующий файл вещественных чисел +/// с именем FileName и отображает его содержимое в разделе результатов. +procedure ResFileReal(FileName: string); +/// Добавляет в задание результирующий символьный файл +/// с именем FileName и отображает его содержимое в разделе результатов. +/// Символы должны храниться в файле в однобайтной кодировке. +procedure ResFileChar(FileName: string); +/// Добавляет в задание результирующий строковый файл +/// с элементами типа ShortString и именем FileName +/// и отображает его содержимое в разделе результатов. +/// Длина элементов файла не должна превосходить 70 символов. +/// Строки должны храниться в файле в однобайтной кодировке. +procedure ResFileString(FileName: string); +/// Добавляет в задание результирующий текстовый файл +/// с именем FileName и отображает его содержимое в разделе результатов. +/// Длина каждой строки текстового файла не должна превосходить 70 символов. +/// Текст должен храниться в файле в однобайтной кодировке. +procedure ResText(FileName: string; LineCount: integer := 5); + +type pt = class + private + constructor Create; + begin + end; + public +/// Дополнительная опция для процедуры NewGroup: +/// группа доступна для всех языков. + class function OptionAllLanguages: integer; + begin + result := PT4MakerNetX.OptionAllLanguages; + end; +/// Дополнительная опция для процедуры NewGroup: +/// группа доступна для всех реализаций языка Pascal. + class function OptionPascalLanguages: integer; + begin + result := PT4MakerNetX.OptionPascalLanguages; + end; +/// Дополнительная опция для процедуры NewGroup: +/// группа доступна для всех NET-языков. + class function OptionNETLanguages: integer; + begin + result := PT4MakerNetX.OptionNETLanguages; + end; +/// Дополнительная опция для процедуры NewGroup: +/// группа доступна только при наличии связанного с ней файла дополнений. + class function OptionUseAddition: integer; + begin + result := PT4MakerNetX.OptionUseAddition; + end; +/// Дополнительная опция для процедуры NewGroup: +/// в заданиях данной группы не будет отображаться пример верного решения. + class function OptionHideExamples: integer; + begin + result := PT4MakerNetX.OptionHideExamples; + end; +/// Процедура, с которой должно начинаться определение нового задания. +/// Должна вызываться в процедуре с именем, начинающемся с текста Task. +/// Параметр topic определяет имя подгруппы (является необязательным). +/// Параметр tasktext содержит формулировку задания; отдельные строки +/// формулировки должны разделяться символами #13, #10 или #13#10. +class procedure NewTask(topic, tasktext: string); +begin + PT4MakerNetX.NewTask(topic, tasktext); +end; +/// Процедура, с которой должно начинаться определение нового задания. +/// Должна вызываться в процедуре с именем, начинающемся с текста Task. +/// Параметр tasktext содержит формулировку задания; отдельные строки +/// формулировки должны разделяться символами #13, #10 или #13#10. +class procedure NewTask(tasktext: string); +begin + PT4MakerNetX.NewTask(tasktext); +end; +/// Добавляет комментарий в новой строке раздела исходных даннных. +class procedure DataComm(comm: string); +begin + PT4MakerNetX.DataComm(comm); +end; +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +class procedure Data(comm: string; a: object); +begin + PT4MakerNetX.Data(comm, a); +end; +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +class procedure Data(comm1: string; a1: object; comm2: string); +begin + PT4MakerNetX.Data(comm1, a1, comm2); +end; +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +class procedure Data(comm1: string; a1: object; comm2: string; a2: object); +begin + PT4MakerNetX.Data(comm1, a1, comm2, a2); +end; +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +class procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string); +begin + PT4MakerNetX.Data(comm1, a1, comm2, a2, comm3); +end; +/// Добавляет данные и комментарии в новой строке раздела исходных даннных. +class procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); +begin + PT4MakerNetX.Data(comm1, a1, comm2, a2, comm3, a3); +end; +/// Добавляет последовательность логических данных в раздел исходных данных. +class procedure Data(seq: sequence of boolean); +begin + PT4MakerNetX.Data(seq); +end; +/// Добавляет последовательность целых чисел в раздел исходных данных. +class procedure Data(seq: sequence of integer); +begin + PT4MakerNetX.Data(seq); +end; +/// Добавляет последовательность вещественных чисел в раздел исходных данных. +class procedure Data(seq: sequence of real); +begin + PT4MakerNetX.Data(seq); +end; +/// Добавляет последовательность символов в раздел исходных данных. +class procedure Data(seq: sequence of char); +begin + PT4MakerNetX.Data(seq); +end; +/// Добавляет последовательность строк в раздел исходных данных. +class procedure Data(seq: sequence of string); +begin + PT4MakerNetX.Data(seq); +end; + +/// Добавляет комментарий в новой строке раздела результатов. +class procedure ResComm(comm: string); +begin + PT4MakerNetX.ResComm(comm); +end; +/// Добавляет данные и комментарии в новой строке раздела результатов. +class procedure Res(comm: string; a: object); +begin + PT4MakerNetX.Res(comm, a); +end; +/// Добавляет данные и комментарии в новой строке раздела результатов. +class procedure Res(comm1: string; a1: object; comm2: string); +begin + PT4MakerNetX.Res(comm1, a1, comm2); +end; +/// Добавляет данные и комментарии в новой строке раздела результатов. +class procedure Res(comm1: string; a1: object; comm2: string; a2: object); +begin + PT4MakerNetX.Res(comm1, a1, comm2, a2); +end; +/// Добавляет данные и комментарии в новой строке раздела результатов. +class procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string); +begin + PT4MakerNetX.Res(comm1, a1, comm2, a2, comm3); +end; +/// Добавляет данные и комментарии в новой строке раздела результатов. +class procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); +begin + PT4MakerNetX.Res(comm1, a1, comm2, a2, comm3, a3); +end; +/// Добавляет последовательность логических данных в раздел результатов. +class procedure Res(seq: sequence of boolean); +begin + PT4MakerNetX.Res(seq); +end; +/// Добавляет последовательность целых чисел в раздел результатов. +class procedure Res(seq: sequence of integer); +begin + PT4MakerNetX.Res(seq); +end; +/// Добавляет последовательность вещественных чисел в раздел результатов. +class procedure Res(seq: sequence of real); +begin + PT4MakerNetX.Res(seq); +end; +/// Добавляет последовательность символов в раздел результатов. +class procedure Res(seq: sequence of char); +begin + PT4MakerNetX.Res(seq); +end; +/// Добавляет последовательность строк в раздел результатов. +class procedure Res(seq: sequence of string); +begin + PT4MakerNetX.Res(seq); +end; + +/// Задает минимальную ширину поля вывода для числовых данных +/// (числа выравниваются по правому краю поля вывода, +/// т.е. при необходимости дополняются слева пробелами). +/// Если n не лежит в диапазоне 0..10, то вызов процедуры игнорируется. +/// По умолчанию минимальная ширина поля вывода полагается равной 0. +class procedure SetWidth(n: integer); +begin + PT4MakerNetX.SetWidth(n); +end; +/// Задает формат отображения вещественных чисел: +/// с фиксированной точкой и n дробными знаками при n > 0, +/// с плавающей точкой и n дробными знаками при n < 0, +/// с плавающей точкой и 6 дробными знаками при n = 0. +/// Если n по модулю превосходит 10, то вызов процедуры игнорируется. +/// По умолчанию устанавливается формат с фиксированной точкой +/// и 2 дробными знаками. +class procedure SetPrecision(n: integer); +begin + PT4MakerNetX.SetPrecision(n); +end; +/// Задает количество тестовых запусков, выполняемых +/// для проверки правильности программы (от 2 до 10). +/// По умолчанию число тестовых запусков полагается равным 5. +class procedure SetTestCount(n: integer); +begin + PT4MakerNetX.SetTestCount(n); +end; +/// Задает минимально необходимое количество элементов +/// исходных данных, которое требуется ввести для правильного +/// решения задачи в случае текущего набора исходных данных. +/// При отсутствии процедуры предполагается, +/// что для правильного решения надо ввести все исходные данные. +class procedure SetRequiredDataCount(n: integer); +begin + PT4MakerNetX.SetRequiredDataCount(n); +end; +/// Возвращает номер текущего тестового запуска +/// (запуски нумеруются от 1). +class function CurrentTest: integer; +begin + result := PT4MakerNetX.CurrentTest; +end; + +/// Генерирует случайное целов в диапазоне от M до N включительно. +/// Если M >= N, то возвращает M. +class function Random(M, N: integer): integer; +begin + result := PT4MakerNetX.Random(M, N); +end; +/// Генерирует случайное вещественное на промежутке [A, B). +/// Если промежуток [A, B) пуст, то возвращает A. +class function Random(A, B: real): real; +begin + result := PT4MakerNetX.Random(A, B); +end; +/// Генерирует случайную строку длины len, состоящую +/// из цифр и строчных (т.е. маленьких) латинских букв. +class function RandomName(len: integer): string; +begin + result := PT4MakerNetX.RandomName(len); +end; + +/// Создает новую группу с кратким описанием GroupDescription, +/// информацией об авторе GroupAuthor и набором необязательных опций, объединяемых операцией or. +/// Имя группы определяется по имени библиотеки (путем отбрасывания префикса PT4). +/// В группу включаются задания, определенные в процедурах, имена которых начинаются с текста Task. +/// Процедура NewGroup должна быть вызвана в процедуре inittaskgroup без параметров, которую +/// необходимо описать в библиотеке с группой заданий (все буквы в имени inittaskgroup - строчные). +class procedure NewGroup(GroupDescription, GroupAuthor: string; Options: integer := 0); +begin + PT4MakerNetX.NewGroup(GroupDescription, GroupAuthor, Options); +end; +/// Обеспечивает регистрацию созданной группы в электронном задачнике. +/// Процедура ActivateNET(S) должна быть вызвана в процедуре activate(S: string), +/// которую необходимо описать в библиотеке с группой заданий (все буквы в имени activate - строчные). +class procedure ActivateNET(S: string); +begin + PT4MakerNetX.ActivateNET(S); +end; +/// Импортирует в создаваемую группу существующее задание +/// из группы GroupName с номером TaskNumber. Должна вызываться +/// в процедуре с именем, начинающемся с текста Task. +class procedure UseTask(GroupName: string; TaskNumber: integer); +begin + PT4MakerNetX.UseTask(GroupName, TaskNumber); +end; +/// Возвращает массив из 116 русских слов. +class function GetWords: array of string; +begin + result := PT4MakerNetX.GetWords; +end; +/// Возвращает массив из 116 английских слов. +class function GetEnWords: array of string; +begin + result := PT4MakerNetX.GetEnWords; +end; +/// Возвращает массив из 61 русского предложения. +class function GetSentences: array of string; +begin + result := PT4MakerNetX.GetSentences; +end; +/// Возвращает массив из 61 английского предложения. +class function GetEnSentences: array of string; +begin + result := PT4MakerNetX.GetEnSentences; +end; +/// Возвращает массив из 85 русских многострочных текстов. +/// Каждая строка текста оканчивается символами #13#10. +class function GetTexts: array of string; +begin + result := PT4MakerNetX.GetTexts; +end; +/// Возвращает массив из 85 английских многострочных текстов. +/// Каждая строка текста оканчивается символами #13#10. +class function GetEnTexts: array of string; +begin + result := PT4MakerNetX.GetEnTexts; +end; +/// Возвращает случайное русское слово из массива, +/// входящего в конструктор учебных заданий. +class function RandomWord: string; +begin + result := PT4MakerNetX.RandomWord; +end; +/// Возвращает случайное английское слово из массива, +/// входящего в конструктор учебных заданий. +class function RandomEnWord: string; +begin + result := PT4MakerNetX.RandomEnWord; +end; +/// Возвращает случайное русское предложение из массива, +/// входящего в конструктор учебных заданий. +class function RandomSentence: string; +begin + result := PT4MakerNetX.RandomSentence; +end; +/// Возвращает случайное английское предложение из массива, +/// входящего в конструктор учебных заданий. +class function RandomEnSentence: string; +begin + result := PT4MakerNetX.RandomEnSentence; +end; +/// Возвращает случайный русский многострочный текст из массива, +/// входящего в конструктор учебных заданий. +/// Каждая строка текста оканчивается символами #13#10. +class function RandomText: string; +begin + result := PT4MakerNetX.RandomText; +end; +/// Возвращает случайный английский многострочный текст из массива, +/// входящего в конструктор учебных заданий. +/// Каждая строка текста оканчивается символами #13#10. +class function RandomEnText: string; +begin + result := PT4MakerNetX.RandomEnText; +end; + +/// Добавляет в задание исходный файл целых чисел +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. +class procedure DataFileInteger(FileName: string); +begin + PT4MakerNetX.DataFileInteger(FileName); +end; +/// Добавляет в задание исходный файл вещественных чисел +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. +class procedure DataFileReal(FileName: string); +begin + PT4MakerNetX.DataFileReal(FileName); +end; +/// Добавляет в задание исходный символьный файл +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. Символы должны +/// храниться в файле в однобайтной кодировке. +class procedure DataFileChar(FileName: string); +begin + PT4MakerNetX.DataFileChar(FileName); +end; +/// Добавляет в задание исходный строковый файл +/// с элементами типа ShortString и именем FileName +/// и отображает его содержимое в разделе исходных данных. +/// Длина элементов файла не должна превосходить 70 символов. +/// Строки должны храниться в файле в однобайтной кодировке. +class procedure DataFileString(FileName: string); +begin + PT4MakerNetX.DataFileString(FileName); +end; +/// Добавляет в задание исходный текстовый файл +/// с именем FileName и отображает его содержимое +/// в разделе исходных данных. Длина каждой строки +/// текстового файла не должна превосходить 70 символов. +/// Текст должен храниться в файле в однобайтной кодировке. +class procedure DataText(FileName: string; LineCount: integer := 4); +begin + PT4MakerNetX.DataText(FileName); +end; + +/// Добавляет в задание результирующий файл целых чисел +/// с именем FileName и отображает его содержимое в разделе результатов. +class procedure ResFileInteger(FileName: string); +begin + PT4MakerNetX.ResFileInteger(FileName); +end; +/// Добавляет в задание результирующий файл вещественных чисел +/// с именем FileName и отображает его содержимое в разделе результатов. +class procedure ResFileReal(FileName: string); +begin + PT4MakerNetX.ResFileReal(FileName); +end; +/// Добавляет в задание результирующий символьный файл +/// с именем FileName и отображает его содержимое в разделе результатов. +/// Символы должны храниться в файле в однобайтной кодировке. +class procedure ResFileChar(FileName: string); +begin + PT4MakerNetX.ResFileChar(FileName); +end; +/// Добавляет в задание результирующий строковый файл +/// с элементами типа ShortString и именем FileName +/// и отображает его содержимое в разделе результатов. +/// Длина элементов файла не должна превосходить 70 символов. +/// Строки должны храниться в файле в однобайтной кодировке. +class procedure ResFileString(FileName: string); +begin + PT4MakerNetX.ResFileString(FileName); +end; +/// Добавляет в задание результирующий текстовый файл +/// с именем FileName и отображает его содержимое в разделе результатов. +/// Длина каждой строки текстового файла не должна превосходить 70 символов. +/// Текст должен храниться в файле в однобайтной кодировке. +class procedure ResText(FileName: string; LineCount: integer := 5); +begin + PT4MakerNetX.ResText(FileName); +end; +end; + + +implementation +{$reference system.windows.forms.dll} +uses System.Reflection, PT4TaskMakerNET, System.Windows.Forms, System; + +const + alphabet = '0123456789abcdefghijklmnopqrstuvwxyz'; + ErrMes1 = 'Error: Раздел размером более 5 строк не может содержать файловые данные.'; + ErrMes2 = 'Error: При наличии файловых данных раздел не может содержать более 5 строк.'; + ErrMes3 = 'Error: Количество исходных данных превысило 200.'; + ErrMes4 = 'Error: Количество результирующих данных превысило 200.'; + ErrMes5 = 'Error: При определении задания первой должна вызываться процедура NewTask.'; + ErrMes6 = 'Error: При определении задания не указаны исходные данные.'; + ErrMes7 = 'Error: При определении задания не указаны результирующие данные.'; + +var + yd, yr, ye, nd, nr, pr, wd: integer; + nt, ut, fd, fr: boolean; + fmt: string; + tasks := new List(100); + +procedure Show(s: string); +begin + MessageBox.Show(s, 'Error', MessageBoxButtons.OK, MessageBoxIcon.Error); +end; + +function ErrorMessage(s: string): string; +begin + result := Copy(s + new string(' ', 100), 1, 78); +end; + +procedure ErrorInfo(s: string); +begin + PT4TaskMakerNET.TaskText('\B'+ErrorMessage(s)+'\b', 0, ye); + ye := ye + 1; + if ye > 5 then ye := 0; +end; + +function CheckTT: boolean; +begin + result := ut; + if not nt then + begin + NewTask(''); + ErrorInfo(ErrMes5); + end; +end; + +function RandomName(len: integer): string; +begin + result := ArrRandom(len, 1, alphabet.Length) + .Select(e -> alphabet[e]).JoinIntoString(''); +end; + +procedure SetPrecision(n: integer); +begin + if CheckTT then exit; + if abs(n) > 10 then exit; + pr := n; + if n < 0 then + begin + fmt := 'e' + IntToStr(-n); + n := 0; + end + else if n = 0 then + fmt := 'e6' + else + fmt := 'f' + IntToStr(n); + PT4TaskMakerNET.SetPrecision(n); +end; + +procedure SetWidth(n: integer); +begin + if (n >= 0) and (n <= 20) then + wd := n; +end; + +procedure NewTask(topic, tasktext: string); +begin + if nt then exit; + PT4TaskMakerNET.CreateTask(topic); + PT4TaskMakerNET.TaskText(tasktext); + nt := true; // вызвана процедура NewTask + ut := false; // было подключено существующее задание (процедурой UseTask) + ye := 1; // текущий номер строки для вывода сообщения об ошибке + yd := 0; // текущий номер строки в разделе исходных данных + yr := 0; // текущий номер строки в разделе результатов + nd := 0; // количество элементов исходных данных + nr := 0; // количество элементов результирующих данных + fd := false; // наличие файловых данных в разделе исходных данных + fr := false; // наличие файловых данных в разделе результатов + pr := 2; // текущая точность вывода вещественных данных + fmt := 'f2'; // текущий формат вывода вещественных данных + wd := 0; // текущая ширина поля вывода для чисел +end; + +function wreal(w: integer; x: real): integer; +begin + result := w; + if w = 0 then + begin + result := Format('{0,0:' + fmt + '}', x).Length; + if (pr <= 0) and (x >= 0) then + result := result + 1; + end; +end; + +function winteger(w: integer; x: integer): integer; +begin + result := w; + if w = 0 then + result := IntToStr(x).Length; +end; + +procedure NewTask(tasktext: string); +begin + NewTask('', tasktext); +end; + +procedure Data(s: string; a: object; x, y, w: integer); +begin + if (y > 5) and fd then + begin + ErrorInfo(ErrMes2); + exit; + end; + inc(nd); + if nd > 200 then + begin + ErrorInfo(ErrMes3); + exit; + end; + if a is boolean then + DataB(s, boolean(a), x, y) + else if a is integer then + DataN(s, integer(a), x, y, winteger(w, integer(a))) + else if a is real then + DataR(s, real(a), x, y, wreal(w, real(a))) + else if a is char then + DataC(s, char(a), x, y) + else if a is string then + DataS(s, string(a), x, y) + else + DataComment(Copy(s + '!WrongType:' + a.GetType.Name, 1, 38), x, y); +end; + +procedure Res(s: string; a: object; x, y, w: integer); +begin + if (y > 5) and fr then + begin + ErrorInfo(ErrMes2); + exit; + end; + inc(nr); + if nr > 200 then + begin + ErrorInfo(ErrMes4); + exit; + end; + if a is boolean then + ResultB(s, boolean(a), x, y) + else if a is integer then + ResultN(s, integer(a), x, y, winteger(w, integer(a))) + else if a is real then + ResultR(s, real(a), x, y, wreal(w, real(a))) + else if a is char then + ResultC(s, char(a), x, y) + else if a is string then + ResultS(s, string(a), x, y) + else + ResultComment(Copy(s + '!WrongType:' + a.GetType.Name, 1, 38), x, y); +end; + +procedure DataComm(comm: string); +begin + if CheckTT then exit; + inc(yd); + DataComment(comm, 0, yd); +end; + +procedure Data(comm: string; a: object); +begin + if CheckTT then exit; + inc(yd); + Data(comm, a, 0, yd, wd); +end; + +procedure Data(comm1: string; a1: object; comm2: string); +begin + if CheckTT then exit; + inc(yd); + Data(comm1, a1, xLeft, yd, wd); + DataComment(comm2, xRight, yd); +end; + +procedure Data(comm1: string; a1: object; comm2: string; a2: object); +begin + if CheckTT then exit; + inc(yd); + Data(comm1, a1, xLeft, yd, wd); + Data(comm2, a2, xRight, yd, wd); +end; + +procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string); +begin + if CheckTT then exit; + inc(yd); + Data(comm1, a1, xLeft, yd, wd); + Data(comm2, a2, 0, yd, wd); + DataComment(comm3, xRight, yd); +end; + +procedure Data(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); +begin + if CheckTT then exit; + inc(yd); + Data(comm1, a1, xLeft, yd, wd); + Data(comm2, a2, 0, yd, wd); + Data(comm3, a3, xRight, yd, wd); +end; + +procedure Data(seq: sequence of boolean); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yd); + var w := 5; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yd); + i := 1; + end; + Data('', e, Center(i, n, w, 2), yd, w); + end; +end; + +procedure Data(seq: sequence of integer); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yd); + var w := wd; + if w = 0 then + w := seq.Select(e -> IntToStr(e)).Max(e -> e.Length); + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yd); + i := 1; + end; + Data('', e, Center(i, n, w, 2), yd, w); + end; +end; + +procedure Data(seq: sequence of real); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yd); + var w := wd; + if w = 0 then + w := seq.Select(e -> wreal(0, e)(*Format('{0,0:'+fmt+'}', e)*)).Max; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yd); + i := 1; + end; + Data('', e, Center(i, n, w, 2), yd, w); + end; +end; + +procedure Data(seq: sequence of char); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yd); + var w := 3; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yd); + i := 1; + end; + Data('', e, Center(i, n, w, 2), yd, w); + end; +end; + +procedure Data(seq: sequence of string); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yd); + var w := seq.Max(e -> e.Length) + 2; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yd); + i := 1; + end; + Data('', e, Center(i, n, w, 2), yd, w); + end; +end; + +procedure ResComm(comm: string); +begin + if CheckTT then exit; + inc(yr); + ResultComment(comm, 0, yr); +end; + +procedure Res(comm: string; a: object); +begin + if CheckTT then exit; + inc(yr); + Res(comm, a, 0, yr, wd); +end; + +procedure Res(comm1: string; a1: object; comm2: string); +begin + if CheckTT then exit; + inc(yr); + Res(comm1, a1, xLeft, yr, wd); + ResultComment(comm2, xRight, yr); +end; + +procedure Res(comm1: string; a1: object; comm2: string; a2: object); +begin + if CheckTT then exit; + inc(yr); + Res(comm1, a1, xLeft, yr, wd); + Res(comm2, a2, xRight, yr, wd); +end; + +procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string); +begin + if CheckTT then exit; + inc(yr); + Res(comm1, a1, xLeft, yr, wd); + Res(comm2, a2, 0, yr, wd); + ResultComment(comm3, xRight, yr); +end; + +procedure Res(comm1: string; a1: object; comm2: string; a2: object; comm3: string; a3: object); +begin + if CheckTT then exit; + inc(yr); + Res(comm1, a1, xLeft, yr, wd); + Res(comm2, a2, 0, yr, wd); + Res(comm3, a3, xRight, yr, wd); +end; + +procedure Res(seq: sequence of boolean); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yr); + var w := 5; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yr); + i := 1; + end; + Res('', e, Center(i, n, w, 2), yr, w); + end; +end; + +procedure Res(seq: sequence of integer); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yr); + var w := wd; + if w = 0 then + w := seq.Select(e -> IntToStr(e)).Max(e -> e.Length); + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yr); + i := 1; + end; + Res('', e, Center(i, n, w, 2), yr, w); + end; +end; + +procedure Res(seq: sequence of real); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yr); + var w := wd; + if w = 0 then + w := seq.Select(e -> wreal(0, e)).Max; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yr); + i := 1; + end; + Res('', e, Center(i, n, w, 2), yr, w); + end; +end; + +procedure Res(seq: sequence of char); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yr); + var w := 3; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yr); + i := 1; + end; + Res('', e, Center(i, n, w, 2), yr, w); + end; +end; + +procedure Res(seq: sequence of string); +begin + if CheckTT then exit; + var n := seq.Count; + if n = 0 then exit; + inc(yr); + var w := seq.Max(e -> e.Length) + 2; + var wmax := 80 div (w + 2); + if n > wmax then + n := wmax; + var i := 0; + foreach var e in seq do + begin + inc(i); + if i > wmax then + begin + inc(yr); + i := 1; + end; + Res('', e, Center(i, n, w, 2), yr, w); + end; +end; + + +procedure ActivateNET(S: string); +begin + PT4TaskMakerNET.ActivateNET(S); +end; + +procedure RunTask(num: integer); +var ut0: boolean; +begin + try + try + if (num > 0) and (num <= tasks.Count) then + tasks[num - 1].Invoke(nil, nil); + finally + nt := false; + ut0 := ut; + ut := false; + end; + except + on e: TargetInvocationException do + begin + ErrorInfo('Error ' + + e.InnerException.GetType.Name + ': ' + + e.InnerException.message); + end; + end; + if ut0 then exit; + if (nd = 0) and not fd then + DataS('\B'+Copy(ErrorMessage(ErrMes6),1,76)+'\b', '', 1, 1); + if (nr = 0) and not fr then + ResultS('\B'+Copy(ErrorMessage(ErrMes7),1,76)+'\b', '', 1, 1); +end; + +function GetGroupName(assname: string): string; +begin + result := copy(assname, 1, pos(',', assname)-1); + var p := pos('_', result); + if p > 0 then + delete(result, p, 100); + delete(result, 1, 3); +end; + +function AcceptedLanguage(opt: integer): boolean; +begin + var lang := CurrentLanguage; + result := (lang = lgPascalABCNET) + or (opt and OptionAllLanguages = OptionAllLanguages) + or (lang and lgNET <> 0) and (opt and OptionNETLanguages = OptionNETLanguages) + or (lang and lgPascal = lgPascal) and (opt and OptionPascalLanguages = OptionPascalLanguages); +end; + + +procedure NewGroup(GroupDescription, GroupAuthor: string; Options: integer); + +begin + if not AcceptedLanguage(Options) then exit; // недопустимый текущий язык + var ass := Assembly.GetCallingAssembly; + var GroupName := GetGroupName(ass.FullName); + var nm := 'PT4' + GroupName; + tasks.Clear; + var GroupKey := 'GK'; + foreach var e in ass.GetType(nm + '.' + nm).GetMethods do + if e.Name.ToUpper.StartsWith('TASK') then + begin + tasks.Add(e); + GroupKey := GroupKey + Copy(e.Name, 5, 100); + end; + if tasks.Count = 0 then + begin + Show('Группа ' + GroupName + ' не содержит заданий'#13#10+ + '(имена процедур с заданиями должны начинаться с текста "Task").'); + exit; + end; + if tasks.Count > 999 then + begin + Show('Группа ' + GroupName + ' содержит более 999 заданий.'); + exit; + end; + if Options and OptionUseAddition = OptionUseAddition then + GroupKey := GroupKey + '#UseAddition#'; + if Options and OptionHideExamples = OptionHideExamples then + GroupKey := GroupKey + '#HideExamples#'; + CreateGroup(GroupName, GroupDescription, GroupAuthor, + GroupKey, tasks.Count, RunTask); +end; + + +procedure SetTestCount(n: integer); +begin + if CheckTT then exit; + PT4TaskMakerNET.SetTestCount(n); +end; + +procedure SetRequiredDataCount(n: integer); +begin + if CheckTT then exit; + PT4TaskMakerNET.SetRequiredDataCount(n); +end; + +function Random(M, N: integer): integer; +begin + result := PT4TaskMakerNET.RandomN(M, N); +end; + +function Random(A, B: real): real; +begin + result := PT4TaskMakerNET.RandomR(A, B); +end; + +function CurrentTest: integer; +begin + if CheckTT then exit; + result := PT4TaskMakerNET.CurrentTest; +end; + +procedure UseTask(GroupName: string; TaskNumber: integer); +begin + if ut then exit; + PT4TaskMakerNET.UseTask(GroupName, TaskNumber); + ut := true; +end; + +function GetWords: array of string; +begin + Result := ArrGen(WordCount, i -> WordSample(i)); +end; + +function RandomWord: string; +begin + Result := WordSample(RandomN(0, WordCount - 1)); +end; + +function GetEnWords: array of string; +begin + Result := ArrGen(EnWordCount, i -> EnWordSample(i)); +end; + +function RandomEnWord: string; +begin + Result := EnWordSample(RandomN(0, EnWordCount - 1)); +end; + +function GetSentences: array of string; +begin + Result := ArrGen(SentenceCount, i -> SentenceSample(i)); +end; + +function RandomSentence: string; +begin + Result := SentenceSample(RandomN(0, SentenceCount - 1)); +end; + +function GetEnSentences: array of string; +begin + Result := ArrGen(EnSentenceCount, i -> EnSentenceSample(i)); +end; + +function RandomEnSentence: string; +begin + Result := EnSentenceSample(RandomN(0, EnSentenceCount - 1)); +end; + +function GetTexts: array of string; +begin + Result := ArrGen(TextCount, i -> TextSample(i)); +end; + +function RandomText: string; +begin + Result := TextSample(RandomN(0, TextCount - 1)); +end; + +function GetEnTexts: array of string; +begin + Result := ArrGen(EnTextCount, i -> EnTextSample(i)); +end; + +function RandomEnText: string; +begin + Result := EnTextSample(RandomN(0, EnTextCount - 1)); +end; + +procedure DataFileInteger(FileName: string); +begin + if CheckTT then exit; + inc(yd); + if yd > 5 then + begin + DataComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of integer; + Reset(f, FileName); + while not EOF(f) do + begin + var a: integer; + read(f, a); + var s := IntToStr(a); + if s.Length > w then + w := s.Length; + end; + Close(f); + except + on ex: Exception do + begin + DataComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fd := true; + DataFileN(FileName, yd, w + 2); +end; + +procedure DataFileReal(FileName: string); +begin + if CheckTT then exit; + inc(yd); + if yd > 5 then + begin + DataComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of real; + Reset(f, FileName); + while not EOF(f) do + begin + var a: real; + read(f, a); + var s := wreal(0, a); + if s > w then + w := s; + end; + Close(f); + except + on ex: Exception do + begin + DataComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fd := true; + DataFileR(FileName, yd, w + 2); +end; + +procedure DataFileChar(FileName: string); +begin + if CheckTT then exit; + inc(yd); + if yd > 5 then + begin + DataComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + fd := true; + DataFileC(FileName, yd, 5); +end; + +procedure DataFileString(FileName: string); +begin + + if CheckTT then exit; + inc(yd); + if yd > 5 then + begin + DataComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of ShortString; + Reset(f, FileName); + while not EOF(f) do + begin + var a: ShortString; + read(f, a); + if Length(a) > w then + w := Length(a); + end; + Close(f); + except + on ex: Exception do + begin + DataComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fd := true; + DataFileS(FileName, yd, w + 4); + +end; + +procedure DataText(FileName: string; LineCount: integer); +begin + if CheckTT then exit; + inc(yd); + if yd > 5 then + begin + DataComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + fd := true; + var yd2 := yd + LineCount - 1; + if yd2 > 5 then yd2 := 5; + DataFileT(FileName, yd, yd2); + yd := yd2; +end; + +procedure ResFileInteger(FileName: string); +begin + if CheckTT then exit; + inc(yr); + if yr > 5 then + begin + ResComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of integer; + Reset(f, FileName); + while not EOF(f) do + begin + var a: integer; + read(f, a); + var s := IntToStr(a); + if s.Length > w then + w := s.Length; + end; + Close(f); + except + on ex: Exception do + begin + ResComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fr := true; + ResultFileN(FileName, yr, w + 2); +end; + +procedure ResFileReal(FileName: string); +begin + if CheckTT then exit; + ResComm(fmt); + inc(yr); + if yr > 5 then + begin + ResComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of real; + Reset(f, FileName); + while not EOF(f) do + begin + var a: real; + read(f, a); + var s := wreal(0, a); + if s > w then + w := s; + end; + Close(f); + except + on ex: Exception do + begin + ResComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fr := true; + ResultFileR(FileName, yr, w + 2); +end; + +procedure ResFileChar(FileName: string); +begin + if CheckTT then exit; + inc(yr); + if yr > 5 then + begin + ResComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + fr := true; + ResultFileC(FileName, yr, 5); +end; + +procedure ResFileString(FileName: string); +begin + if CheckTT then exit; + inc(yr); + if yr > 5 then + begin + ResComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + var w := 0; + try + var f: file of ShortString; + Reset(f, FileName); + while not EOF(f) do + begin + var a: ShortString; + read(f, a); + if Length(a) > w then + w := Length(a); + end; + Close(f); + except + on ex: Exception do + begin + ResComm('\B'+ErrorMessage('FileError(' + FileName + '): ' + ex.Message)+'\b'); + exit; + end; + end; + fr := true; + ResultFileS(FileName, yr, w + 4); +end; + +procedure ResText(FileName: string; LineCount: integer); +begin + if CheckTT then exit; + inc(yr); + if yr > 5 then + begin + ResComm('\B'+ErrorMessage(ErrMes1)+'\b'); + exit; + end; + fr := true; + var yr2 := yr + LineCount - 1; + if yr2 > 5 then yr2 := 5; + ResultFileT(FileName, yr, yr2); + yr := yr2; +end; + +end. \ No newline at end of file diff --git a/TestSuite/exceptions4.pas b/TestSuite/exceptions4.pas new file mode 100644 index 000000000..a801bfceb --- /dev/null +++ b/TestSuite/exceptions4.pas @@ -0,0 +1,64 @@ +var i: integer; + +procedure test; +begin + try + raise new Exception; + finally + i := 1; + end; +end; + +procedure test2; +begin + try + + finally + i := 3; + end; +end; + +procedure test3; +begin + try + while true do + try + raise new Exception; + finally + i := 4; + end; + except + end; +end; + +procedure test4; +begin + try + raise new Exception + finally + try + raise new System.NotSupportedException; + except + i := 5; + end; + end; + i := 6; +end; + +begin + try + test; + except + Inc(i); + end; + assert(i = 2); + test2; + assert(i = 3); + test3; + assert(i = 4); + try + test4; + except + end; + assert(i = 5); +end. \ No newline at end of file diff --git a/TreeConverter/TreeConversion/syntax_tree_visitor.cs b/TreeConverter/TreeConversion/syntax_tree_visitor.cs index b2c53e295..825d15d69 100644 --- a/TreeConverter/TreeConversion/syntax_tree_visitor.cs +++ b/TreeConverter/TreeConversion/syntax_tree_visitor.cs @@ -1881,18 +1881,19 @@ namespace PascalABCCompiler.TreeConverter statement_node finally_stmt = convert_strong(try_hndlr_finally.stmt_list); context.leave_code_block(); stm.statements.AddElement(finally_stmt); + basic_function_call bfc = new basic_function_call(SystemLibrary.SystemLibrary.bool_not as basic_function_node,null); bfc.parameters.AddElement(new local_block_variable_reference(tmp_var,null)); stm.statements.AddElement(new if_node(bfc,new rethrow_statement_node(null),null,null)); exception_filter ef = new exception_filter(filter_type, lvr, stm, null); - efl.AddElement(ef); + //efl.AddElement(ef); bfc = new basic_function_call(SystemLibrary.SystemLibrary.bool_assign as basic_function_node,null); bfc.parameters.AddElement(new local_block_variable_reference(tmp_var,null)); bfc.parameters.AddElement(new bool_const_node(true,null)); - (try_statements as statements_list).statements.AddElement(bfc); - (try_statements as statements_list).statements.AddElement(new throw_statement_node(current_catch_excep,null)); - return_value(new try_block(try_statements, null, efl, loc)); + //(try_statements as statements_list).statements.AddElement(bfc); + //(try_statements as statements_list).statements.AddElement(new throw_statement_node(current_catch_excep,null)); + return_value(new try_block(try_statements, finally_stmt, efl, loc)); context.leave_exception_handlers(); return; }