administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix #1413

Browse source
This commit is contained in:
miks1965 2018-11-08 00:24:28 +03:00
parent a65c2a0017
commit c770e3f464
16 changed files with 6504 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "4";
public const string Build = "2";
public const string Revision = "1857";
public const string Revision = "1859";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

2
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=2
%REVISION%=1857
%REVISION%=1859
%MINOR%=4
%MAJOR%=3

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.4.2.1857'
!define VERSION '3.4.2.1859'

2
SyntaxTree/tree/Tree.cs
View file

@ -3600,7 +3600,7 @@ namespace PascalABCCompiler.SyntaxTree
///<summary>
///Описание переменных одной строкой. Не содержит var, т.к. встречается исключительно внутри другой конструкции.Может встречаться как до beginа (внутри variable_definitions), так и как внутриблочное описание (внутри var_statement).
///Описание переменных одной строкой. Не содержит var, т.к. встречается исключительно внутри другой конструкции. Может встречаться как до beginа (внутри variable_definitions), так и как внутриблочное описание (внутри var_statement).
///</summary>
[Serializable]

2
SyntaxTree/tree/tree.xml
View file

@ -4525,7 +4525,7 @@
<HelpData Key="var_def_list.vars" Value="" />
<HelpData Key="var_def_list_for_record" Value="" />
<HelpData Key="var_def_list_for_record.vars" Value="" />
<HelpData Key="var_def_statement" Value="Описание переменных одной строкой. Не содержит var, т.к. встречается исключительно внутри другой конструкции.Может встречаться как до beginа (внутри variable_definitions), так и как внутриблочное описание (внутри var_statement).&#xD;&#xA;" />
<HelpData Key="var_def_statement" Value="Описание переменных одной строкой. Не содержит var, т.к. встречается исключительно внутри другой конструкции. Может встречаться как до beginа (внутри variable_definitions), так и как внутриблочное описание (внутри var_statement).&#xD;&#xA;" />
<HelpData Key="var_def_statement." Value="" />
<HelpData Key="var_def_statement.field_attr" Value="" />
<HelpData Key="var_def_statement.inital_value" Value="Начальное значение переменных" />

6
SyntaxTreeConverters/StandardSyntaxConverter.cs
View file

@ -66,11 +66,11 @@ namespace PascalABCCompiler.SyntaxTreeConverters
//new SimplePrettyPrinterVisitor("D:\\Tree.txt").ProcessNode(root);
//FillParentNodeVisitor.New.ProcessNode(root);
/*var cv = CollectLightSymInfoVisitor.New;
cv.ProcessNode(root);
cv.Output(@"Light1.txt");*/
/*try
{
//root.visit(new SimplePrettyPrinterVisitor(@"d:\\zzz4.txt"));
@ -80,7 +80,7 @@ namespace PascalABCCompiler.SyntaxTreeConverters
System.IO.File.AppendAllText(@"d:\\zzz4.txt",e.Message);
}*/
#endif
return root;

51
SyntaxVisitors/YieldVisitors/RenameSameBlockLocalVarsVisitor.cs
View file

@ -105,7 +105,36 @@ namespace SyntaxVisitors
--CurrentLevel;
}
public override void visit(var_statement vs)
public override void visit(var_def_statement var_def)
{
if (var_def.vars.idents.Any(id => id.name.StartsWith("$")))
{
base.visit(var_def); // SSM 17/07/16 исправление ошибки - не обходилось выражение-инициализатор
return;
}
var newLocalNames = var_def.vars.idents.Select(id =>
{
var low = id.name
//.ToLower()
;
var newName = this.CreateNewVariableName(low);
//BlockNamesStack[CurrentLevel].Add(low, newName);
BlockNamesStack[CurrentLevel][low] = newName;
return new ident(newName, id.source_context);
});
var newVS = new var_def_statement(new ident_list(newLocalNames.ToArray()),
var_def.vars_type,
var_def.inital_value);
Replace(var_def, newVS);
listNodes[listNodes.Count - 1] = newVS; //SSM 8.11.18
base.visit(newVS);
}
/*public override void visit(var_statement vs)
{
if (vs.var_def.vars.idents.Any(id => id.name.StartsWith("$")))
{
@ -113,15 +142,17 @@ namespace SyntaxVisitors
return;
}
var newLocalNames = vs.var_def.vars.idents.Select(id =>
{
var low = id.name/*.ToLower()*/;
var newLocalNames = vs.var_def.vars.idents.Select(id =>
{
var low = id.name
//.ToLower()
;
var newName = this.CreateNewVariableName(low);
//BlockNamesStack[CurrentLevel].Add(low, newName);
BlockNamesStack[CurrentLevel][low] = newName;
return new ident(newName, id.source_context);
});
var newName = this.CreateNewVariableName(low);
//BlockNamesStack[CurrentLevel].Add(low, newName);
BlockNamesStack[CurrentLevel][low] = newName;
return new ident(newName, id.source_context);
});
var newVS = new var_statement(new var_def_statement(new ident_list(newLocalNames.ToArray()),
vs.var_def.vars_type,
@ -130,7 +161,7 @@ namespace SyntaxVisitors
Replace(vs, newVS);
base.visit(newVS);
}
}/* */
public override void visit(variable_definitions vd)
{

471
TestSuite/CompilationSamples/ABCDatabases.pas Normal file
View file

@ -0,0 +1,471 @@
unit ABCDatabases;
//uses PrintAttributeUnit;
function PrintAttributeString(a: object): string; forward;
function PrintAttributeString(a: object; fProvider: System.IFormatProvider): string; forward;
type
Country = auto class
_name, _capital: string;
_population: integer;
_continent: string;
public
[PrintAttribute(0, -32)]
property Название: string read _name;
[PrintAttribute(0, -32)]
property Name: string read _name;
[PrintAttribute(' ', 1, -19)]
property Столица: string read _capital;
[PrintAttribute(' ', 1, -19)]
property Capital: string read _capital;
[PrintAttribute(3, 13, 'd')]
property Население: integer read _population;
[PrintAttribute(3, 13, 'd')]
property Population: integer read _population;
[PrintAttribute(' ', 2, -9)]
property Континент: string read _continent;
[PrintAttribute(' ', 2, -9)]
property Continent: string read _continent;
end;
ТипПола = (Муж, Жен);
Pupil = auto class
_name: string;
_gender: boolean;
_height: integer;
_cls: integer;
_inSunSchool: boolean;
function getGender: ТипПола := _gender ? Муж : Жен;
public
[PrintAttribute(0, -16)]
property Name: string read _name;
[PrintAttribute(0, -16)]
property Фамилия: string read _name;
[PrintAttribute(' ', 1, -3)]
property Gender: ТипПола read getGender;
[PrintAttribute(' ', 1, -3)]
property Пол: ТипПола read getGender;
[PrintAttribute(' ', 2, 3, 'd')]
property Height: integer read _height;
[PrintAttribute(' ', 2, 3, 'd')]
property Рост: integer read _height;
[PrintAttribute(' ',3, 2, 'd')]
property Cls: integer read _cls;
[PrintAttribute(' ',3, 2, 'd')]
property Класс: integer read _cls;
[PrintAttribute(' ', 4, -5)]
property InSunSchool: boolean read _inSunSchool;
[PrintAttribute(' ', 4, -5)]
property УчитсяВКШ: boolean read _inSunSchool;
end;
function GenderToBoolean(a: string): boolean := a = 'Муж';
function InSunSchoolToBoolean(a: string): boolean := a = 'Да';
type
Fitness = auto class
private
_code, _year, _month, _time: integer;
public
[PrintAttribute('( Code = ', 0, 2)]
property Код: integer read _code;
[PrintAttribute('( Code = ', 0, 2)]
property Code: integer read _code;
[PrintAttribute(' , Year = ', 1, 4)]
property Год: integer read _year;
[PrintAttribute(' , Year = ', 1, 4)]
property Year: integer read _year;
[PrintAttribute(' , Month = ', 2, 2)]
property Месяц: integer read _month;
[PrintAttribute(' , Month = ', 2, 2)]
property Month: integer read _month;
[PrintAttribute(' , Time = ', 3, 2)]
property Время: integer read _time;
[PrintAttribute(' , Time = ', 3, 2)]
property Time: integer read _time;
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
Abitur = auto class
private
_name: string;
_year: integer;
_school: integer;
public
[PrintAttribute('( Name = ', 0, -11)]
property Фамилия: string read _name;
[PrintAttribute('( Name = ', 0, -11)]
property Name: string read _name;
[PrintAttribute(', Year = ', 1, 4)]
property Год: integer read _year;
[PrintAttribute(', Year = ', 1, 4)]
property Year: integer read _year;
[PrintAttribute(' , School = ', 2, 2)]
property Школа: integer read _school;
[PrintAttribute(' , School = ', 2, 2)]
property School: integer read _school;
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
Debtor = auto class
private
_name: string;
_flat: integer;
_debt: real;
public
[PrintAttribute('( Name = ', 0, -11)]
property Фамилия: string read _name;
[PrintAttribute('( Name = ', 0, -11)]
property Name: string read _name;
[PrintAttribute(', Flat = ', 1, 3)]
property Квартира: integer read _flat;
[PrintAttribute(', Flat = ', 1, 3)]
property Flat: integer read _flat;
[PrintAttribute(' , Debt = ', 2, 7, 'f2')]
property Долг: real read _debt;
[PrintAttribute(' , Debt = ', 2, 7, 'f2')]
property Debt: real read _debt;
[PrintAttribute(' , Entrance = ', 3, 1)]
property Подъезд: integer read (_flat - 1) div 36 + 1;
[PrintAttribute(' , Entrance = ', 3, 1)]
property Entrance: integer read (_flat - 1) div 36 + 1;
[PrintAttribute(' , Floor = ', 4, 1)]
property Этаж: integer read (_flat - 1) mod 36 div 4 + 1;
[PrintAttribute(' , Floor = ', 4, 1)]
property Floor: integer read (_flat - 1) mod 36 div 4 + 1;
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
FuelStation = auto class
private
_brand, _price: integer;
_company, _street: string;
public
[PrintAttribute('( Brand = ', 0, 2)]
property Марка: integer read _brand;
[PrintAttribute('( Brand = ', 0, 2)]
property Brand: integer read _brand;
[PrintAttribute(', Price = ', 1, 4)]
property Цена: integer read _price;
[PrintAttribute(', Price = ', 1, 4)]
property Price: integer read _price;
[PrintAttribute(', Company = ', 2, -12)]
property Компания: string read _company;
[PrintAttribute(', Company = ', 2, -12)]
property Company: string read _company;
[PrintAttribute(', Street = ', 3, -15)]
property Улица: string read _street;
[PrintAttribute(', Street = ', 3, -15)]
property Street: string read _street;
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
PupilExam = auto class
private
_name: string;
_school, _point0, _point1, _point2: integer;
[PrintAttribute(' , Point : ', 2, 3)]
property Балл0: integer read _point0;
[PrintAttribute(' , Point : ', 2, 3)]
property Point0: integer read _point0;
[PrintAttribute(' , ', 3, 3)]
property Балл1: integer read _point1;
[PrintAttribute(' , ', 3, 3)]
property Point1: integer read _point1;
[PrintAttribute(' , ', 4, 3)]
property Балл2: integer read _point2;
[PrintAttribute(' , ', 4, 3)]
property Point2: integer read _point2;
public
[PrintAttribute('( Name = ', 0, -16)]
property ФИО: string read _name;
[PrintAttribute('( Name = ', 0, -16)]
property Name: string read _name;
[PrintAttribute(', School = ', 1, 2)]
property Школа: integer read _school;
[PrintAttribute(', School = ', 1, 2)]
property School: integer read _school;
property Балл: array of integer read Arr(_point0, _point1, _point2);
property Point: array of integer read Arr(_point0, _point1, _point2);
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
PupilMark = auto class
private
_name: string;
_cls: integer;
_subject: string;
_mark: integer;
public
[PrintAttribute('( Name = ', 0, -16)]
property ФИО: string read _name;
[PrintAttribute('( Name = ', 0, -16)]
property Name: string read _name;
[PrintAttribute(', Cls = ', 1, 2)]
property Класс: integer read _cls;
[PrintAttribute(', Cls = ', 1, 2)]
property Cls: integer read _cls;
[PrintAttribute(' , Subject = ', 2, -11)]
property Предмет: string read _subject;
[PrintAttribute(' , Subject = ', 2, -11)]
property Subject: string read _subject;
[PrintAttribute(' , Mark = ', 3, 1)]
property Оценка: integer read _mark;
[PrintAttribute(' , Mark = ', 3, 1)]
property Mark: integer read _mark;
function ToString: string; override;
begin
result := PrintAttributeString(self);
end;
end;
function ЗаполнитьМассивСтран: array of Country;
begin
var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Страны.csv';
if fname = '' then
raise new System.ApplicationException('Не найден массив стран Databases\Страны.csv');
Result := ReadLines(fname)
.Select(s->s.ToWords(';'))
.Select(w->new Country(w[0],w[1],w[2].ToInteger,w[3])).ToArray;
end;
function GetCountries: array of Country := ЗаполнитьМассивСтран;
function ЗаполнитьМассивУчеников: array of Pupil;
begin
var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Ученики.csv';
if fname = '' then
raise new System.ApplicationException('Не найден массив учеников Databases\Ученики.csv');
Result := ReadLines(fname)
.Select(s->s.ToWords(';'))
.Select(w->new Pupil(w[0],GenderToBoolean(w[2]),w[4].ToInteger,w[1].ToInteger,
InSunschoolToBoolean(w[3]))).ToArray;
end;
function GetPupils: array of Pupil := ЗаполнитьМассивУчеников;
function GetFitness: array of Fitness;
begin
var fname := 'Fitness.tst';
if not FileExists(fname) then
begin
fname := 'Fitness.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Fitness');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new Fitness(w[0].ToInteger,w[1].ToInteger,w[2].ToInteger,w[3].ToInteger)).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов Fitness содержит неверные данные');
end;
end;
function GetAbiturs: array of Abitur;
begin
var fname := 'Abitur.tst';
if not FileExists(fname) then
begin
fname := 'Abitur.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Abitur');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new Abitur(w[0],w[1].ToInteger,w[2].ToInteger)).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов Abitur содержит неверные данные');
end;
end;
function GetDebtors: array of Debtor;
begin
var fname := 'Debtor.tst';
if not FileExists(fname) then
begin
fname := 'Debtor.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Debtor');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new Debtor(w[0],w[1].ToInteger,w[2].ToReal)).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов Debtor содержит неверные данные');
end;
end;
function GetFuelStations: array of FuelStation;
begin
var fname := 'FuelStation.tst';
if not FileExists(fname) then
begin
fname := 'FuelStation.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов FuelStation');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new FuelStation(w[0].ToInteger,w[1].ToInteger,w[2],w[3])).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов FuelStation содержит неверные данные');
end;
end;
function GetPupilExams: array of PupilExam;
begin
var fname := 'PupilExam.tst';
if not FileExists(fname) then
begin
fname := 'PupilExam.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов PupilExam');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new PupilExam(w[0],w[1].ToInteger,w[2].ToInteger,w[3].ToInteger,w[4].ToInteger)).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов PupilExam содержит неверные данные');
end;
end;
function GetPupilMarks: array of PupilMark;
begin
var fname := 'PupilMark.tst';
if not FileExists(fname) then
begin
fname := 'PupilMark.txt';
if not FileExists(fname) then
raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов PupilMark');
end;
try
Result := ReadLines(fname)
.Select(s->s.ToWords(','))
.Select(w->new PupilMark(w[0],w[1].ToInteger,w[2],w[3].ToInteger)).ToArray;
except
raise new System.FormatException('Файл-источник для массива объектов PupilMark содержит неверные данные');
end;
end;
function PrintAttributeString(a: object; fProvider: System.IFormatProvider): string;
begin
var t := a.GetType();
var res := new Dictionary<integer, string>();
foreach var p in t.GetProperties(System.Reflection.BindingFlags.Public
or System.Reflection.BindingFlags.NonPublic or System.Reflection.BindingFlags.Instance) do
begin
var att := p.GetCustomAttribute(typeof(PrintAttribute), false) as PrintAttribute;
if att = nil then
continue;
var (c, n, w, f) := (att.Comment, att.Num, att.Width, att.Fmt);
var val := '';
var o := p.GetValue(a, nil);
if (f <> '') and (o is System.IFormattable) then
begin
val := System.IFormattable(o).ToString(f, fProvider);
end
else
begin
val := o.ToString;
end;
if w > 0 then
val := val.PadLeft(w)
else if w < 0 then
val := val.PadRight(-w);
res[n] := c + val;
end;
result := nil;
if res.Keys.Count = 0 then
exit;
result := '';
foreach var k in res.Keys.OrderBy(e -> e) do
begin
result += res[k];
end;
var delim := Copy(result, 2, 1);
if result.StartsWith('{') then
result += (delim = ' ') ? ' }' : '}'
else if result.StartsWith('[') then
result += (delim = ' ') ? ' ]' : ']'
else if result.StartsWith('(') then
result += (delim = ' ') ? ' )' : ')'
else if result.StartsWith('''') then
result += (delim = ' ') ? ' ''' : ''''
else if result.StartsWith('"') then
result += (delim = ' ') ? ' "' : '"';
end;
function PrintAttributeString(a: object): string;
begin
result := PrintAttributeString(a, nil);
end;
function ToStr(params a: array of object): string;
begin
result := '';
var b := false;
foreach var e in a do
begin
if b then
result += ' '
else
b := true;
if e is real then
result += real(e).ToString(2)
else if e is string then
result += e.ToString()
else if e.GetType.FullName.StartsWith('System.Tuple') then
begin
var b1 := false;
foreach var e1 in e.GetType.GetProperties do
begin
if b1 then
result += ' '
else
b1 := true;
result += ToStr(Arr(e1.GetValue(e,nil)));
end;
end
else if e is System.Collections.IEnumerable then
begin
var b1 := false;
var e1 := (e as System.Collections.IEnumerable).GetEnumerator;
while e1.MoveNext do
begin
if b1 then
result += ' '
else
b1 := true;
result += ToStr(Arr(e1.Current));
end;
end
else
result += e.ToString();
end;
end;
begin
end.

783
TestSuite/CompilationSamples/BlockFileOfT.pas Normal file
View file

@ -0,0 +1,783 @@
(************************************************************************************)
// Copyright (©) Cergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// This code is distributed under the Unlicense
// For details please see LICENSE.md or here:
// https://github.com/SunSerega/PascalABC.Net-BlockFileOfT/blob/master/LICENSE.md
(************************************************************************************)
// Copyright (©) Сергей латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// Этот код распространяется под Unlicense
// Для деталей смотрите в файл LICENSE.md или сюда:
// https://github.com/SunSerega/PascalABC.Net-BlockFileOfT/blob/master/LICENSE.md
(************************************************************************************)
///Модуль содержащий тип BlockFileOf<T>
///Этот тип - альтернатива стандартному file of T
///Основное преимущество - скорость работы
unit BlockFileOfT;
interface
uses System.Runtime.InteropServices;
uses System.IO;
type
///--
BlockFileBase = abstract class
protected fi:FileInfo;
protected _offset:int64;
protected str:FileStream;
protected bw:BinaryWriter;
protected br:BinaryReader;
protected linked := new List<BlockFileBase>;
protected procedure Link(f:BlockFileBase);
protected procedure UnLink;
private class function MessageBox(wnd: System.IntPtr; message, caption: string; flags: cardinal):integer;
external 'User32.dll';
end;
///Тип, записывающий данные в файл по принципу схожему с "file of <T>"
///Но в отличии от "file of <T>" - данный тип сохраняет всю запись одним блоком,
///так, как она записа в памяти.
///Это даёт значительное преимущество по скорости, но ограничевает,
///типы, которые могут быть использованы в виде полей <T>
///
///Ожидается, что в видет шаблонного параметра <T> будет передана запись,
///не содержащая динамичных полей.
///Иначе целостность данных будет терятся
///Это значит, что поля записи T и всех вложенных записей - НЕ могут быть:
/// -Указатели
/// -Ссылочных типов (то есть классами)
/// -Особых типов, которые .Net считает "опасными". Как char или System.DateTime
///Но эти ограничения можно обойти, про это в справке
BlockFileOf<T>=class(BlockFileBase)
private class sz: integer;
private class procedure TestForRefT(tt: System.Type);
begin
if tt.IsClass then
begin
MessageBox(new System.IntPtr(nil),
$'Тип {tt} ссылочный.{#10}Ссылочные типы нельзя сохранять в типизированный файл.{#10}Нажмите OK для выхода.',
$'Тип T из BlockFileOf<T> содержет ссылочные типы',
$10
);
Halt(-1);
end;
foreach var fi in
tt.GetFields(
System.Reflection.BindingFlags.GetField or
System.Reflection.BindingFlags.Instance or
System.Reflection.BindingFlags.Public or
System.Reflection.BindingFlags.NonPublic
) do
if not fi.IsLiteral then
if fi.FieldType <> tt then//integer имеет поле типа integer, без этой строчки StackOwerflow
TestForRefT(fi.FieldType);
end;
private class constructor :=
try
TestForRefT(typeof(T));
(*
try
var a := new T[0];
GCHandle.Alloc(a,GCHandleType.Pinned).Free;
except
on e: System.ArgumentException do
begin
MessageBox(new System.IntPtr(nil),
$'.Net не принимает какой то из типов полей записи, для которой вы создали BlockFileOf<T>{#10}Говорит - его нельзя превратить в набор байт{#10}Нажмите OK для выхода.',
$'Тип T содержет ссылочные типы',
$10
);
Halt(-1);
end;
end;
(**)
sz := Marshal.SizeOf(typeof(T));
except
on e:Exception do
begin
MessageBox(new System.IntPtr(nil),
e.ToString,
$'При инициализации BlockFileOf<{typeof(T)}> произошла ошибка',
$10
);
Halt(-1);
end;
end;
private function GetName:string;
private function GetFullName:string;
private function GetExists:boolean;
private function GetFileSize:int64 := (GetByteFileSize - _offset) div sz;
private procedure SetFileSize(size:int64) := SetByteFileSize(_offset + size*sz);
private function GetByteFileSize:int64;
private procedure SetByteFileSize(size:int64);
private function GetPos:int64 := (GetPosByte-_offset) div sz;
private procedure SetPos(pos:int64) := SetPosByte(_offset + pos*sz);
private function GetPosByte:int64;
private procedure SetPosByte(pos:int64);
private function InternalReadLazy(c:integer; start_pos:int64):sequence of T;
///Инициализирует переменную файла, не привязывая её к файлу на диске
public constructor := exit;
///Инициализирует переменную файла, привязывая её к файлу fname
public constructor(fname:string) :=
Assign(fname);
///Инициализирует переменную файла, привязывая её к файлу fname
///А так же устанавливая значение смещени от начала в байтах на offset
public constructor(fname:string; offset:int64) :=
Assign(fname, offset);
///- constructor BlockFileOf<>(f:BlockFileOf<>);
///Инициализирует новую переменную, создавая связку данной переменной
///После вызова этого конструктора - переданная и созданная переменная будут
///использовать общий файловый поток, но записывать разные типы данных (у них может быть разный T)
///Это значит, что переменная которую передали в конструктор должно уже иметь открытый файловый поток
///Метод Close разрывает эту связь.
public constructor(f: BlockFileBase) :=
Link(f);
///Размер блока из одного элемента типа T, в байтах
///Хоть это свойство и можно перезаписывать, но это не рекомендуется
///Если перезаписать на число, большее чем было - в файл будет сохранять лишние нули
///А если на меньшее - получите неопределённое поведение (скорее всего вылет, но далеко не сразу)
public property TSize:integer read integer(sz) write sz := value;
///Смещение от начала файла до начала элементов (в байтах)
public property Offset:int64 read _offset write _offset;
///Количество сохранённых в файл элементов типа T
///Чтоб установить длину файла - надо открыть файл. Но прочитать длину можно не открывая
public property Size:int64 read GetFileSize write SetFileSize;
///Полный размер файла, в байтах
///Чтоб установить длину файла - надо открыть файл. Но прочитать длину можно не открывая
public property ByteSize:int64 read GetByteFileSize write SetByteFileSize;
///Имя файла (только имя самого файла, без имени папки)
public property Name:string read GetName;
///Полное имя файла (вместе с именами всех под-папок, вплодь до корня диска)
public property FullName:string read GetFullName;
///Существует ли файл
public property Exists:boolean read GetExists;
///Номер текущего элемета типа T в файле (нумеруя с 0)
public property Pos:int64 read GetPos write SetPos;
///Номер текущего байта от начала файла (нумеруя с 0)
public property PosByte:int64 read GetPosByte write SetPosByte;
///Привязана ли переменная к файлу
public property Assigned:boolean read fi <> nil;
///Открыт ли файл
public property Opened:boolean read str <> nil;
///Достигнут ли конец файла
public property EOF:boolean read ByteSize-PosByte < sz;
///Основной поток открытого файла (или nil если файл не открыт)
///Внимание! Любое действие которое изменит этот поток - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BaseStream:FileStream read str;
///Переменная, которая записывает данные в основной поток (или nil если файл не открыт)
///Внимание! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BinWriter:BinaryWriter read bw;
///Переменная, которая читает данные из основного потока (или nil если файл не открыт)
///Внимание! Любое действие которое изменит основной поток файла - приведёт к неожиданным последствиям, используйте его только если знаете что делаете
public property BinReader:BinaryReader read br;
///Переменная, показывающая данные о файле (или nil, если переменная не привязана к файлу)
public property FileInfo:System.IO.FileInfo read fi;
///Привязывает данную переменную к файлу {fname}
///Привязывать можно и к не существующим файлам, при откритии определёнными способами (как Rewrite) новый файл будет создан
public procedure Assign(fname:string);
///Привязывает данную переменную к файлу {fname}
///А так же устанавливая значение смещени от начала в байтах на offset
///Привязывать можно и к не существующим файлам, при откритии определёнными способами (как Rewrite) новый файл будет создан
public procedure Assign(fname:string; offset:int64);
///Убирает свять переменной и файла, если связь есть
public procedure UnAssign;
///Открывает файл, способом описанным в переменной mode
///Чтоб получить переменную этого типа - пишите System.IO.FileMode.<способ_открытия_файла>
public procedure Open(mode:FileMode);
///Удаляет связаный файл, если он существует
public procedure Delete;
///Переименовывает файл
///Если указать другое расположение - файл будет перемещён
public procedure Rename(NewName:string);
///Создает (или обнуляет) привязаный файл
public procedure Rewrite;
///Привязывает данную переменную к файлу {fname} и создает (или обнуляет) этот файл
public procedure Rewrite(fname:string);
///Привязывает данную переменную к файлу {fname} и создает (или обнуляет) этот файл
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Rewrite(fname:string; offset:int64);
///Открывает файл (ожидается, что он уже существует) и устанавливает позицию на начало файла
public procedure Reset;
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию на начало файла
public procedure Reset(fname:string);
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию на начало файла
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Reset(fname:string; offset:int64);
///Открывает файл (ожидается, что он уже существует) и устанавливает позицию в конце файла
public procedure Append;
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию в конце файла
public procedure Append(fname:string);
///Привязывает данную переменную к файлу {fname}, открывает этот файл (ожидается, что файл уже существует) и устанавливает позицию в конце файла
///А так же устанавливая значение смещени от начала в байтах на offset
public procedure Append(fname:string; offset:int64);
///Переставляет позицию в файле на элемент #pos (нумеруя с 0)
public procedure Seek(pos:int64) := self.Pos := pos;
///Переставляет файловый курсор на байт #pos (нумеруя с 0) от начала файла
public procedure SeekByte(pos:int64) := self.PosByte := pos;
///Записывает все изменения в файл и отчищает внутренние буферы
///До вызова Flush или Close - все изменения и кеш хранятся в оперативной памяти
///Поэтому, если вы записываете/читаете много (сотни мегабайт) - лучше вызывать Flush время от времени
public procedure Flush;
///Сохраняет и закрывает файл, если он открыт
public procedure Close;
///Записывает один элемент одним блоком в файл
///И переставляет файловый курсор на 1 элемет вперёд
public procedure Write(o: T);
///Записывает массив элементов одним блоком в файл
///И переставляет файловый курсор на o.Length элеметов вперёд
public procedure Write(params o:array of T);
///Записывает последовательность элементов, у которой можно узнать длину, одним блоком в файл
///И переставляет файловый курсор на o.Count элеметов вперёд
public procedure Write(o:ICollection<T>);
///Записывает последовательность элементов, у которой нельзя узнать длину, по 1 элементу типа T в файл
///И переставляет файловый курсор на o.Count элеметов вперёд
public procedure Write(o:sequence of T);
///Записывает count элементов массива, начиная с элемента #from, одним блоком в файл
///И переставляет файловый курсор на сount элеметов вперёд
public procedure Write(o:array of T; from,count:integer);
///Записывает count элементов последовательности, у которой можно узнать длину, начиная с элемента #from, одним блоком в файл
///И переставляет файловый курсор на сount элеметов вперёд
public procedure Write(o:ICollection<T>; from,count:integer);
///Записывает count элементов последовательности, у которой нельзя узнать длину, начиная с элемента #from, одним блоком в файл
///И после каждого элемента переставляет файловый курсор на 1 элемет вперёд
public procedure Write(o:sequence of T; from,count:integer);
///Читает один элемент из файла одним блоком
///И переставляет файловый курсор на 1 элемет вперёд
public function Read:T;
///Читает массив из count одним блоком
///И переставляет файловый курсор на count элеметов вперёд
public function Read(count:integer):array of T;
///Читает массив из count элементов одним блоком, начиная с элемента #start_elm
///И переставляет файловый курсор на count элеметов вперёд
public function Read(start_elm, count:integer):array of T;
///Возвращает ленивую последовательность из count элементов
///После завершения чтения - курсор окажется на эдлементе #(start_elm+count)
///Каждый раз читать будет начиная с элемента, на котором сейчас стоит файловый курсор
public function ReadLazy(count:integer):sequence of T := InternalReadLazy(count, PosByte);
///Возвращает ленивую последовательность из count элементов, начиная с элемента #start_elm
///После прочтения i элементов последовательности - позиция в файле будет передвигаться на элемент #(start_elm+i)
///Каждый раз читать будет начиная с элемента #start_elm
public function ReadLazy(start_elm, count:integer):sequence of T := InternalReadLazy(count, _offset + start_elm*sz);
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит столько элементов - чтоб не превышать объём в 4096 байт (4КБ)
///После прочтения каждого блока - файловый корсор будет переставлен на его конец
public function ToSeqBlocks:sequence of array of T := ToSeqBlocks(4096);
///Возвращает ленивую последовательность из блоков-массивов с элементами типа T
///Каждый блок хранит столько элементов - чтоб не превышать объём в последовательность байт
///После прочтения каждого блока - файловый корсор будет переставлен на его конец
public function ToSeqBlocks(blocks_size:integer):sequence of array of T;
///Возвращает ленивую последовательность из всех элементов хранящихся в файле
///После прочтения i элементов последовательности - позиция в файле будет передвигаться на элемент #i
public function ToSeq:sequence of T;
protected procedure Finalize; override;
begin
Close;
end;
end;
{$region Exception's}
type
FileNotAssignedException = class(Exception)
constructor :=
inherited Create($'Данная переменная не была привязана к файлу{10}Используйте метод Assign');
end;
FileNotOpenedException = class(Exception)
constructor(fname:string) :=
inherited Create($'Файл {fname} ещё не открыт, откройте его с помощью Open, Reset, Append или Rewrite');
end;
FileNotClosedException = class(Exception)
constructor(fname:string) :=
inherited Create($'Файл {fname} ещё открыт, закройте его методом Close перед тем как продолжать');
end;
CannotReadAfterEOF = class(Exception)
constructor :=
inherited Create($'Нельзя читать за пределами файла. Можно только записывать');
end;
{$endregion Exception's}
implementation
{$region Linking}
procedure BlockFileBase.Link(f:BlockFileBase);
begin
if f.str = nil then raise new FileNotOpenedException($'{f.fi.FullName}, чью переменную передали в конструктор BlockFileOf<T>,');
foreach var l in f.linked + f do
begin
self.linked.Add(l);
l.linked.Add(self);
end;
self.str := f.str;
self.br := f.br;
self.bw := f.bw;
self.fi := new FileInfo(f.fi.FullName);
end;
procedure BlockFileBase.UnLink;
begin
foreach var l in self.linked do
l.linked.Remove(self);
self.linked.Clear;
end;
{$endregion Linking}
{$region property implementation}
function BlockFileOf<T>.GetName:string;
begin
if fi = nil then raise new FileNotAssignedException;
fi.Refresh;
Result := fi.Name;
end;
function BlockFileOf<T>.GetFullName:string;
begin
if fi = nil then raise new FileNotAssignedException;
//fi.Refresh;//А тут не надо
Result := fi.FullName;
end;
function BlockFileOf<T>.GetByteFileSize:int64;
begin
if fi = nil then raise new FileNotAssignedException;
if str <> nil then
begin
Result := str.Length;
exit;
end;
fi.Refresh;
Result := fi.Length;
end;
procedure BlockFileOf<T>.SetByteFileSize(size:int64);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
str.SetLength(size);
end;
function BlockFileOf<T>.GetPosByte:int64;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
Result := str.Position;
end;
procedure BlockFileOf<T>.SetPosByte(pos:int64);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
str.Position := pos;
end;
{$endregion property implementation}
{$region Setup IO}
{$region Basic}
procedure BlockFileOf<T>.Assign(fname:string);
begin
if str <> nil then raise new FileNotClosedException(fi.FullName);
fi := new System.IO.FileInfo(fname);
end;
procedure BlockFileOf<T>.Assign(fname:string; offset:int64);
begin
Assign(fname);
_offset := offset;
end;
procedure BlockFileOf<T>.UnAssign;
begin
if str <> nil then raise new FileNotClosedException(fi.FullName);
fi := nil;
end;
procedure BlockFileOf<T>.Open(mode:FileMode);
begin
if fi = nil then raise new FileNotAssignedException;
if str <> nil then raise new FileNotClosedException(fi.FullName);
str := fi.Open(mode);
bw := new BinaryWriter(str);
br := new BinaryReader(str);
end;
procedure BlockFileOf<T>.Delete;
begin
if fi = nil then raise new FileNotAssignedException;
fi.Delete;
end;
function BlockFileOf<T>.GetExists:boolean;
begin
if fi = nil then raise new FileNotAssignedException;
fi.Refresh;
Result := fi.Exists;
end;
procedure BlockFileOf<T>.Rename(NewName:string);
begin
if fi = nil then raise new FileNotAssignedException;
if str <> nil then raise new FileNotClosedException(fi.FullName);
fi.MoveTo(NewName);
end;
{$endregion Assign}
{$region Rewrite}
procedure BlockFileOf<T>.Rewrite :=
Open(FileMode.Create);
procedure BlockFileOf<T>.Rewrite(fname:string);
begin
Assign(fname);
Rewrite;
end;
procedure BlockFileOf<T>.Rewrite(fname:string; offset:int64);
begin
Assign(fname, offset);
Rewrite;
end;
{$endregion Rewrite}
{$region Reset}
procedure BlockFileOf<T>.Reset :=
Open(FileMode.Open);
procedure BlockFileOf<T>.Reset(fname:string);
begin
Assign(fname);
Reset;
end;
procedure BlockFileOf<T>.Reset(fname:string; offset:int64);
begin
Assign(fname, offset);
Reset;
end;
{$endregion Reset}
{$region Append}
procedure BlockFileOf<T>.Append :=
Open(FileMode.Append);
procedure BlockFileOf<T>.Append(fname:string);
begin
Assign(fname);
Append;
end;
procedure BlockFileOf<T>.Append(fname:string; offset:int64);
begin
Assign(fname, offset);
Append;
end;
{$endregion Append}
{$region Closing}
procedure BlockFileOf<T>.Flush;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
str.Flush;
end;
procedure BlockFileOf<T>.Close;
begin
if str <> nil then
begin
if linked.Count <> 0 then
UnLink else
str.Close;
str := nil;
br := nil;
bw := nil;
end;
end;
{$endregion Closing}
{$endregion Setup IO}
{$region Write}
procedure BlockFileOf<T>.Write(o: T);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var a := new byte[sz];
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
@o,
gc_hnd.AddrOfPinnedObject.ToPointer,
sz,sz
);
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(params o:array of T);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var bl := sz*o.Length;
var a := new byte[bl];
var gc_hnd1 := GCHandle.Alloc(o, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd1.AddrOfPinnedObject.ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:ICollection<T>);
type TArr = array of T;
begin
if o is TArr(var a) then
begin
Write(a);
exit;
end;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var a := new byte[sz*o.Count];
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
var hnd := gc_hnd.AddrOfPinnedObject;
foreach var el in o do
begin
System.Buffer.MemoryCopy(
@el,
hnd.ToPointer,
sz,sz
);
System.IntPtr.Add(hnd, sz);
end;
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:sequence of T) :=
if o is ICollection<T>(var c) then
Write(c) else
foreach var el in o do
Write(el);
procedure BlockFileOf<T>.Write(o:array of T; from,count:integer);
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var bl := sz*count;
var a := new byte[bl];
var gc_hnd1 := GCHandle.Alloc(o, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
System.IntPtr.Add(gc_hnd1.AddrOfPinnedObject, from * sz).ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:ICollection<T>; from,count:integer);
type TArr = array of T;
begin
if o is TArr(var a) then
begin
Write(a, from, count);
exit;
end;
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
var a := new byte[sz*o.Count];
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
var hnd := gc_hnd.AddrOfPinnedObject;
foreach var el in o do
if from > 0 then from -= 1 else
if count > 0 then
begin
System.Buffer.MemoryCopy(
@el,
hnd.ToPointer,
sz,sz
);
hnd := System.IntPtr.Add(hnd, sz);
count -= 1;
end;
gc_hnd.Free;
bw.Write(a);
end;
procedure BlockFileOf<T>.Write(o:sequence of T; from,count:integer) :=
if o is ICollection<T>(var c) then
Write(c,from,count) else
Write(o.Skip(from).Take(count));
{$endregion Write}
{$region Read}
function BlockFileOf<T>.Read:T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
if str.Length - str.Position < sz then raise new CannotReadAfterEOF;
var a := br.ReadBytes(sz);
var gc_hnd := GCHandle.Alloc(a, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd.AddrOfPinnedObject.ToPointer,
@Result,
sz,sz
);
gc_hnd.Free;
end;
function BlockFileOf<T>.Read(count:integer):array of T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
if str.Length - str.Position < sz*count then raise new CannotReadAfterEOF;
var bl := sz*count;
var a := br.ReadBytes(bl);
Result := new T[count];
var gc_hnd1 := GCHandle.Alloc(a, GCHandleType.Pinned);
var gc_hnd2 := GCHandle.Alloc(Result, GCHandleType.Pinned);
System.Buffer.MemoryCopy(
gc_hnd1.AddrOfPinnedObject.ToPointer,
gc_hnd2.AddrOfPinnedObject.ToPointer,
bl,bl
);
gc_hnd1.Free;
gc_hnd2.Free;
end;
function BlockFileOf<T>.Read(start_elm, count:integer):array of T;
begin
Pos := start_elm;
Result := Read(count);
end;
function BlockFileOf<T>.InternalReadLazy(c:integer; start_pos:int64):sequence of T;
begin
if fi = nil then raise new FileNotAssignedException;
if str = nil then raise new FileNotOpenedException(fi.FullName);
if str.Length - start_pos < sz*c then raise new CannotReadAfterEOF;
for var i := 0 to c-1 do
begin
PosByte := start_pos + i*sz;
yield Read;
end;
end;
function BlockFileOf<T>.ToSeqBlocks(blocks_size:integer):sequence of array of T;
begin
var c := blocks_size div sz;
var i := 0;
while true do
begin
var left := Size - i;
if left < c then
begin
if left > 0 then
begin
Pos := i;
yield Read(left);
end;
exit;
end else
begin
Pos := i;
yield Read(c);
i += c;
end;
end;
end;
function BlockFileOf<T>.ToSeq:sequence of T;
begin
var i := 0;
while not EOF do
begin
Pos := i;
yield Read;
i += 1;
end;
end;
{$endregion Read}
end.

36
TestSuite/CompilationSamples/Countries.pas Normal file
View file

@ -0,0 +1,36 @@
unit Countries;
type
Att = class(System.Attribute)
Num: integer;
constructor (n: integer) := Num := n;
end;
Country = auto class
nm,cap: string;
inh: integer;
cont: string;
public
[Att(1)]
property Название: string read nm;
[Att(2)]
property Столица: string read cap;
[Att(4)]
property Население: integer read inh;
[Att(3)]
property Континент: string read cont;
end;
function ЗаполнитьМассивСтран: array of Country;
begin
var fname := __FindFile('Databases\Страны.csv');
if fname = '' then
raise new System.ApplicationException('Не найден массив стран Databases\Страны.csv');
Result := ReadLines(fname)
.Select(s->s.ToWords(';'))
.Select(w->new Country(w[0],w[1],w[2].ToInteger,w[3])).ToArray;
end;
begin
end.

12
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -8690,7 +8690,7 @@ begin
yield func(x, y)
end;
/// Разбивает последовательности на две в позиции ind
/// Разбивает последовательность на две в позиции ind. Реализуется двухпроходным алгоритмом
function SplitAt<T>(Self: sequence of T; ind: integer): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Take(ind), Self.Skip(ind));
@ -8700,13 +8700,13 @@ end;
// ToDo: SequenceCompare
/// Разделяет последовательности на две по заданному условию
/// Разделяет последовательность на две по заданному условию. Реализуется двухпроходным алгоритмом
function Partition<T>(Self: sequence of T; cond: T->boolean): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Where(cond), Self.Where(x -> not cond(x)));
end;
/// Разделяет последовательности на две по заданному условию, в котором участвует индекс
/// Разделяет последовательность на две по заданному условию, в котором участвует индекс. Реализуется двухпроходным алгоритмом
function Partition<T>(Self: sequence of T; cond: (T,integer)->boolean): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Where(cond), Self.Where((x, i)-> not cond(x, i)));
@ -8742,19 +8742,19 @@ begin
Result := Self.Zip(a, (x, y)-> (x, y)).Zip(b, (p, z)-> (p[0], p[1], z)).Zip(c, (p, z)-> (p[0], p[1], p[2], z));
end;
/// Разъединяет последовательность двухэлементных кортежей на две последовательности
/// Разъединяет последовательность двухэлементных кортежей на две последовательности. Реализуется двухпроходным алгоритмом
function UnZipTuple<T, T1>(Self: sequence of (T, T1)): (sequence of T, sequence of T1); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]))
end;
/// Разъединяет последовательность трехэлементных кортежей на три последовательности
/// Разъединяет последовательность трехэлементных кортежей на три последовательности. Реализуется многопроходным алгоритмом
function UnZipTuple<T, T1, T2>(Self: sequence of (T, T1, T2)): (sequence of T, sequence of T1, sequence of T2); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2]))
end;
/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности
/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности. Реализуется многопроходным алгоритмом
function UnZipTuple<T, T1, T2, T3>(Self: sequence of (T, T1, T2, T3)): (sequence of T, sequence of T1, sequence of T2, sequence of T3); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2]), Self.Select(x -> x[3]))

1367
TestSuite/CompilationSamples/WPFObjects.pas Normal file
View file

File diff suppressed because it is too large Load diff

3764
TestSuite/CompilationSamples/graph3d.pas Normal file
View file

File diff suppressed because it is too large Load diff

12
TestSuite/match_yield1.pas Normal file
View file

@ -0,0 +1,12 @@
function f1: sequence of byte;
begin
match new Object with
integer(var i): yield i;
byte(var i): yield i;
object(var i): yield 66;
end;
end;
begin
Assert(f1.First = 66);
end.

10
TestSuite/yield_autotype.pas Normal file
View file

@ -0,0 +1,10 @@
function f1: sequence of byte;
begin
var ii := 66;
var o := ii;
yield ii;
end;
begin
Assert(f1.First = 66);
end.

12
bin/Lib/PABCSystem.pas
View file

@ -8690,7 +8690,7 @@ begin
yield func(x, y)
end;
/// Разбивает последовательности на две в позиции ind
/// Разбивает последовательность на две в позиции ind. Реализуется двухпроходным алгоритмом
function SplitAt<T>(Self: sequence of T; ind: integer): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Take(ind), Self.Skip(ind));
@ -8700,13 +8700,13 @@ end;
// ToDo: SequenceCompare
/// Разделяет последовательности на две по заданному условию
/// Разделяет последовательность на две по заданному условию. Реализуется двухпроходным алгоритмом
function Partition<T>(Self: sequence of T; cond: T->boolean): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Where(cond), Self.Where(x -> not cond(x)));
end;
/// Разделяет последовательности на две по заданному условию, в котором участвует индекс
/// Разделяет последовательность на две по заданному условию, в котором участвует индекс. Реализуется двухпроходным алгоритмом
function Partition<T>(Self: sequence of T; cond: (T,integer)->boolean): (sequence of T, sequence of T); extensionmethod;
begin
Result := (Self.Where(cond), Self.Where((x, i)-> not cond(x, i)));
@ -8742,19 +8742,19 @@ begin
Result := Self.Zip(a, (x, y)-> (x, y)).Zip(b, (p, z)-> (p[0], p[1], z)).Zip(c, (p, z)-> (p[0], p[1], p[2], z));
end;
/// Разъединяет последовательность двухэлементных кортежей на две последовательности
/// Разъединяет последовательность двухэлементных кортежей на две последовательности. Реализуется двухпроходным алгоритмом
function UnZipTuple<T, T1>(Self: sequence of (T, T1)): (sequence of T, sequence of T1); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]))
end;
/// Разъединяет последовательность трехэлементных кортежей на три последовательности
/// Разъединяет последовательность трехэлементных кортежей на три последовательности. Реализуется многопроходным алгоритмом
function UnZipTuple<T, T1, T2>(Self: sequence of (T, T1, T2)): (sequence of T, sequence of T1, sequence of T2); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2]))
end;
/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности
/// Разъединяет последовательность четырехэлементных кортежей на четыре последовательности. Реализуется многопроходным алгоритмом
function UnZipTuple<T, T1, T2, T3>(Self: sequence of (T, T1, T2, T3)): (sequence of T, sequence of T1, sequence of T2, sequence of T3); extensionmethod;
begin
Result := (Self.Select(x -> x[0]), Self.Select(x -> x[1]), Self.Select(x -> x[2]), Self.Select(x -> x[3]))