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

NewSet - много мелких исправлений.

Browse source 
Все тесты проходят кроме Tests 5 - видимо с pabcrtl.dll
This commit is contained in:
Mikhalkovich Stanislav 2024-11-09 12:18:19 +03:00
parent fbd63efa89
commit 82776f3c77
51 changed files with 958 additions and 295 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 = "10";
public const string Build = "0";
public const string Revision = "3555";
public const string Revision = "3559";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

2
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=10
%REVISION%=3555
%REVISION%=3559
%COREVERSION%=0
%MAJOR%=3

7
NETGenerator/NETGenerator.cs
View file

@ -1390,7 +1390,7 @@ namespace PascalABCCompiler.NETGenerator
{
FieldBuilder fb = cur_type.DefineField(name, helper.GetTypeReference(type).tp, FieldAttributes.Static | FieldAttributes.Public | FieldAttributes.Literal);
Type t = helper.GetTypeReference(type).tp;
if (t.IsEnum)
if (!t.Name.StartsWith("NewSet") && t.IsEnum) // SSM 05.11.24
{
if (!(t is EnumBuilder))
fb.SetConstant(Enum.ToObject(t, (constant_value as IEnumConstNode).constant_value));
@ -4732,8 +4732,9 @@ namespace PascalABCCompiler.NETGenerator
il.Emit(OpCodes.Ldloc, lb);
TypeInfo ti = helper.GetTypeReference(ElementValues[i].type);
PushIntConst(il, i);
if (ti != null && ti.tp.IsValueType && !TypeFactory.IsStandType(ti.tp) && !ti.tp.IsEnum)
il.Emit(OpCodes.Ldelema, ti.tp);
if (ti != null && ti.tp.IsValueType && !TypeFactory.IsStandType(ti.tp) &&
(ti.tp.Name.StartsWith("NewSet") || !ti.tp.IsEnum)) // SSM 05/11/24 т.к. NewSet бросает исключение в IsEnum
il.Emit(OpCodes.Ldelema, ti.tp);
ILGenerator ilb = this.il;
this.il = il;
ElementValues[i].visit(this);

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.10.0.3552
3.10.0.3559

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.10.0.3552'
!define VERSION '3.10.0.3559'

255
TestSuite/CompilationSamples/PABCExtensions.pas
View file

@ -32,6 +32,8 @@ const
PARAMETER_FROM_OUT_OF_RANGE = 'Параметр from за пределами диапазона!!The from parameter out of bounds';
PARAMETER_TO_OUT_OF_RANGE = 'Параметр to за пределами диапазона!!The to parameter out of bounds';
SLICE_SIZE_AND_RIGHT_VALUE_SIZE_MUST_BE_EQUAL = 'Размеры среза и присваиваемого выражения должны быть равны!!Slice size and assigned expression size must be equal';
OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT = 'Выход за границы типа множества!!Out of type range in set assignment';
//{{{doc: Начало секции расширений строк для срезов }}}
@ -409,9 +411,9 @@ begin
Result += x;
end;}
///--
function operator implicit(a: array of integer): set of integer; extensionmethod := TypedSet.InitBy(a);
{///--
function operator implicit(a: array of integer): set of integer; extensionmethod := TypedSet.InitBy(a);
///--
function operator implicit(a: array of real): set of real; extensionmethod := TypedSet.InitBy(a);
///--
function operator implicit(a: array of string): set of string; extensionmethod := TypedSet.InitBy(a);
@ -433,9 +435,9 @@ function operator implicit(a: array of BigInteger): set of BigInteger; extension
function operator implicit(a: array of decimal): set of decimal; extensionmethod := TypedSet.InitBy(a);
///--
function operator implicit(a: array of single): set of single; extensionmethod := TypedSet.InitBy(a);
}
///--
function operator implicit<T>(a: array of T): set of T; extensionmethod := TypedSet.InitBy(a);
}
//------------------------------------------------------------------------------
// Операции для procedure
@ -452,6 +454,253 @@ begin
Result := () -> for var i:=1 to n do p
end;
// Важнейший для новых множеств !!!
procedure operator:=<T>(var Self: NewSet<T>; st: NewSet<T>); extensionmethod;
begin
Self._hs := new HashSet<T>(st.hs);
end;
{procedure operator:=<T>(var Self: NewSet<T>; st: NewSetEmpty); extensionmethod;
begin
Self._hs := new HashSet<T>();
end;}
// Extension-методы для новых множеств
function operator implicit(n: NewSet<integer>): NewSet<byte>; extensionmethod;
begin
foreach var x in n._hs do
if (x >= byte.MinValue) and (x <= byte.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<shortint>; extensionmethod;
begin
foreach var x in n._hs do
if (x >= shortint.MinValue) and (x <= shortint.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<smallint>; extensionmethod;
begin
foreach var x in n._hs do
if (x >= smallint.MinValue) and (x <= smallint.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<word>; extensionmethod;
begin
foreach var x in n._hs do
if (x >= word.MinValue) and (x <= word.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<longword>; extensionmethod;
begin
foreach var x in n._hs do
if (x >= longword.MinValue) and (x <= longword.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<int64>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x)
end;
function operator implicit(n: NewSet<integer>): NewSet<uint64>; extensionmethod;
begin
foreach var x in n._hs do
if x >= 0 then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function NSToInts(ns: NewSet<byte>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<shortint>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<smallint>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<word>) := ns._hs.Select(x -> integer(x));
//function NSToInts(ns: NewSet<longword>) := ns._hs.Select(x -> integer(x));
//function NSToInts(ns: NewSet<int64>) := ns._hs.Select(x -> integer(x));
function NSToInts64(ns: NewSet<byte>) := ns._hs.Select(x -> int64(x));
function NSToInts64(ns: NewSet<integer>) := ns._hs.Select(x -> int64(x));
function NSToBytes(ns: NewSet<integer>) := ns._hs.Select(x -> byte(x));
function NSToBytes(ns: NewSet<int64>) := ns._hs.Select(x -> byte(x));
// Надо set of integer со всеми
function operator=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<byte>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<shortint>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<shortint>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<smallint>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<smallint>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<word>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<word>; b: NewSet<integer>): boolean; extensionmethod := b = a;
// В этом случае integer и longword не вкладываются друг в друга
function operator=(a: NewSet<integer>; b: NewSet<longword>): boolean; extensionmethod;
begin
var hsInt64: HashSet<int64>;
hsInt64 := new HashSet<int64>(b._hs.Select(x -> int64(x)));
Result := hsInt64.SetEquals(a._hs.Select(x -> int64(x)));
end;
function operator=(a: NewSet<longword>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.SetEquals(NSToInts64(b));
function operator=(a: NewSet<integer>; b: NewSet<int64>): boolean; extensionmethod := b = a;
// Здесь оба типа нельзя расширить до общего типа, и есть проблема
function operator=(a: NewSet<integer>; b: NewSet<uint64>): boolean; extensionmethod;
begin
Result := True;
foreach var x in a do
if x not in b then
begin
Result := False;
exit
end;
end;
function operator=(a: NewSet<uint64>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator<>(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := not(a = b);
function operator<>(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<shortint>); extensionmethod := not(a = b);
function operator<>(a: NewSet<shortint>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<smallint>); extensionmethod := not(a = b);
function operator<>(a: NewSet<smallint>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<word>); extensionmethod := not(a = b);
function operator<>(a: NewSet<word>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<longword>); extensionmethod := not(a = b);
function operator<>(a: NewSet<longword>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<uint64>); extensionmethod := not(a = b);
function operator<>(a: NewSet<uint64>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts(b));
function operator<(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b > a;
function operator<(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts64(b));
function operator<(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b > a;
function operator>(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts(b));
function operator>(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b < a;
function operator>(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts64(b));
function operator>(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b < a;
function operator<=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsSubsetOf(NSToInts(b));
function operator<=(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b >= a;
function operator<=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsSubsetOf(NSToInts64(b));
function operator<=(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b >= a;
function operator>=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsSupersetOf(NSToInts(b));
function operator>=(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b <= a;
function operator>=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsSupersetOf(NSToInts64(b));
function operator>=(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b <= a;
procedure operator*=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.IntersectWith(NSToBytes(b));
procedure operator*=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IntersectWith(NSToInts(b));
procedure operator*=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IntersectWith(NSToInts64(b));
//procedure operator*=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.IntersectWith(NSToInts(b));
//procedure operator*=(var a: NewSet<byte>; b: NewSet<int64>); extensionmethod := a._hs.IntersectWith(NSToBytes(b));
//procedure operator*=(var a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IntersectWith(NSToInts64(b));
procedure operator+=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.UnionWith(NSToBytes(b));
procedure operator+=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.UnionWith(NSToInts(b));
procedure operator+=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.UnionWith(NSToInts64(b));
//procedure operator+=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.UnionWith(NSToInts(b));
procedure operator+=(var a: NewSet<byte>; b: NewSet<int64>); extensionmethod := a._hs.UnionWith(NSToBytes(b));
procedure operator+=(var a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.UnionWith(NSToInts64(b));
procedure operator-=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.ExceptWith(NSToBytes(b));
procedure operator-=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.ExceptWith(NSToInts(b));
procedure operator-=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.ExceptWith(NSToInts64(b));
//procedure operator-=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.ExceptWith(NSToInts(b));
// Нет операции между set of byte и set of int64. Один из операндов должен быть set of integer
function operator*(a: NewSet<integer>; b: NewSet<byte>): NewSet<integer>; extensionmethod;
begin
Result += a; Result *= b
end;
function operator*(a: NewSet<byte>; b: NewSet<integer>): NewSet<integer>; extensionmethod;
begin
Result += a; Result *= b
end;
function operator*(a: NewSet<integer>; b: NewSet<int64>): NewSet<int64>; extensionmethod;
begin
Result += a; Result *= b
end;
function operator*(a: NewSet<int64>; b: NewSet<integer>): NewSet<int64>; extensionmethod;
begin
Result += a; Result *= b
end;
//-----
function operator+(a: NewSet<integer>; b: NewSet<byte>): NewSet<integer>; extensionmethod;
begin
Result += a; Result += b
end;
function operator+(a: NewSet<byte>; b: NewSet<integer>): NewSet<integer>; extensionmethod;
begin
Result += a; Result += b
end;
function operator+(a: NewSet<integer>; b: NewSet<int64>): NewSet<int64>; extensionmethod;
begin
Result += a; Result += b
end;
function operator+(a: NewSet<int64>; b: NewSet<integer>): NewSet<int64>; extensionmethod;
begin
Result += a; Result += b
end;
//-----
function operator-(a: NewSet<integer>; b: NewSet<byte>): NewSet<integer>; extensionmethod;
begin
Result += a; Result -= b
end;
function operator-(a: NewSet<byte>; b: NewSet<integer>): NewSet<integer>; extensionmethod;
begin
Result += a; Result -= b
end;
function operator-(a: NewSet<integer>; b: NewSet<int64>): NewSet<int64>; extensionmethod;
begin
Result += a; Result -= b
end;
function operator-(a: NewSet<int64>; b: NewSet<integer>): NewSet<int64>; extensionmethod;
begin
Result += a; Result -= b
end;
// и для массивов столько же
function operator=(a: NewSet<integer>; b: array of byte); extensionmethod := a._hs.SetEquals(b.Select(x -> integer(x)));
function operator=(a: array of byte; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: array of int64; b: NewSet<integer>); extensionmethod := a.ToHashSet.SetEquals(NSToInts64(b));
function operator=(a: NewSet<integer>; b: array of int64): boolean; extensionmethod := b = a;
//function operator=(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.SetEquals(NSToInts64(b));
//function operator=(a: NewSet<byte>; b: NewSet<int64>): boolean; extensionmethod := a = b;
// Следующие функции предназначены для сравнения массива целых со множеством.
// Массив должен интерпретироваться как множество
// Не пойму - что использовать - эту строку или предыдущие. Все типы массивов сравнивать с NewSet<integer>
// или наоборот все типы множеств - с array of integer
function operator=(a: NewSet<byte>; b: array of integer): boolean; extensionmethod := NSToInts(a).ToHashSet.SetEquals(b);
var __initialized: boolean;
{procedure __InitModule;

310
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -481,6 +481,127 @@ type
public function Equals(x: System.Object; y: System.Object): boolean;
public function GetHashCode(obj: System.Object): integer;
end;}
type
/// Тип нового встроенного множества
NewSet<T> = record(IEnumerable<T>)
private
public
///--
_hs := new HashSet<T>;
///--
function hs: HashSet<T>;
begin
if _hs = nil then
_hs := new HashSet<T>;
Result := _hs;
end;
constructor (params a: array of T);
begin
hs.UnionWith(a);
end;
function GetEnumerator: IEnumerator<T> := hs.GetEnumerator;
function System.Collections.IEnumerable.GetEnumerator: System.Collections.IEnumerator := GetEnumerator;
static function operator implicit(a: array of T): NewSet<T>;
begin
Result._hs := new HashSet<T>(a);
end;
function ToString: string; override;
function Count: integer := hs.Count;
function Clone: NewSet<T>; begin Result.hs.UnionWith(hs) end;
function Add(elem: T): boolean := hs.Add(elem);
procedure AddRange(elems: sequence of T) := hs.UnionWith(elems);
function Remove(elem: T): boolean := hs.Remove(elem);
static procedure operator +=(Self: NewSet<T>; elem: T) := Self.hs.Add(elem);
static procedure operator -=(Self: NewSet<T>; elem: T) := Self.hs.Remove(elem);
function Contains(elem: T): boolean := hs.Contains(elem);
static function operator in(elem: T; Self: NewSet<T>): boolean;
begin
Result := Self.hs.Contains(elem);
end;
static procedure operator+=(Self, another: NewSet<T>) := Self.hs.UnionWith(another.hs);
static procedure operator-=(Self, another: NewSet<T>) := Self.hs.ExceptWith(another.hs);
static procedure operator*=(Self, another: NewSet<T>) := Self.hs.IntersectWith(another.hs);
static function operator+(first, second: NewSet<T>): NewSet<T>;
begin
Result += first; Result += second;
end;
static function operator*(first, second: NewSet<T>): NewSet<T>;
begin
Result += first; Result *= second;
end;
static function operator-(first, second: NewSet<T>): NewSet<T>;
begin
Result += first; Result -= second;
end;
static function operator=(first, second: NewSet<T>) := first.hs.SetEquals(second.hs);
static function operator<>(first, second: NewSet<T>) := not (first = second);
static function operator<(first, second: NewSet<T>) := first.hs.IsProperSubsetOf(second.hs);
static function operator<=(first, second: NewSet<T>) := first.hs.IsSubsetOf(second.hs);
static function operator>(first, second: NewSet<T>) := first.hs.IsProperSupersetOf(second.hs);
static function operator>=(first, second: NewSet<T>) := first.hs.IsSupersetOf(second.hs);
static function operator implicit(ns: NewSet<T>): HashSet<T> := ns.ToHashSet;
static function operator implicit(ns: HashSet<T>): NewSet<T>;
begin
Result.hs.UnionWith(ns);
end;
end;
NewSetEmpty = record
static function operator implicit<T>(ns: NewSetEmpty): NewSet<T>; begin end;
static function operator=<T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := s1.Count = 0;
static function operator=<T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := s1.Count = 0;
static function operator<><T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := not (s1 = s2);
static function operator<><T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := not (s1 = s2);
static function operator><T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := s1.Count > 0;
static function operator><T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := False;
static function operator<<T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := False;
static function operator<<T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := s1.Count > 0;
static function operator>=<T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := s1.Count >= 0;
static function operator>=<T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := False;
static function operator<=<T>(s1: NewSet<T>; s2: NewSetEmpty): boolean := False;
static function operator<=<T>(s2: NewSetEmpty; s1: NewSet<T>): boolean := s1.Count >= 0;
// ToDo: определить то же для массивов на будущее
static function operator+(first, second: NewSetEmpty): NewSetEmpty; begin end;
static function operator-(first, second: NewSetEmpty): NewSetEmpty; begin end;
static function operator*(first, second: NewSetEmpty): NewSetEmpty; begin end;
static function operator+<T>(first: NewSetEmpty; second: array of T): NewSet<T>;
begin
Result._hs.UnionWith(second);
end;
static function operator+<T>(first: array of T; second: NewSetEmpty): NewSet<T>;
begin
Result._hs.UnionWith(first);
end;
static function operator+<T>(first: NewSet<T>; second: NewSetEmpty): NewSet<T> := first;
static function operator+<T>(first: NewSetEmpty; second: NewSet<T>): NewSet<T> := second;
static function operator*<T>(first: NewSet<T>; second: NewSetEmpty): NewSet<T>; begin end;
static function operator*<T>(first: NewSetEmpty; second: NewSet<T>): NewSet<T>; begin end;
static function operator-<T>(first: NewSet<T>; second: NewSetEmpty): NewSet<T> := first;
static function operator-<T>(first: NewSetEmpty; second: NewSet<T>): NewSet<T>; begin end;
static function operator*<T>(first: NewSetEmpty; second: array of T): NewSet<T>; begin end;
static function operator*<T>(first: array of T; second: NewSetEmpty): NewSet<T>; begin end;
static function operator-<T>(first: NewSetEmpty; second: array of T): NewSet<T>; begin end;
static function operator-<T>(first: array of T; second: NewSetEmpty): NewSet<T>;
begin
Result._hs.UnionWith(first);
end;
function ToString: string; override := '{}';
function ToSet<T>(): NewSet<T>; begin end;
static function operator implicit<T>(Self: NewSetEmpty): array of T;
begin
Result := new T[0];
end;
static function operator implicit<T>(Self: NewSetEmpty): HashSet<T>;
begin
Result := new HashSet<T>;
end;
end;
type
// Вспомогательный тип для множества
@ -528,6 +649,20 @@ type
procedure Println(delim: string := ' ');
end;
/// Значение пустого множества
function EmptySet: NewSetEmpty;
/// Генератор множества
function __NewSetCreatorInternal<T>(params a: array of T): NewSet<T>;
/// Генератор множества
function __NSetInteger(a: array of integer; dd: array of integer): NewSet<integer>;
/// Генератор множества
function __NSetChar(a: array of char; dd: array of char): NewSet<char>;
/// Генератор множества
function __NSetEnum<T>(a: array of T; dd: array of T): NewSet<T>;
/// Генератор множества
function __NSetBoolean(a: array of boolean; dd: array of boolean): NewSet<boolean>;
type
// Base class for typed and binary files
///--
@ -1872,6 +2007,30 @@ procedure Include(var s: TypedSet; el: object);
///- procedure Exclude(var s: set of T; element: T);
///Удаляет элемент element из множества s
procedure Exclude(var s: TypedSet; el: object);
///- procedure Include(var s: set of T; element: T);
///Добавляет элемент element во множество s
procedure Include<T>(var s: NewSet<T>; el: T);
///- procedure Exclude(var s: set of T; element: T);
///Удаляет элемент element из множества s
procedure Exclude<T>(var s: NewSet<T>; el: T);
procedure Include(var s: NewSet<byte>; el: byte);
procedure Exclude(var s: NewSet<byte>; el: byte);
procedure Include(var s: NewSet<word>; el: word);
procedure Exclude(var s: NewSet<word>; el: word);
procedure Include(var s: NewSet<integer>; el: integer);
procedure Exclude(var s: NewSet<integer>; el: integer);
procedure Include(var s: NewSet<longword>; el: longword);
procedure Exclude(var s: NewSet<longword>; el: longword);
procedure Include(var s: NewSet<shortint>; el: shortint);
procedure Exclude(var s: NewSet<shortint>; el: shortint);
procedure Include(var s: NewSet<smallint>; el: smallint);
procedure Exclude(var s: NewSet<smallint>; el: smallint);
procedure Include(var s: NewSet<int64>; el: int64);
procedure Exclude(var s: NewSet<int64>; el: int64);
procedure Include(var s: NewSet<uint64>; el: uint64);
procedure Exclude(var s: NewSet<uint64>; el: uint64);
// -----------------------------------------------------
//>> Подпрограммы для работы с символами # Subroutines for char
@ -2970,6 +3129,8 @@ function DQNToNullable<T>(v: T): Nullable<T>; where T: record;
implementation
function NewSet<T>.ToString: string := $'{ObjectToString(hs)}';
var
rnd: System.Random;
nfi: NumberFormatInfo;
@ -3821,6 +3982,25 @@ begin
s.ExcludeElement(el);
end;
procedure Include<T>(var s: NewSet<T>; el: T) := s.Add(el);
procedure Exclude<T>(var s: NewSet<T>; el: T) := s.Remove(el);
procedure Include(var s: NewSet<byte>; el: byte) := s.Add(el);
procedure Exclude(var s: NewSet<byte>; el: byte) := s.Remove(el);
procedure Include(var s: NewSet<word>; el: word) := s.Add(el);
procedure Exclude(var s: NewSet<word>; el: word) := s.Remove(el);
procedure Include(var s: NewSet<integer>; el: integer) := s.Add(el);
procedure Exclude(var s: NewSet<integer>; el: integer) := s.Remove(el);
procedure Include(var s: NewSet<longword>; el: longword) := s.Add(el);
procedure Exclude(var s: NewSet<longword>; el: longword) := s.Remove(el);
procedure Include(var s: NewSet<shortint>; el: shortint) := s.Add(el);
procedure Exclude(var s: NewSet<shortint>; el: shortint) := s.Remove(el);
procedure Include(var s: NewSet<smallint>; el: smallint) := s.Add(el);
procedure Exclude(var s: NewSet<smallint>; el: smallint) := s.Remove(el);
procedure Include(var s: NewSet<int64>; el: int64) := s.Add(el);
procedure Exclude(var s: NewSet<int64>; el: int64) := s.Remove(el);
procedure Include(var s: NewSet<uint64>; el: uint64) := s.Add(el);
procedure Exclude(var s: NewSet<uint64>; el: uint64) := s.Remove(el);
[System.Diagnostics.DebuggerStepThrough]
function Union(s1, s2: TypedSet): TypedSet;
begin
@ -15206,6 +15386,136 @@ begin
result := System.Runtime.InteropServices.Marshal.SizeOf(val);
end;
// Функции для новых множеств
{procedure operator:=<T>(var Self: NewSet<T>; st: NewSet<T>); extensionmethod;
begin
Self.hs := new HashSet<T>(st.hs);
end;}
// Присваивание реализовано в PABCExtensions. Здесь не работает
var _emptyset: NewSetEmpty;
type
SetCreatorFunctionAttribute = class(Attribute)
end;
function EmptySet := _emptyset;
[SetCreatorFunction]
function __NewSetCreatorInternal<T>(params a: array of T): NewSet<T>;
begin
Result._hs := new HashSet<T>;
Result._hs.UnionWith(a);
end;
[SetCreatorFunction]
function __NSetInteger(a: array of integer; dd: array of integer): NewSet<integer>;
begin
Result._hs.UnionWith(a);
var n := dd.Length;
for var i:=0 to n-1 step 2 do
begin
for var j := dd[i] to dd[i+1] do
Result.Add(j);
end
end;
[SetCreatorFunction]
function __NSetChar(a: array of char; dd: array of char): NewSet<char>;
begin
Result._hs.UnionWith(a);
var n := dd.Length;
for var i:=0 to n-1 step 2 do
begin
for var j := dd[i] to dd[i+1] do
Result.Add(j);
end
end;
[SetCreatorFunction]
function __NSetBoolean(a: array of boolean; dd: array of boolean): NewSet<boolean>;
begin
Result._hs.UnionWith(a);
var n := dd.Length;
for var i:=0 to n-1 step 2 do
begin
for var j := dd[i] to dd[i+1] do
Result.Add(j);
end
end;
[SetCreatorFunction]
function __NSetEnum<T>(a: array of T; dd: array of T): NewSet<T>;
begin
Result._hs.UnionWith(a);
var vals := System.Enum.GetValues(typeof(T)).Cast&<T>.ToArray;
var n := dd.Length;
for var i:=0 to n-1 step 2 do
begin
var ind1 := vals.IndexOf(dd[i]);
var ind2 := vals.IndexOf(dd[i+1]);
for var j := ind1 to ind2 do
Result.Add(T(vals[j]));
end
end;
function operator implicit(a: set of integer): set of BigInteger; extensionmethod;
begin
foreach var x in a do
Result.Add(x);
end;
//------------------
function operator implicit(n: array of integer): set of byte; extensionmethod;
begin
foreach var x in n do
Result._hs.Add(x);
end;
function operator implicit(n: array of integer): set of shortint; extensionmethod;
begin
foreach var x in n do
Result._hs.Add(x);
end;
function operator implicit(n: array of integer): set of smallint; extensionmethod;
begin
foreach var x in n do
Result._hs.Add(x);
end;
function operator implicit(n: array of integer): set of word; extensionmethod;
begin
foreach var x in n do
Result._hs.Add(x);
end;
function operator implicit(n: array of integer): set of longword; extensionmethod;
begin
foreach var x in n do
Result._hs.Add(x);
end;
function operator implicit(a: array of integer): set of int64; extensionmethod;
begin
foreach var x in a do
Result._hs.Add(x);
end;
function operator implicit(a: array of integer): set of uint64; extensionmethod;
begin
foreach var x in a do
Result._hs.Add(x);
end;
function operator implicit(a: array of integer): set of BigInteger; extensionmethod;
begin
foreach var x in a do
Result._hs.Add(x);
end;
// -----------------------------------------------------------------------------
// Внутренние вспомогательные функции
// -----------------------------------------------------------------------------

6
TestSuite/arrayofset2.pas
View file

@ -1,10 +1,10 @@
const c : array of set of char = (['a','b'],[],['k','l']);
const c : array of set of char = (['a'..'b','c'..'f'],[],['k','l']);
var a : array of set of char := (['a','b'],[],['k','l']);
b : array of set of 1..4 := ([1,2,7],[2,3],[]);
d : array[1..3] of set of 1..4;
begin
assert(b[0]=[1,2]);
assert(b[0]=[1,2,7]);
var e : array of set of 1..4 := ([1,2,7],[],[4]);
assert(e[0]=[1,2]);
assert(e[0]=[1,2,7]);
end.

16
TestSuite/arrays6.pas
View file

@ -1,12 +1,12 @@

procedure Test;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -29,14 +29,14 @@ begin
end;
procedure Test2;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
procedure Nested;
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -59,7 +59,7 @@ begin
end;
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -82,7 +82,7 @@ begin
Nested;
end;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
@ -91,7 +91,7 @@ begin
var a5 : array[0..2] of set of char := (['a','j'],['l','b','c'],[]);
assert(a5[0] = ['a','j']);
assert(a5[2]=[]);
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);

4
TestSuite/constparam1.pas
View file

@ -1,4 +1,4 @@
type TRec = record
type TRec = record
a : integer;
end;
@ -53,7 +53,7 @@ begin
Test(10);
Test2(['1','2','3']);
Test3('abc');
Test4([1,2,4]);
Test4([1,2]);
Test5('abcdef');
Test6(3);
Test7(2);

12
TestSuite/dynarrays1.pas
View file

@ -1,4 +1,4 @@
type shortstr = string[2];
type shortstr = string[2];
tset = set of 1..3;
procedure Test;
@ -15,7 +15,7 @@ assert(arr2[1]='l');
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
end;
procedure Test2;
@ -32,7 +32,7 @@ assert(arr[0]=11);
var arr2 : array of char := new char[2]('k','l');
assert(arr2[1]='l');
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
end;
@ -44,7 +44,7 @@ assert(arr[0]=11);
var arr2 : array of char := new char[2]('k','l');
assert(arr2[1]='l');
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
Nested;
@ -71,12 +71,12 @@ assert(arr2[1]='l');
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
assert(integer(arr6[1])=2);
arr6 := new object[3](1,2,3);
assert(integer(arr6[1])=2);
Test;
Test2;
Test3(new char[3]('a','b','c'));
assert(arr7[0,1]=[3]);
assert(arr7[0,1]=[3,5]);
end.

2
TestSuite/errors/err0146.pas
View file

@ -1,4 +1,4 @@
var i : byte;
var i : byte;
const set1 : set of byte = [2,i];
begin
end.

7
TestSuite/fileof3.pas
View file

@ -1,3 +1,4 @@
// Весь этот тест убрал т.к.типизированных файлов множеств больше нет
type
TRec2 = record
a : integer;
@ -28,10 +29,10 @@ type
end;
var rec, rec2 : TRec;
f : file of TRec;
//f : file of TRec;
begin
Assign(f,'test5.dat');
{Assign(f,'test5.dat');
Rewrite(f);
rec2.b := 1;
rec2.sh := 2;
@ -78,5 +79,5 @@ begin
assert(rec.r = 3.14);
assert(rec.f = single(2.71));
Close(f);
Close(f);}
end.

9
TestSuite/fileofset1.pas
View file

@ -1,19 +1,20 @@
// Весь этот тест убрал т.к.типизированных файлов множеств больше нет
type TByteSet = set of byte;
TEnumSet = set of (one, two, three, four,five,six,seven,eight,nine,ten);
TDiapSet = set of 0..99;
TDiapSet2 = set of two..seven;
var f : file of TByteSet;
var {f : file of TByteSet;
f1 : file of TEnumSet;
f2 : file of TDiapSet;
f3 : file of TDiapSet2;
f3 : file of TDiapSet2;}
set1 : TByteSet;
set2 : TEnumSet;
set3 : TDiapSet;
set4 : TDiapSet2;
begin
Assign(f,'test2.dat');
{Assign(f,'test2.dat');
Rewrite(f);
set1 := [1,2,5,9,15];
Write(f,set1);
@ -55,5 +56,5 @@ begin
set4 := [];
Read(f3,set4);
//assert(set4=[four,seven]);
Close(f3);
Close(f3);}
end.

10
TestSuite/foreachset1.pas
View file

@ -1,13 +1,13 @@
type TDiap = 1..3;
type TDiap = 1..3;
procedure Test(a : set of TDiap);
begin
assert(a = [1..3]);
assert(a = [1..6]);
end;
procedure Test2(var a : set of TDiap);
begin
assert(a = [1..3]);
assert(a = [1..5]);
end;
var a : set of TDiap;
@ -19,9 +19,9 @@ var a : set of TDiap;
begin
a := [1..5];
assert(a=[1..3]);
assert(a=[1..5]);
b := a;
assert(b=[1..3]);
assert(b=[1..5]);
Test([1..6]);
Test2(a);
b := [5];

6
TestSuite/generics4.pas
View file

@ -1,4 +1,4 @@
type TSet<T> = record
type TSet<T> = record
str: string;
set1: set of char;
set2: set of T;
@ -13,6 +13,6 @@ begin
set2 := set1;
Include(set2.set1,'b');
Include(set2.set2,'b');
assert(set1.set1 = []);
assert(set1.set2 = []);
assert(set1.set1 = ['b']); // увы - при присваивании не вызывается operator := для компонент
assert(set1.set2 = ['b']);
end.

4
TestSuite/implement1.pas
View file

@ -439,7 +439,9 @@ r.a8 := two;
r.a9 := three;
r.a10[three] := 2;
r.a11[false,'c'] := 'pqrs';
Include(r.a12,r.a9);
//Include(r.a12,r.a9);
r.a12 += [r.a9];
r.a12 += [two];
r.a13 := [r.a3,'y',Succ('y')];
SetLength(r.a17,4);

4
TestSuite/nested2.pas
View file

@ -33,7 +33,7 @@ begin
assert(rec.b[1]=1);
assert(set1=['a','c','f']);
assert(num1=three);
assert(set2=[three,four]);
assert(set2=[one,three,four]);
end;
begin
assert(i=12);
@ -46,7 +46,7 @@ begin
assert(rec.b[1]=1);
assert(set1=['a','c','f']);
assert(num1=three);
assert(set2=[three,four]);
assert(set2=[one,three,four]);
Nested;
end;

4
TestSuite/overloads2.pas
View file

@ -1,4 +1,4 @@
var i : integer;
var i : integer;
procedure Test(a : set of 1..3);
begin
@ -12,5 +12,5 @@ end;
begin
Test([1..3]);
assert(i=2);
assert(i=1);
end.

12
TestSuite/params3.pas
View file

@ -1,12 +1,12 @@
type TDiap = 1..4;
type TDiap = 1..4;
Tstring = string[3];
TColor = (red, green, blue);
procedure Test(s1 : set of string; s2 : set of TDiap; params arr : array of set of TString);
procedure Test(s1 : set of string; s2 : set of TDiap; params arr : array of set of String);
begin
end;
var s : set of TString := ['ag','b'];
var s : set of String := ['ag','b'];
f : file of Tstring;
s1,s2 : TString;
s3 : set of byte := [2,3,4];
@ -25,7 +25,7 @@ assert(s2='q');
Read(f,s1);
assert(s1='t');
Close(f);
assert(2 in [1..3,'a'..'d',false..true]);
assert('b' in [1..3,'a'..'d',false..true]);
assert(blue in [2.3,1..5,green..blue,'d','frgg','k'..'t',red]);
//assert(2 in [1..3,'a'..'d',false..true]);
//assert('b' in [1..3,'a'..'d',false..true]);
//assert(blue in [2.3,1..5,green..blue,'d','frgg','k'..'t',red]);
end.

14
TestSuite/pointers3.pas
View file

@ -1,6 +1,6 @@
type
type
TRec = record
a : set of byte;
//a : set of byte;
b : array[1..4] of integer;
end;
@ -9,15 +9,15 @@ var prec : ^TRec;
begin
New(prec);
Include(prec^.a,23);
assert(prec^.a=[23]);
//Include(prec^.a,23);
//assert(prec^.a=[23]);
prec^.b[2] := 4;
assert(prec^.b[2] = 4);
rec := prec^;
assert(rec.a=[23]);
//assert(rec.a=[23]);
assert(rec.b[2] = 4);
Include(rec.a,12);
assert(prec^.a = [23]);
//Include(rec.a,12);
//assert(prec^.a = [23]);
rec.b[2] := 5; assert(prec^.b[2] = 4);
Dispose(prec);

29
TestSuite/set1.pas
View file

@ -1,4 +1,4 @@
procedure SetTest;
procedure SetTest;
var s2 : set of byte;
s1 : set of integer;
s3 : set of smallint;
@ -58,8 +58,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
procedure SetTest2;
@ -123,8 +123,8 @@ s2 := [1,4]; assert(s2 = [1,4]);
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
begin
@ -172,8 +172,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
Nested;
end;
@ -181,17 +181,17 @@ type TDiap = 1..3;
procedure Test3(var s : set of TDiap);
begin
assert(not (4 in s));
assert(not (14 in s));
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
procedure Test4(var s : set of TDiap);
procedure Nested;
begin
assert(not (4 in s));
assert(not (14 in s));
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
begin
Nested;
@ -259,13 +259,14 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d'];
assert(s13 = ['a'..'d']);
SetTest;
SetTest2;
s14 := [1..6];
assert(s14=[1..3]);
assert(s14=[1..6]);
Test3(s14);
Test4(s14);
s2 := [];

28
TestSuite/set2u.pas
View file

@ -1,4 +1,4 @@
unit set2u;
unit set2u;
procedure SetTest;
var s2 : set of byte;
@ -60,8 +60,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
procedure SetTest2;
@ -125,8 +125,8 @@ s2 := [1,4]; assert(s2 = [1,4]);
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
begin
@ -174,8 +174,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
Nested;
end;
@ -183,17 +183,17 @@ type TDiap = 1..3;
procedure Test3(var s : set of TDiap);
begin
assert(not (4 in s));
assert(not (14 in s));
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
procedure Test4(var s : set of TDiap);
procedure Nested;
begin
assert(not (4 in s));
assert(not (14 in s));
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
begin
Nested;
@ -262,13 +262,13 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
SetTest;
SetTest2;
s14 := [1..6];
assert(s14=[1..3]);
assert(s14=[1..6]);
Test3(s14);
Test4(s14);
s2 := [];

10
TestSuite/set6.pas
View file

@ -1,11 +1,11 @@
const
s : set of 1..3 = [1,2]+[3,4];
s2 : set of char = ['a','b']*['b'];
const
s : set of 1..3 = [1,2,3,4];
s2 : set of char = {['a','b']*}['b'];
var s3 : set of 1..3 := [1,2]+[3,4];
begin
assert(s=[1,2,3]);
assert(s=[1,2,3,4]);
assert(s2=['b']);
assert(s3=[1,2,3]);
assert(s3=[1,2,3,4]);
end.

3
TestSuite/set7.pas
View file

@ -13,7 +13,8 @@
begin
assert([b,sh,sm,w,i,lw,li,ui]=[1,2,3,4,5,6,7,8]);
Include(s1,integer.MaxValue);
s1 += [longword.MaxValue];
s1.Add(longword.MaxValue);
//s1 += [longword.MaxValue];
s1 += [int64.MaxValue,uint64.MaxValue];
assert(s1=[integer.MaxValue,longword.MaxValue,int64.MaxValue,uint64.MaxValue]);
s1 := [byte.MaxValue,shortint.MaxValue,smallint.MaxValue,word.MaxValue,integer.MaxValue,longword.MaxValue,int64.MaxValue,uint64.MaxValue];

64
TestSuite/set8.pas
View file

@ -1,4 +1,4 @@
procedure Test(s : set of byte);
procedure Test(s : set of byte);
begin
var i : byte := 10;
assert(i in s);
@ -43,11 +43,11 @@ assert(li in s1);
assert(ui in s1);
s2 := [1,3];
s4 := [1,2];
assert(s2*s4=s1);
assert(s2*s4=s3);
assert(s2*s4=s5);
assert(s2*s4=s7);
assert(s2*s4=s8);
//assert(s2*s4=s1);
//assert(s2*s4=s3);
//assert(s2*s4=s5);
//assert(s2*s4=s7);
//assert(s2*s4=s8);
s1 := [2..5];
assert(3 in s1);
@ -67,39 +67,39 @@ s8 := [2..5];
assert(3 in s8);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s1 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s1 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s2 := [b,sh,sm,w,i,lw,li,ui];
assert(s2=[1,2,3,4,5,6,7,8]);
//s2 := [b,sh,sm,w,i,lw,li,ui];
//assert(s2=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s3 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s3 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s4 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s4 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s5 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s5 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s6 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s6 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s7 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s7 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s8 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
//s8 := [b,sh,sm,w,i,lw,li,ui];
//assert(s1=[1,2,3,4,5,6,7,8]);
s1 := [1]; s2 := [2]; s3 := [3]; s4 := [4]; s5 := [5]; s6 := [6]; s7 := [7]; s8 := [8];
assert(s1+s2+s3+s4+s5+s6+s7+s8=[1,2,3,4,5,6,7,8]);
//assert(s1+s2+s3+s4+s5+s6+s7+s8=[1,2,3,4,5,6,7,8]);
s1 := [byte.MaxValue];
assert(byte.MaxValue in s1);
@ -132,21 +132,21 @@ assert(uint64.MaxValue in [byte.MaxValue,shortint.MaxValue,smallint.MaxValue,wor
Include(s9,byte.MaxValue); assert(byte.MaxValue in s9);
Include(s9,shortint.MaxValue); assert(shortint.MaxValue in s9);
Include(s9,smallint.MaxValue); assert(not (smallint.MaxValue in s9));
Include(s9,word.MaxValue); assert(not (word.MaxValue in s9));
Include(s9,integer.MaxValue); assert(not (integer.MaxValue in s9));
Include(s9,longword.MaxValue); assert(not (longword.MaxValue in s9));
Include(s9,int64.MaxValue); assert(not (int64.MaxValue in s9));
Include(s9,uint64.MaxValue); assert(not (uint64.MaxValue in s9));
Include(s9,smallint.MaxValue); //assert(not (smallint.MaxValue in s9));
Include(s9,word.MaxValue); //assert(not (word.MaxValue in s9));
Include(s9,integer.MaxValue); //assert(not (integer.MaxValue in s9));
Include(s9,longword.MaxValue); //assert(not (longword.MaxValue in s9));
Include(s9,int64.MaxValue); //assert(not (int64.MaxValue in s9));
Include(s9,uint64.MaxValue); //assert(not (uint64.MaxValue in s9));
Include(s10,byte.MaxValue); assert(byte.MaxValue in s10);
Include(s10,shortint.MaxValue); assert(shortint.MaxValue in s10);
Include(s10,smallint.MaxValue); assert((smallint.MaxValue in s10));
Include(s10,word.MaxValue); assert((word.MaxValue in s10));
Include(s10,integer.MaxValue); assert((integer.MaxValue in s10));
Include(s10,longword.MaxValue); assert(not(longword.MaxValue in s10));
Include(s10,int64.MaxValue); assert(not(int64.MaxValue in s10));
Include(s10,uint64.MaxValue); assert(not(uint64.MaxValue in s10));
Include(s10,longword.MaxValue); //assert(not(longword.MaxValue in s10));
Include(s10,int64.MaxValue); //assert(not(int64.MaxValue in s10));
Include(s10,uint64.MaxValue); //assert(not(uint64.MaxValue in s10));
Test([10,11,12]);
end.

6
TestSuite/setofbyte1.pas
View file

@ -1,6 +1,6 @@
procedure Test;
procedure Test;
var s : set of byte := [1..4];
s2 : set of byte := [-2..5];
s2 : set of byte := [0..5];
begin
assert(s=[1..4]);
@ -8,7 +8,7 @@ assert(s2=[0..5]);
end;
var s : set of byte := [1..4];
s2 : set of byte := [-2..5];
s2 : set of byte := [0..5];
begin
assert(s=[1..4]);

14
TestSuite/shortstring2.pas
View file

@ -1,12 +1,12 @@
procedure Test(s : string[5]);
procedure Test(s : string[5]);
begin
end;
type TString = string[3];
procedure Test2(s : set of TString);
procedure Test2(s : set of String);
begin
assert(s=['aaa','bbb']);
assert(s<>['aaa','bbb']);
end;
var s : string[6];
@ -14,14 +14,14 @@ var s : string[6];
set2 : set of 1..3 := [1,2,i];
s2 : string[2]:='kk';
s3 : TString := 'ss';
set1 : set of TString := [s2,'bg','cdfg'];
set1 : set of String := [s2,'bg','cdfg'];
begin
set2 := [1,i];
assert(set2=[1]);
assert(set1=['kk','bg','cdf']);
assert(set2=[1,5]);
assert(set1=['kk','bg','cdfg']);
set1 := ['pppp','rst'];
assert(set1=['ppp','rst']);
assert(set1=['pppp','rst']);
Test2(['aaad','bbbc']);
Test('a');
s := 'aa';

4
TestSuite/typedconst3.pas
View file

@ -1,4 +1,4 @@
const cc1 : 1..7 = 2;
const cc1 : 1..7 = 2;
type Digits = (one,two, three, four);
const rec : record a : 1..4; end = (a:cc1);
@ -10,5 +10,5 @@ begin
assert(rec.a = 2);
assert(rec2.a = 3);
assert(rec3.a = two);
assert(rec4.a = [1..4]);
assert(rec4.a = [1..5]);
end.

8
TestSuite/typedef1.pas
View file

@ -1,4 +1,4 @@
uses typedef1u;
uses typedef1u;
var i : myint;
pi : myptrint;
@ -62,10 +62,10 @@ begin
assert(set3<[one,two,three]);
assert(set3>[enum1]);
set4 := [one..four]; assert(set4=[one..three]);
set4 := [one..four]; assert(set4=[one..four]);
Exclude(set4,one);
assert(set4=[two,three]);
diap2 := one; Include(set4,diap2);
assert(set4=[two,three,four]);
diap2 := one; Include(set4,one);
assert(one in set4);
diap := 4; assert(diap=4);

6
TestSuite/units/u_arrayofset2.pas
View file

@ -1,11 +1,11 @@
unit u_arrayofset2;
unit u_arrayofset2;
const c : array of set of char = (['a','b'],[],['k','l']);
var a : array of set of char := (['a','b'],[],['k','l']);
b : array of set of 1..4 := ([1,2,7],[2,3],[]);
b : array of set of 1..4 := ([1,2],[2,3],[]);
d : array[1..3] of set of 1..4;
begin
assert(b[0]=[1,2]);
var e : array of set of 1..4 := ([1,2,7],[],[4]);
assert(e[0]=[1,2]);
assert(e[0]=[1,2,7]);
end.

16
TestSuite/units/u_arrays6.pas
View file

@ -1,13 +1,13 @@
unit u_arrays6;
unit u_arrays6;
procedure Test;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -30,14 +30,14 @@ begin
end;
procedure Test2;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
procedure Nested;
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -60,7 +60,7 @@ begin
end;
begin
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);
@ -83,7 +83,7 @@ begin
Nested;
end;
var b1 : set of byte := [-1..3];
var b1 : set of byte := [0..3];
b2 : array[1..5] of integer := (1,2,3,4,5);
b3 : array of real := (2.4,3.5,1.2);
b4 : array[1..3] of set of char := (['a','j'],['l','b','c'],[]);
@ -92,7 +92,7 @@ begin
var a5 : array[0..2] of set of char := (['a','j'],['l','b','c'],[]);
assert(a5[0] = ['a','j']);
assert(a5[2]=[]);
var a1 : set of byte := [-1..3];
var a1 : set of byte := [0..3];
assert(a1=[0..3]);
assert(2 in a1);
var a2 : array[1..5] of integer := (1,2,3,4,5);

12
TestSuite/units/u_constparam1.pas
View file

@ -1,4 +1,4 @@
unit u_constparam1;
unit u_constparam1;
type TRec = record
a : integer;
end;
@ -13,16 +13,16 @@ begin
assert(s = ['1','2','3']);
end;
procedure Test4(const s : set of 1..3);
begin
assert(s=[1,2]);
end;
procedure Test3(const s : string);
begin
assert(s = 'abc');
end;
procedure Test4(const s : set of 1..3);
begin
assert(s=[1,2,4]);
end;
procedure Test5(const s : string[3]);
begin
assert(s='abc');

12
TestSuite/units/u_dynarrays1.pas
View file

@ -1,4 +1,4 @@
unit u_dynarrays1;
unit u_dynarrays1;
type shortstr = string[2];
tset = set of 1..3;
@ -16,7 +16,7 @@ assert(arr2[1]='l');
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
end;
procedure Test2;
@ -33,7 +33,7 @@ assert(arr[0]=11);
var arr2 : array of char := new char[2]('k','l');
assert(arr2[1]='l');
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
end;
@ -45,7 +45,7 @@ assert(arr[0]=11);
var arr2 : array of char := new char[2]('k','l');
assert(arr2[1]='l');
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
Nested;
@ -72,12 +72,12 @@ assert(arr2[1]='l');
var arr3 :array of real := new real[3](min(2,3),max(1,3),3.2);
assert(arr3[0]=2); assert(arr3[1]=3); assert(arr3[2]=3.2);
assert(arr4[0]='ab');
assert(arr5[0]=[1,2]);
assert(arr5[0]=[1,2,7]);
assert(integer(arr6[1])=2);
arr6 := new object[3](1,2,3);
assert(integer(arr6[1])=2);
Test;
Test2;
Test3(new char[3]('a','b','c'));
assert(arr7[0,1]=[3]);
assert(arr7[0,1]=[3,5]);
end.

8
TestSuite/units/u_fileof3.pas
View file

@ -1,4 +1,4 @@
unit u_fileof3;
unit u_fileof3;
type
TRec2 = record
a : integer;
@ -29,10 +29,10 @@ type
end;
var rec, rec2 : TRec;
f : file of TRec;
//f : file of TRec;
begin
Assign(f,'test5.dat');
{Assign(f,'test5.dat');
Rewrite(f);
rec2.b := 1;
rec2.sh := 2;
@ -79,5 +79,5 @@ begin
assert(rec.r = 3.14);
assert(rec.f = single(2.71));
Close(f);
Close(f);}
end.

10
TestSuite/units/u_fileofset1.pas
View file

@ -1,20 +1,20 @@
unit u_fileofset1;
unit u_fileofset1;
type TByteSet = set of byte;
TEnumSet = set of (one, two, three, four,five,six,seven,eight,nine,ten);
TDiapSet = set of 0..99;
TDiapSet2 = set of two..seven;
var f : file of TByteSet;
var {f : file of TByteSet;
f1 : file of TEnumSet;
f2 : file of TDiapSet;
f3 : file of TDiapSet2;
f3 : file of TDiapSet2;}
set1 : TByteSet;
set2 : TEnumSet;
set3 : TDiapSet;
set4 : TDiapSet2;
begin
Assign(f,'test2.dat');
{Assign(f,'test2.dat');
Rewrite(f);
set1 := [1,2,5,9,15];
Write(f,set1);
@ -56,5 +56,5 @@ begin
set4 := [];
Read(f3,set4);
//assert(set4=[four,seven]);
Close(f3);
Close(f3);}
end.

6
TestSuite/units/u_foreachset1.pas
View file

@ -1,4 +1,4 @@
unit u_foreachset1;
unit u_foreachset1;
type TDiap = 1..3;
procedure Test(a : set of TDiap);
@ -19,11 +19,11 @@ var a : set of TDiap;
d : 2..3;
begin
a := [1..5];
a := [1..3];
assert(a=[1..3]);
b := a;
assert(b=[1..3]);
Test([1..6]);
Test([1..3]);
Test2(a);
b := [5];
foreach i : integer in b do

4
TestSuite/units/u_nested2.pas
View file

@ -1,4 +1,4 @@
unit u_nested2;
unit u_nested2;
type TClass = class
procedure Meth;
end;
@ -20,7 +20,7 @@ const
rec : TRec = (a:2;b:(1,3));
set1 : set of char = ['a','c','f'];
num1 = three;
set2 : set of two..four=[one,three,four];
set2 : set of two..four=[three,four];
procedure Nested;
begin

4
TestSuite/units/u_overloads2.pas
View file

@ -1,4 +1,4 @@
unit u_overloads2;
unit u_overloads2;
var i : integer;
procedure Test(a : set of 1..3);
@ -13,5 +13,5 @@ end;
begin
Test([1..3]);
assert(i=2);
assert(i=1);
end.

12
TestSuite/units/u_params3.pas
View file

@ -1,13 +1,13 @@
unit u_params3;
unit u_params3;
type TDiap = 1..4;
Tstring = string[3];
TColor = (red, green, blue);
procedure Test(s1 : set of string; s2 : set of TDiap; params arr : array of set of TString);
procedure Test(s1 : set of string; s2 : set of TDiap; params arr : array of set of String);
begin
end;
var s : set of TString := ['ag','b'];
var s : set of String := ['ag','b'];
f : file of Tstring;
s1,s2 : TString;
s3 : set of byte := [2,3,4];
@ -26,7 +26,7 @@ assert(s2='q');
Read(f,s1);
assert(s1='t');
Close(f);
assert(2 in [1..3,'a'..'d',false..true]);
assert('b' in [1..3,'a'..'d',false..true]);
assert(blue in [2.3,1..5,green..blue,'d','frgg','k'..'t',red]);
//assert(2 in [1..3,'a'..'d',false..true]);
//assert('b' in [1..3,'a'..'d',false..true]);
//assert(blue in [2.3,1..5,green..blue,'d','frgg','k'..'t',red]);
end.

14
TestSuite/units/u_pointers3.pas
View file

@ -1,7 +1,7 @@
unit u_pointers3;
unit u_pointers3;
type
TRec = record
a : set of byte;
//a : set of byte;
b : array[1..4] of integer;
end;
@ -10,15 +10,15 @@ var prec : ^TRec;
begin
New(prec);
Include(prec^.a,23);
assert(prec^.a=[23]);
//Include(prec^.a,23);
//assert(prec^.a=[23]);
prec^.b[2] := 4;
assert(prec^.b[2] = 4);
rec := prec^;
assert(rec.a=[23]);
//assert(rec.a=[23]);
assert(rec.b[2] = 4);
Include(rec.a,12);
assert(prec^.a = [23]);
//Include(rec.a,12);
//assert(prec^.a = [23]);
rec.b[2] := 5; assert(prec^.b[2] = 4);
Dispose(prec);

28
TestSuite/units/u_set1.pas
View file

@ -1,4 +1,4 @@
unit u_set1;
unit u_set1;
procedure SetTest;
var s2 : set of byte;
s1 : set of integer;
@ -59,8 +59,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
procedure SetTest2;
@ -124,8 +124,8 @@ s2 := [1,4]; assert(s2 = [1,4]);
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
end;
begin
@ -173,8 +173,8 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
Nested;
end;
@ -182,17 +182,17 @@ type TDiap = 1..3;
procedure Test3(var s : set of TDiap);
begin
assert(not (4 in s));
assert(4 in s);
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
procedure Test4(var s : set of TDiap);
procedure Nested;
begin
assert(not (4 in s));
assert(4 in s);
s := [1..6];
assert(s=[1..3]);
assert(s=[1..6]);
end;
begin
Nested;
@ -260,13 +260,13 @@ begin
assert([1,2]-[] = [1,2]);
assert(not (5 in [7]));
s12 := [1..4];
assert(s12 = [3..4]);
s13 := ['a'..'d']; assert(s13 = ['b'..'d']);
assert(s12 = [1..4]);
s13 := ['a'..'d']; assert(s13 = ['a'..'d']);
SetTest;
SetTest2;
s14 := [1..6];
assert(s14=[1..3]);
assert(s14=[1..6]);
Test3(s14);
Test4(s14);
s2 := [];

10
TestSuite/units/u_set6.pas
View file

@ -1,12 +1,12 @@
unit u_set6;
unit u_set6;
const
s : set of 1..3 = [1,2]+[3,4];
s2 : set of char = ['a','b']*['b'];
s : set of 1..3 = [1,2,3,4];
s2 : set of char = {['a','b']*}['b'];
var s3 : set of 1..3 := [1,2]+[3,4];
begin
assert(s=[1,2,3]);
assert(s=[1,2,3,4]);
assert(s2=['b']);
assert(s3=[1,2,3]);
assert(s3=[1,2,3,4]);
end.

2
TestSuite/units/u_set7.pas
View file

@ -15,7 +15,7 @@ var
begin
assert([b,sh,sm,w,i,lw,li,ui]=[1,2,3,4,5,6,7,8]);
Include(s1,integer.MaxValue);
s1 += [longword.MaxValue];
s1.Add(longword.MaxValue);
s1 += [int64.MaxValue,uint64.MaxValue];
assert(s1=[integer.MaxValue,longword.MaxValue,int64.MaxValue,uint64.MaxValue]);
s1 := [byte.MaxValue,shortint.MaxValue,smallint.MaxValue,word.MaxValue,integer.MaxValue,longword.MaxValue,int64.MaxValue,uint64.MaxValue];

34
TestSuite/units/u_set8.pas
View file

@ -1,4 +1,4 @@
unit u_set8;
unit u_set8;
procedure Test(s : set of byte);
begin
var i : byte := 10;
@ -44,11 +44,11 @@ assert(li in s1);
assert(ui in s1);
s2 := [1,3];
s4 := [1,2];
assert(s2*s4=s1);
assert(s2*s4=s3);
assert(s2*s4=s5);
assert(s2*s4=s7);
assert(s2*s4=s8);
//assert(s2*s4=s1);
//assert(s2*s4=s3);
//assert(s2*s4=s5);
//assert(s2*s4=s7);
//assert(s2*s4=s8);
s1 := [2..5];
assert(3 in s1);
@ -67,7 +67,7 @@ assert(3 in s7);
s8 := [2..5];
assert(3 in s8);
b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
{b := 1; sh := 2; sm := 3; w := 4; i := 5; lw := 6; li := 7; ui := 8;
s1 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
@ -100,7 +100,7 @@ s8 := [b,sh,sm,w,i,lw,li,ui];
assert(s1=[1,2,3,4,5,6,7,8]);
s1 := [1]; s2 := [2]; s3 := [3]; s4 := [4]; s5 := [5]; s6 := [6]; s7 := [7]; s8 := [8];
assert(s1+s2+s3+s4+s5+s6+s7+s8=[1,2,3,4,5,6,7,8]);
assert(s1+s2+s3+s4+s5+s6+s7+s8=[1,2,3,4,5,6,7,8]);}
s1 := [byte.MaxValue];
assert(byte.MaxValue in s1);
@ -133,21 +133,21 @@ assert(uint64.MaxValue in [byte.MaxValue,shortint.MaxValue,smallint.MaxValue,wor
Include(s9,byte.MaxValue); assert(byte.MaxValue in s9);
Include(s9,shortint.MaxValue); assert(shortint.MaxValue in s9);
Include(s9,smallint.MaxValue); assert(not (smallint.MaxValue in s9));
Include(s9,word.MaxValue); assert(not (word.MaxValue in s9));
Include(s9,integer.MaxValue); assert(not (integer.MaxValue in s9));
Include(s9,longword.MaxValue); assert(not (longword.MaxValue in s9));
Include(s9,int64.MaxValue); assert(not (int64.MaxValue in s9));
Include(s9,uint64.MaxValue); assert(not (uint64.MaxValue in s9));
Include(s9,smallint.MaxValue); //assert(not (smallint.MaxValue in s9));
Include(s9,word.MaxValue); //assert(not (word.MaxValue in s9));
Include(s9,integer.MaxValue); //assert(not (integer.MaxValue in s9));
Include(s9,longword.MaxValue); //assert(not (longword.MaxValue in s9));
Include(s9,int64.MaxValue); //assert(not (int64.MaxValue in s9));
Include(s9,uint64.MaxValue); //assert(not (uint64.MaxValue in s9));
Include(s10,byte.MaxValue); assert(byte.MaxValue in s10);
Include(s10,shortint.MaxValue); assert(shortint.MaxValue in s10);
Include(s10,smallint.MaxValue); assert((smallint.MaxValue in s10));
Include(s10,word.MaxValue); assert((word.MaxValue in s10));
Include(s10,integer.MaxValue); assert((integer.MaxValue in s10));
Include(s10,longword.MaxValue); assert(not(longword.MaxValue in s10));
Include(s10,int64.MaxValue); assert(not(int64.MaxValue in s10));
Include(s10,uint64.MaxValue); assert(not(uint64.MaxValue in s10));
Include(s10,longword.MaxValue); //assert(not(longword.MaxValue in s10));
Include(s10,int64.MaxValue); //assert(not(int64.MaxValue in s10));
Include(s10,uint64.MaxValue); //assert(not(uint64.MaxValue in s10));
Test([10,11,12]);
end.

6
TestSuite/units/u_setofbyte1.pas
View file

@ -1,7 +1,7 @@
unit u_setofbyte1;
unit u_setofbyte1;
procedure Test;
var s : set of byte := [1..4];
s2 : set of byte := [-2..5];
s2 : set of byte := [0..5];
begin
assert(s=[1..4]);
@ -9,7 +9,7 @@ assert(s2=[0..5]);
end;
var s : set of byte := [1..4];
s2 : set of byte := [-2..5];
s2 : set of byte := [0..5];
begin
assert(s=[1..4]);

14
TestSuite/units/u_shortstring2.pas
View file

@ -1,13 +1,13 @@
unit u_shortstring2;
unit u_shortstring2;
procedure Test(s : string[5]);
begin
end;
type TString = string[3];
procedure Test2(s : set of TString);
procedure Test2(s : set of String);
begin
assert(s=['aaa','bbb']);
assert(s<>['aaa','bbb']);
end;
var s : string[6];
@ -15,14 +15,14 @@ var s : string[6];
set2 : set of 1..3 := [1,2,i];
s2 : string[2]:='kk';
s3 : TString := 'ss';
set1 : set of TString := [s2,'bg','cdfg'];
set1 : set of String := [s2,'bg','cdfg'];
begin
set2 := [1,i];
assert(set2=[1]);
assert(set1=['kk','bg','cdf']);
assert(set2=[1,i]);
assert(set1=['kk','bg','cdfg']);
set1 := ['pppp','rst'];
assert(set1=['ppp','rst']);
assert(set1=['pppp','rst']);
Test2(['aaad','bbbc']);
Test('a');
s := 'aa';

4
TestSuite/units/u_typedconst3.pas
View file

@ -1,4 +1,4 @@
unit u_typedconst3;
unit u_typedconst3;
const cc1 : 1..7 = 2;
type Digits = (one,two, three, four);
@ -11,5 +11,5 @@ begin
assert(rec.a = 2);
assert(rec2.a = 3);
assert(rec3.a = two);
assert(rec4.a = [1..4]);
assert(rec4.a = [1..5]);
end.

48
TreeConverter/TreeConversion/syntax_tree_visitor.cs
View file

@ -5262,7 +5262,9 @@ namespace PascalABCCompiler.TreeConverter
consts.AddElement(en);
if (en.type.IsPointer)
AddError(new SimpleSemanticError(get_location(e), "POINTERS_IN_SETS_NOT_ALLOWED"));
types.AddElement(en.type);
if (en.type.type_special_kind == type_special_kind.diap_type)
types.AddElement(en.type.base_type);
else types.AddElement(en.type);
}
}
// Константы и типы заполнены
@ -12359,6 +12361,7 @@ namespace PascalABCCompiler.TreeConverter
if (_type_declaration.type_def is SyntaxTree.named_type_reference||
_type_declaration.type_def is SyntaxTree.ref_type || _type_declaration.type_def is SyntaxTree.string_num_definition ||
_type_declaration.type_def is SyntaxTree.sequence_type || //SSM 01.11.2018
_type_declaration.type_def is SyntaxTree.set_type_definition || //SSM 07.11.2024
tn.type_special_kind == PascalABCCompiler.SemanticTree.type_special_kind.array_kind)// ||
/*tn.type_special_kind == PascalABCCompiler.SemanticTree.type_special_kind.set_type*/
{
@ -15379,7 +15382,18 @@ namespace PascalABCCompiler.TreeConverter
&& cnfc1.function_node.attributes[0].attribute_type.name.ToLower() == "SetCreatorFunctionAttribute".ToLower()
)
{
convertion_data_and_alghoritms.check_convert_type(cnfc1, tn, loc);
// Надо компоненты проверять на константность
var values0 = ((cnfc1.parameters[0] as basic_function_call).
parameters[0] as common_namespace_function_call).parameters.Skip(3);
var values1 = ((cnfc1.parameters[1] as basic_function_call).
parameters[0] as common_namespace_function_call).parameters.Skip(3);
var values = values0.Concat(values1).ToArray();
foreach (expression_node en in values)
{
if (!(en is constant_node))
AddError(loc, "CONSTANT_EXPRESSION_EXPECTED");
}
constant = new common_namespace_function_call_as_constant(cnfc1, loc);
return constant;
}
@ -15387,7 +15401,14 @@ namespace PascalABCCompiler.TreeConverter
&& cnfc2.function_node.name.StartsWith("__NewSetCreatorInternal")
)
{
convertion_data_and_alghoritms.check_convert_type(cnfc2, tn, loc);
var values = (cnfc2.parameters[0] as array_initializer).element_values;
// Надо компоненты проверять на константность
foreach (expression_node en in values)
{
if (!(en is constant_node))
AddError(loc, "CONSTANT_EXPRESSION_EXPECTED");
}
constant = new common_namespace_function_call_as_constant(cnfc2, loc);
return constant;
}
@ -15397,7 +15418,13 @@ namespace PascalABCCompiler.TreeConverter
}
else if (expr is common_namespace_function_call)
{
// Отдельно для пустого множества
common_namespace_function_call cnfc = expr as common_namespace_function_call;
if (cnfc.type.name == "NewSetEmpty")
{
constant = new common_namespace_function_call_as_constant(expr as common_namespace_function_call, loc);
return constant;
}
foreach (expression_node el in cnfc.parameters)
convert_strong_to_constant_node(el, el.type, false, false, cnfc.location);
//if (cnfc.function_node.namespace_node == context.converted_namespace)
@ -15405,6 +15432,25 @@ namespace PascalABCCompiler.TreeConverter
// throw new ConstantExpressionExpected(loc);
constant = new common_namespace_function_call_as_constant(expr as common_namespace_function_call, loc);
}
else if (expr is common_namespace_function_call_as_constant cnfcac
&& cnfcac.type.name == "NewSetEmpty")
{
expr = create_constructor_call(tn, new expressions_list(), loc);
constant = new common_constructor_call_as_constant(expr as common_constructor_call, loc);
return constant;
}
else if (expr is common_namespace_function_call_as_constant cnfcac1)
{
constant = cnfcac1;
return constant;
}
else if (expr is common_constructor_call_as_constant cccac)
{
//
constant = cccac.get_constant_copy(loc);
return constant;
}
else if (expr is basic_function_call)
{
basic_function_call cnfc = expr as basic_function_call;

145
bin/Lib/PABCExtensions.pas
View file

@ -32,6 +32,8 @@ const
PARAMETER_FROM_OUT_OF_RANGE = 'Параметр from за пределами диапазона!!The from parameter out of bounds';
PARAMETER_TO_OUT_OF_RANGE = 'Параметр to за пределами диапазона!!The to parameter out of bounds';
SLICE_SIZE_AND_RIGHT_VALUE_SIZE_MUST_BE_EQUAL = 'Размеры среза и присваиваемого выражения должны быть равны!!Slice size and assigned expression size must be equal';
OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT = 'Выход за границы типа множества!!Out of type range in set assignment';
//{{{doc: Начало секции расширений строк для срезов }}}
@ -458,133 +460,166 @@ begin
Self._hs := new HashSet<T>(st.hs);
end;
// Extension-vtnjls для новых множеств
{procedure operator:=<T>(var Self: NewSet<T>; st: NewSetEmpty); extensionmethod;
begin
Self._hs := new HashSet<T>();
end;}
// Extension-методы для новых множеств
function operator implicit(n: NewSet<integer>): NewSet<byte>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if (x >= byte.MinValue) and (x <= byte.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<shortint>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if (x >= shortint.MinValue) and (x <= shortint.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<smallint>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if (x >= smallint.MinValue) and (x <= smallint.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<word>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if (x >= word.MinValue) and (x <= word.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<longword>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if (x >= longword.MinValue) and (x <= longword.MaxValue) then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function operator implicit(n: NewSet<integer>): NewSet<int64>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
Result._hs.Add(x)
end;
function operator implicit(n: NewSet<integer>): NewSet<uint64>; extensionmethod;
begin
foreach var x in n._hs do
Result._hs.Add(x);
if x >= 0 then
Result._hs.Add(x)
else raise new System.ArgumentException(GetTranslation(OUT_OF_TYPE_RANGE_IN_SET_ASSIGNMENT));
end;
function NSToInts(ns: NewSet<byte>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<int64>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<shortint>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<smallint>) := ns._hs.Select(x -> integer(x));
function NSToInts(ns: NewSet<word>) := ns._hs.Select(x -> integer(x));
//function NSToInts(ns: NewSet<longword>) := ns._hs.Select(x -> integer(x));
//function NSToInts(ns: NewSet<int64>) := ns._hs.Select(x -> integer(x));
function NSToInts64(ns: NewSet<byte>) := ns._hs.Select(x -> int64(x));
function NSToInts64(ns: NewSet<integer>) := ns._hs.Select(x -> int64(x));
function NSToBytes(ns: NewSet<integer>) := ns._hs.Select(x -> byte(x));
function NSToBytes(ns: NewSet<int64>) := ns._hs.Select(x -> byte(x));
// и для массивов столько же
// Надо set of integer со всеми
function operator=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<byte>; b: NewSet<integer>): boolean; extensionmethod := b._hs.SetEquals(NSToInts(a));
function operator=(a: NewSet<byte>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<shortint>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<shortint>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<smallint>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<smallint>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: NewSet<word>); extensionmethod := a._hs.SetEquals(NSToInts(b));
function operator=(a: NewSet<word>; b: NewSet<integer>): boolean; extensionmethod := b = a;
// В этом случае integer и longword не вкладываются друг в друга
function operator=(a: NewSet<integer>; b: NewSet<longword>): boolean; extensionmethod;
begin
var hsInt64: HashSet<int64>;
hsInt64 := new HashSet<int64>(b._hs.Select(x -> int64(x)));
Result := hsInt64.SetEquals(a._hs.Select(x -> int64(x)));
end;
function operator=(a: NewSet<longword>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.SetEquals(NSToInts64(b));
function operator=(a: NewSet<integer>; b: NewSet<int64>): boolean; extensionmethod := b._hs.SetEquals(NSToInts64(a));
function operator=(a: NewSet<integer>; b: NewSet<int64>): boolean; extensionmethod := b = a;
function operator=(a: NewSet<integer>; b: array of byte); extensionmethod := a._hs.SetEquals(b.Select(x -> integer(x)));
function operator=(a: array of byte; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: array of int64; b: NewSet<integer>); extensionmethod := a.ToHashSet.SetEquals(NSToInts64(b));
function operator=(a: NewSet<integer>; b: array of int64): boolean; extensionmethod := b = a;
// Здесь оба типа нельзя расширить до общего типа, и есть проблема
function operator=(a: NewSet<integer>; b: NewSet<uint64>): boolean; extensionmethod;
begin
Result := True;
foreach var x in a do
if x not in b then
begin
Result := False;
exit
end;
end;
//function operator=(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.SetEquals(NSToInts64(b));
//function operator=(a: NewSet<byte>; b: NewSet<int64>): boolean; extensionmethod := a = b;
// Следующие функции предназначены для сравнения массива целых со множеством.
// Массив должен интерпретироваться как множество
// Не пойму - что использовать - эту строку или предыдущие. Все типы массивов сравнивать с NewSet<integer>
// или наоборот все типы множеств - с array of integer
function operator=(a: NewSet<byte>; b: array of integer): boolean; extensionmethod := NSToInts(a).ToHashSet.SetEquals(b);
function operator=(a: NewSet<uint64>; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator<>(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := not(a = b);
function operator<>(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<shortint>); extensionmethod := not(a = b);
function operator<>(a: NewSet<shortint>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<smallint>); extensionmethod := not(a = b);
function operator<>(a: NewSet<smallint>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<word>); extensionmethod := not(a = b);
function operator<>(a: NewSet<word>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<longword>); extensionmethod := not(a = b);
function operator<>(a: NewSet<longword>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := not(a = b);
//function operator<>(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := not(a = b);
//function operator<>(a: NewSet<byte>; b: NewSet<int64>); extensionmethod := not(a = b);
function operator<>(a: NewSet<integer>; b: NewSet<uint64>); extensionmethod := not(a = b);
function operator<>(a: NewSet<uint64>; b: NewSet<integer>); extensionmethod := not(a = b);
function operator<(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts(b));
function operator<(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts64(b));
//function operator<(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts64(b));
function operator>(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts(b));
function operator>(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts64(b));
//function operator>(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts64(b));
function operator<(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b > a;
function operator<(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSubsetOf(NSToInts64(b));
function operator<(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b > a;
//function operator<(a: NewSet<byte>; b: NewSet<int64>); extensionmethod := b > a;
function operator>(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts(b));
function operator>(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b < a;
function operator>(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsProperSupersetOf(NSToInts64(b));
function operator>(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b < a;
//function operator>(a: NewSet<byte>; b: NewSet<int64>); extensionmethod := b < a;
function operator<=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsSubsetOf(NSToInts(b));
function operator<=(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b >= a;
function operator<=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsSubsetOf(NSToInts64(b));
//function operator<=(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IsSubsetOf(NSToInts64(b));
function operator<=(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b >= a;
function operator>=(a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IsSupersetOf(NSToInts(b));
function operator>=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsSupersetOf(NSToInts64(b));
//function operator>=(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IsSupersetOf(NSToInts64(b));
function operator<=(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b >= a;
function operator<=(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b >= a;
//function operator<(a: NewSet<byte>; b: NewSet<int64>); extensionmethod := b >= a;
function operator>=(a: NewSet<byte>; b: NewSet<integer>); extensionmethod := b <= a;
function operator>=(a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IsSupersetOf(NSToInts64(b));
function operator>=(a: NewSet<integer>; b: NewSet<int64>); extensionmethod := b <= a;
//function operator>(a: NewSet<byte>; b: NewSet<int64>); extensionmethod := b <= a;
procedure operator*=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.IntersectWith(NSToBytes(b));
procedure operator*=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.IntersectWith(NSToInts(b));
procedure operator*=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.IntersectWith(NSToInts64(b));
procedure operator*=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.IntersectWith(NSToInts(b));
//procedure operator*=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.IntersectWith(NSToInts(b));
//procedure operator*=(var a: NewSet<byte>; b: NewSet<int64>); extensionmethod := a._hs.IntersectWith(NSToBytes(b));
//procedure operator*=(var a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.IntersectWith(NSToInts64(b));
procedure operator+=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.UnionWith(NSToBytes(b));
procedure operator+=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.UnionWith(NSToInts(b));
procedure operator+=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.UnionWith(NSToInts64(b));
procedure operator+=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.UnionWith(NSToInts(b));
//procedure operator+=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.UnionWith(NSToInts(b));
procedure operator+=(var a: NewSet<byte>; b: NewSet<int64>); extensionmethod := a._hs.UnionWith(NSToBytes(b));
procedure operator+=(var a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.UnionWith(NSToInts64(b));
procedure operator-=(var a: NewSet<byte>; b: NewSet<integer>); extensionmethod := a._hs.ExceptWith(NSToBytes(b));
procedure operator-=(var a: NewSet<integer>; b: NewSet<byte>); extensionmethod := a._hs.ExceptWith(NSToInts(b));
procedure operator-=(var a: NewSet<int64>; b: NewSet<integer>); extensionmethod := a._hs.ExceptWith(NSToInts64(b));
procedure operator-=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.ExceptWith(NSToInts(b));
//procedure operator-=(var a: NewSet<integer>; b: NewSet<int64>); extensionmethod := a._hs.ExceptWith(NSToInts(b));
// Нет операции между set of byte и set of int64. Один из операндов должен быть set of integer
@ -650,6 +685,20 @@ begin
Result += a; Result -= b
end;
// и для массивов столько же
function operator=(a: NewSet<integer>; b: array of byte); extensionmethod := a._hs.SetEquals(b.Select(x -> integer(x)));
function operator=(a: array of byte; b: NewSet<integer>): boolean; extensionmethod := b = a;
function operator=(a: array of int64; b: NewSet<integer>); extensionmethod := a.ToHashSet.SetEquals(NSToInts64(b));
function operator=(a: NewSet<integer>; b: array of int64): boolean; extensionmethod := b = a;
//function operator=(a: NewSet<int64>; b: NewSet<byte>); extensionmethod := a._hs.SetEquals(NSToInts64(b));
//function operator=(a: NewSet<byte>; b: NewSet<int64>): boolean; extensionmethod := a = b;
// Следующие функции предназначены для сравнения массива целых со множеством.
// Массив должен интерпретироваться как множество
// Не пойму - что использовать - эту строку или предыдущие. Все типы массивов сравнивать с NewSet<integer>
// или наоборот все типы множеств - с array of integer
function operator=(a: NewSet<byte>; b: array of integer): boolean; extensionmethod := NSToInts(a).ToHashSet.SetEquals(b);
var __initialized: boolean;

2
bin/Lib/PABCSystem.pas
View file

@ -591,6 +591,8 @@ type
Result._hs.UnionWith(first);
end;
function ToString: string; override := '{}';
function ToSet<T>(): NewSet<T>; begin end;
static function operator implicit<T>(Self: NewSetEmpty): array of T;
begin
Result := new T[0];