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

Merge branch 'master' into features/typeclasses-another-approach

Browse source
This commit is contained in:
Bogan Voloshin 2020-11-05 17:52:57 +03:00
parent 1c4c5d538c f1bba07dae
commit 6f11b069d5
48 changed files with 400 additions and 223 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Compiler/Compiler.cs
View file

@ -2306,8 +2306,8 @@ namespace PascalABCCompiler
if (ClearAfterCompilation)
ClearAll();
OnChangeCompilerState(this, CompilerState.Ready, null);
if (!need_recompiled)
OnChangeCompilerState(this, CompilerState.Ready, null);
if (ErrorsList.Count > 0)
{
return null;

2
Compiler/PCU/PCUFileFormatVersion.cs
View file

@ -6,6 +6,6 @@ namespace PascalABCCompiler.PCU
{
public static class PCUFileFormatVersion
{
public static System.Int16 Version = 115;
public static System.Int16 Version = 116;
}
}

97
Compiler/PCU/PCUReader.cs
View file

@ -2107,8 +2107,8 @@ namespace PascalABCCompiler.PCU
//}
}
private definition_node CreateInterfaceCommonType(string name, int offset)
{
private definition_node CreateInterfaceCommonType(string name, int offset)
{
definition_node dn = null;
if (members.TryGetValue(offset, out dn))
return dn as common_type_node;
@ -2116,7 +2116,7 @@ namespace PascalABCCompiler.PCU
bool is_interface = br.ReadBoolean();
int ind = br.ReadInt32();
if (is_interface)//пропускаем флаг - интерфейсности
{
name = GetString(br.ReadInt32());
@ -2125,10 +2125,12 @@ namespace PascalABCCompiler.PCU
{
name = br.ReadString();
}
//br.ReadInt32();
//br.ReadInt32();
//Читаем, является ли тип интерфейсом
bool type_is_interface = (br.ReadByte() == 1);
bool type_is_class = (br.ReadByte() == 1);
//Читаем, является ли тип делегатом
bool type_is_delegate = (br.ReadByte() == 1);
@ -2164,35 +2166,28 @@ namespace PascalABCCompiler.PCU
ctn.generic_params = type_params;
}
AddMember(ctn, offset);
int_members.Insert(0,ctn);
int_members.Insert(0, ctn);
common_type_node saved_ctn = ctn;
type_node base_type = GetTypeReference();
bool is_value_type = br.ReadBoolean();
//Читаем поддерживаемые интерфейсы
List<SemanticTree.ITypeNode> interf_implemented = ReadImplementingInterfaces();
//int interf_count = br.ReadInt32();
//List<SemanticTree.ITypeNode> interf_implemented = new List<SemanticTree.ITypeNode>(interf_count);
//for (int i = 0; i < interf_count; i++)
//{
// interf_implemented.Add(GetTypeReference());
//}
constant_node low_val=null;
constant_node upper_val=null;
constant_node low_val = null;
constant_node upper_val = null;
SemanticTree.type_access_level tal = (SemanticTree.type_access_level)br.ReadByte();
SemanticTree.type_special_kind tsk = (SemanticTree.type_special_kind)br.ReadByte();
ctn.SetIsSealed(br.ReadBoolean());
ctn.SetIsAbstract(br.ReadBoolean());
ctn.SetIsStatic(br.ReadBoolean());
ctn.IsPartial = br.ReadBoolean();
if (tsk == SemanticTree.type_special_kind.diap_type)
{
low_val = CreateExpression() as constant_node;
upper_val = CreateExpression() as constant_node;
low_val = CreateExpression() as constant_node;
upper_val = CreateExpression() as constant_node;
}
if (type_is_interface)
{
//Добавляем ссылки на области видимости предков интерфейса
@ -2203,12 +2198,10 @@ namespace PascalABCCompiler.PCU
}
iscope.TopInterfaceScopeArray = interf_scopes.ToArray();
}
//ctn = new wrapped_common_type_node(this, base_type, name, tal, cun.namespaces[0], scope, null, offset);
//AddMember(ctn, offset);
//int_members.Insert(0,ctn);
ctn.SetBaseType(base_type);
ctn.IsInterface = type_is_interface;
ctn.IsDelegate = type_is_delegate;
ctn.is_class = type_is_class;
ctn.ImplementingInterfaces.AddRange(interf_implemented);
ctn.internal_is_value = is_value_type;
ctn.type_special_kind = tsk;
@ -2226,13 +2219,13 @@ namespace PascalABCCompiler.PCU
if (CanReadObject())
elemnet_type = GetTypeReference();
ctn.element_type = elemnet_type;
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type)
{
SystemLibrary.SystemLibrary.init_reference_type(ctn);
SystemLibrary.SystemLibrary.init_reference_type(ctn);
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.set_type)
{
ctn = compilation_context.AddTypeToSetTypeList(ctn);
ctn = compilation_context.AddTypeToSetTypeList(ctn);
if (saved_ctn != ctn)
{
RemoveMember(offset, saved_ctn);
@ -2242,7 +2235,7 @@ namespace PascalABCCompiler.PCU
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.typed_file)
{
ctn = compilation_context.AddTypeToTypedFileList(ctn);
ctn = compilation_context.AddTypeToTypedFileList(ctn);
if (saved_ctn != ctn)
{
RemoveMember(offset, saved_ctn);
@ -2252,50 +2245,45 @@ namespace PascalABCCompiler.PCU
}
br.ReadInt32();//comprehensive unit;
ctn.attributes.AddRange(GetAttributes());
//common_namespace_node ns = cun.namespaces[0];
byte flag = br.ReadByte();
int def_prop_off=0;
int def_prop_off = 0;
if (flag == 1)
{
def_prop_off = br.ReadInt32();
}
location loc= ReadDebugInfo();
location loc = ReadDebugInfo();
ctn.loc = loc;
if (type_is_delegate)
{
SystemLibrary.SystemLibrary.type_constructor.AddOperatorsToDelegate(ctn, loc);
}
//создаем scope для класса
//ctn = new wrapped_common_type_node(this, base_type, name, tal, ns, scope, loc, offset);
//members[offset] = ctn;
//AddMember(ctn, offset);
class_names[ctn] = AddClassMemberNames(scope);
if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off);
if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off);
//ivan
if (ctn.IsEnum)
if (ctn.IsEnum)
{
AddEnumOperators(ctn);
MakeTypeAsOrdinal(ctn,0,class_names.Count);
ctn.add_additional_enum_operations();
AddEnumOperators(ctn);
MakeTypeAsOrdinal(ctn, 0, class_names.Count);
ctn.add_additional_enum_operations();
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.diap_type)
{
type_constructor.add_convertions_to_diap(ctn,low_val,upper_val);
type_constructor.add_convertions_to_diap(ctn, low_val, upper_val);
}
if (ctn.type_special_kind == SemanticTree.type_special_kind.array_kind)
{
if (!(ctn.element_type is compiled_type_node))
{
type_constructor.make_array_interface(ctn);
}
if (!(ctn.element_type is compiled_type_node))
{
type_constructor.make_array_interface(ctn);
}
}
if (ctn.is_value_type)
{
}
//RestoreAllFields(ctn);
if(!waited_types_to_restore_fields.Contains(ctn))
if (!waited_types_to_restore_fields.Contains(ctn))
waited_types_to_restore_fields.Add(ctn);
if (type_is_delegate)
@ -2308,19 +2296,14 @@ namespace PascalABCCompiler.PCU
dii.parameters.AddRange(invoke_method.parameters);
ctn.add_internal_interface(dii);
}
/*if (ctn.type_special_kind == PascalABCCompiler.SemanticTree.type_special_kind.array_wrapper)
{
bounded_array_interface bai = new bounded_array_interface(oti_indexer, ctn.element_type, cpn, oti_indexer.lower_value.type, int_arr);
ctn.add_internal_interface(bai);
}*/
if (type_is_interface)
{
RestoreAllFields(ctn);
}
if (ctn.is_value)
{
RestoreAllFields(ctn);
RestoreAllFields(ctn);
}
if (ctn.is_generic_type_definition)
{
@ -2333,13 +2316,9 @@ namespace PascalABCCompiler.PCU
}
}
}
/*if (ctn.type_special_kind == SemanticTree.type_special_kind.array_wrapper)
{
RestoreAllFields(ctn);
}*/
return ctn;
}
return ctn;
}
private void MakeTypeAsOrdinal(common_type_node ctn, int low_val, int upper_val)
{

118
Compiler/PCU/PCUWriter.cs
View file

@ -2496,23 +2496,19 @@ namespace PascalABCCompiler.PCU
return sizeof(byte) + sizeof(int);
}
private void VisitTypeDefinition(common_type_node type)
{
private void VisitTypeDefinition(common_type_node type)
{
int offset = 0;
if (is_interface == true) offset = SavePositionAndConstPool(type);
else offset = SavePositionAndImplementationPool(type);
bw.Write((byte)type.semantic_node_type);
bw.Write(is_interface);
else offset = SavePositionAndImplementationPool(type);
bw.Write((byte)type.semantic_node_type);
bw.Write(is_interface);
bw.Write(type_entity_index++);
if (is_interface == true)
bw.Write(GetNameIndex(type));
else
bw.Write(type.name);
/*if (type.base_type != null)
WriteTypeReference(type.base_type);
else*/
if (is_interface == true)
bw.Write(GetNameIndex(type));
else
bw.Write(type.name);
//Пишем, является ли данный класс интерфейсом
if (type.IsInterface)
{
bw.Write((byte)1);
@ -2522,7 +2518,15 @@ namespace PascalABCCompiler.PCU
bw.Write((byte)0);
}
//Пишем, является ли данный класс делегатом
if (type.is_class)
{
bw.Write((byte)1);
}
else
{
bw.Write((byte)0);
}
if (type.IsDelegate)
{
bw.Write((byte)1);
@ -2531,7 +2535,7 @@ namespace PascalABCCompiler.PCU
{
bw.Write((byte)0);
}
//Является ли тип описанием дженерика
if (type.is_generic_type_definition)
{
@ -2552,10 +2556,7 @@ namespace PascalABCCompiler.PCU
int base_class_off = (int)bw.BaseStream.Position;
bw.Seek(GetSizeOfReference(type.base_type), SeekOrigin.Current);
//(ssyy) На кой чёрт это надо?
//WriteTypeReference(SystemLibrary.SystemLibrary.object_type);
//WriteTypeReference(type.base_type);
bw.Write(type.internal_is_value);
//Пишем поддерживаемые интерфейсы
@ -2563,8 +2564,8 @@ namespace PascalABCCompiler.PCU
//WriteImplementingInterfaces(type);
int interface_impl_off = (int)bw.BaseStream.Position;
int seek_off = sizeof(int);
for (int k=0; k<type.ImplementingInterfaces.Count; k++)
seek_off += GetSizeOfReference(type.ImplementingInterfaces[k] as TreeRealization.type_node);
for (int k = 0; k < type.ImplementingInterfaces.Count; k++)
seek_off += GetSizeOfReference(type.ImplementingInterfaces[k] as TreeRealization.type_node);
bw.Seek(seek_off, SeekOrigin.Current);
bw.Write((byte)type.type_access_level);
bw.Write((byte)type.type_special_kind);
@ -2572,11 +2573,12 @@ namespace PascalABCCompiler.PCU
bw.Write(type.IsAbstract);
bw.Write(type.IsStatic);
bw.Write(type.IsPartial);
if (type.type_special_kind == SemanticTree.type_special_kind.diap_type)
{
ordinal_type_interface oti = type.get_internal_interface(internal_interface_kind.ordinal_interface) as ordinal_type_interface;
VisitExpression(oti.lower_value);
VisitExpression(oti.upper_value);
ordinal_type_interface oti = type.get_internal_interface(internal_interface_kind.ordinal_interface) as ordinal_type_interface;
VisitExpression(oti.lower_value);
VisitExpression(oti.upper_value);
}
if (type.is_generic_type_definition)
@ -2584,52 +2586,52 @@ namespace PascalABCCompiler.PCU
//Ограничители параметров
WriteTypeParamsEliminations(type.generic_params);
}
if(CanWriteObject(type.element_type))
if (CanWriteObject(type.element_type))
WriteTypeReference(type.element_type);
bw.Write(GetUnitReference(type.comprehensive_namespace));
SaveOffsetForAttribute(type);
bw.Write(GetUnitReference(type.comprehensive_namespace));
SaveOffsetForAttribute(type);
bw.Write(0);//attributes;
if (type.default_property != null)
if (type.default_property != null)
bw.Write((byte)1);
else
else
bw.Write((byte)0);
int def_prop_off = (int)bw.BaseStream.Position;
if (type.default_property != null)
bw.Write(0);//default_property
WriteDebugInfo(type.loc);
//заполнение списка имен членов этого класса
int num = type.const_defs.Count + type.fields.Count + type.properties.Count + type.methods.Count+type.events.Count;
NameRef[] names = new NameRef[num];
int pos = (int)bw.BaseStream.Position;
//заполнение списка имен членов этого класса
int num = type.const_defs.Count + type.fields.Count + type.properties.Count + type.methods.Count + type.events.Count;
NameRef[] names = new NameRef[num];
int pos = (int)bw.BaseStream.Position;
int int_size = System.Runtime.InteropServices.Marshal.SizeOf(typeof(int));
int size = int_size;
int i=0,j=0;
for (i=j; i<type.const_defs.Count+j; i++)
{
int i = 0, j = 0;
for (i = j; i < type.const_defs.Count + j; i++)
{
names[i] = new NameRef(type.const_defs[i - j].name, i);
name_pool[type.const_defs[i - j]] = names[i];
size += names[i].Size;
}
j=i;
for (i=j; i<type.fields.Count+j; i++)
{
}
j = i;
for (i = j; i < type.fields.Count + j; i++)
{
names[i] = new NameRef(type.fields[i - j].name, i, convert_field_access_level(type.fields[i - j].field_access_level), type.fields[i - j].semantic_node_type);
name_pool[type.fields[i - j]] = names[i];
names[i].is_static = type.fields[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static;
size += names[i].Size;
}
j=i;
for (i=j; i<type.properties.Count+j; i++)
{
}
j = i;
for (i = j; i < type.properties.Count + j; i++)
{
names[i] = new NameRef(type.properties[i - j].name, i, convert_field_access_level(type.properties[i - j].field_access_level), type.properties[i - j].semantic_node_type);
name_pool[type.properties[i - j]] = names[i];
names[i].is_static = type.properties[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static;
size += names[i].Size;
}
j=i;
for (i=j; i<type.methods.Count+j; i++)
{
}
j = i;
for (i = j; i < type.methods.Count + j; i++)
{
names[i] = new NameRef(type.methods[i - j].name, i, convert_field_access_level(type.methods[i - j].field_access_level), type.methods[i - j].semantic_node_type);
name_pool[type.methods[i - j]] = names[i];
if (type.methods[i - j].is_overload)
@ -2637,16 +2639,16 @@ namespace PascalABCCompiler.PCU
names[i].virtual_slot = type.methods[i - j].newslot_awaited || type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_virtual || type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_virtual_abstract || type.methods[i - j].is_constructor;
names[i].is_static = type.methods[i - j].polymorphic_state == SemanticTree.polymorphic_state.ps_static && !type.methods[i - j].is_constructor;
size += names[i].Size;
}
j=i;
for (i=j; i<type.events.Count+j; i++)
{
}
j = i;
for (i = j; i < type.events.Count + j; i++)
{
names[i] = new NameRef(type.events[i - j].name, i, convert_field_access_level(type.events[i - j].field_access_level), type.events[i - j].semantic_node_type);
name_pool[type.events[i - j]] = names[i];
size += names[i].Size;
}
bw.BaseStream.Seek(size,SeekOrigin.Current);
/*VisitConstantInTypeDefinitions(type);
}
bw.BaseStream.Seek(size, SeekOrigin.Current);
/*VisitConstantInTypeDefinitions(type);
VisitFieldDefinitions(type);
VisitMethodDefinitions(type);
VisitPropertyDefinitions(type);
@ -2665,9 +2667,9 @@ namespace PascalABCCompiler.PCU
bw.Write(names[i].offset);
}
bw.BaseStream.Seek(tmp,SeekOrigin.Begin);*/
ClassInfo ci = new ClassInfo(pos, def_prop_off, base_class_off, interface_impl_off,names);
ClassInfo ci = new ClassInfo(pos, def_prop_off, base_class_off, interface_impl_off, names);
class_info[type] = ci;
}
}
//ssyy
private void VisitLabelDeclaration(label_node ln)

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "7";
public const string Build = "1";
public const string Revision = "2721";
public const string Revision = "2736";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=7
%REVISION%=2721
%COREVERSION%=1
%REVISION%=2736
%MINOR%=7
%MAJOR%=3

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.7.1.2721
3.7.1.2736

2
ReleaseGenerators/PABCRtl/PABCRtl.pas
View file

@ -5,7 +5,7 @@ uses
ABCSprites, CRT, DMCollect, DMTaskMaker, DMZadan, Drawman,
DrawManField, Events, FilesOperations, GraphABC,
GraphABCHelper, IniFile, PointerTools, PointRect, Robot, RobotField,
RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4TaskMakerNET, RBDMUtils,
RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4TaskMakerNET, RBDMUtils, SF, School, BlockFileOfT,
FormsABC, Collections, Arrays, ClientServer, WPFObjects, Graph3D, GraphWPF, __RedirectIOMode, __RunMode, __RtlUtils;
end.

2
ReleaseGenerators/PABCRtl/PABCRtl32.pas
View file

@ -5,7 +5,7 @@ uses
ABCSprites, CRT, DMCollect, DMTaskMaker, DMZadan, Drawman,
DrawManField, Events, FilesOperations, GraphABC,
GraphABCHelper, IniFile, PointerTools, PointRect, Robot, RobotField,
RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4, PT4TaskMakerNET, RBDMUtils,
RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4, PT4TaskMakerNET, RBDMUtils, SF, School, BlockFileOfT,
FormsABC, Collections, Arrays, ClientServer, Graph3D, GraphWPF, WPFObjects, __RedirectIOMode, __RunMode, __RtlUtils;
end.

BIN
ReleaseGenerators/PT4/Lib/PT4ABegin.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4ABoolean.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4ACase.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4AExam.dll
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4AIf.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4AInteger.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4ALoopFor.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4ASeries.dll Normal file
View file

Binary file not shown.

BIN
ReleaseGenerators/PT4/Lib/PT4AWhile.dll Normal file
View file

Binary file not shown.

12
ReleaseGenerators/PT4/loaddat.txt Normal file
View file

@ -0,0 +1,12 @@
RB
DM
ABegin
AInteger
ALoopFor
ABoolean
AIf
ACase
AWhile
ASeries
AExam
=br

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.7.1.2721'
!define VERSION '3.7.1.2736'

9
TestSuite/CompilationSamples/BlockFileOfT.pas
View file

@ -830,4 +830,13 @@ end;
{$endregion Utils}
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

8
TestSuite/CompilationSamples/NumLibABC.pas
View file

@ -2776,5 +2776,13 @@ end;
{$endregion}
//----------------------------------------
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

73
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -492,6 +492,7 @@ type
function ToString: string; override;
class function operator implicit<T>(s: TypedSet): HashSet<T>;
class function operator implicit<T>(s: HashSet<T>): TypedSet;
//class function operator implicit<T>(a: array of T): TypedSet;
function Count: integer := ht.Count;
procedure Print(delim: string := ' ');
procedure Println(delim: string := ' ');
@ -3369,6 +3370,17 @@ begin
Result := ts;
end;
///--
{class function TypedSet.operator implicit<T>(a: array of T): TypedSet;
begin
var ts := new TypedSet();
foreach key: T in a do
begin
ts.ht[key] := key;
end;
Result := ts;
end;}
///--
function TypedSet.ToString: string;
var
@ -5193,33 +5205,6 @@ begin
Result := sb.ToString;
end;}
function ReadLexem(f: Text): string;
begin
if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
if f.sr = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING));
var i: integer;
repeat
i := f.sr.Read();
until not char.IsWhiteSpace(char(i)); // pass spaces
if i=-1 then
raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE));
var c := char(i);
var sb := System.Text.StringBuilder.Create;
repeat
sb.Append(c);
i := f.sr.Peek();
if i = -1 then
break;
c := char(i);
if char.IsWhiteSpace(c) then
break;
f.sr.Read();
until False; // accumulate nonspaces
Result := sb.ToString;
end;
// -----------------------------------------------------
// IOStandardSystem: implementation
// -----------------------------------------------------
@ -6447,6 +6432,34 @@ begin
Result := ReadBoolean(f);
Readln(f);
end;
function ReadLexem(f: Text): string;
begin
if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
if f.sr = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING));
var i: integer;
repeat
i := f.sr.Read();
until not char.IsWhiteSpace(char(i)); // pass spaces
if i=-1 then
raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE));
var c := char(i);
var sb := System.Text.StringBuilder.Create;
repeat
sb.Append(c);
i := f.sr.Peek();
if i = -1 then
break;
c := char(i);
if char.IsWhiteSpace(c) then
break;
f.sr.Read();
until False; // accumulate nonspaces
Result := sb.ToString;
end;
// -----------------------------------------------------
// TextFile methods
// -----------------------------------------------------
@ -6982,6 +6995,7 @@ begin
begin
f.sr := new StreamReader(f.fi.FullName, DefaultEncoding);
(CurrentIOSystem as IOStandardSystem).tr := f.sr;
(CurrentIOSystem as IOStandardSystem).realbuflen := -1;
_IsPipedRedirected := True;
_IsPipedRedirectedQuery := True;
end;
@ -7032,6 +7046,11 @@ begin
f.sr.BaseStream.Position := 0;
f.sr.DiscardBufferedData;
end;
if f = input then
begin
(CurrentIOSystem as IOStandardSystem).tr := f.sr;
(CurrentIOSystem as IOStandardSystem).realbuflen := -1;
end;
end;
procedure Reset(f: Text; name: string) := Reset(f, name, DefaultEncoding);

9
TestSuite/CompilationSamples/PT4MakerNetX.pas
View file

@ -1,9 +1,9 @@
/// Конструктор учебных заданий для задачника Programming Taskbook.
/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018.
/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020.
/// Все компоненты конструктора могут вызываться либо как классовые методы класса pt,
/// либо как обычные константы и процедуры.
unit PT4MakerNetX;
interface
const
@ -659,7 +659,7 @@ var
yd, yr, ye, nd, nr, pr, wd: integer;
nt, ut, fd, fr: boolean;
fmt: string;
tasks := new List<MethodInfo>(100);
tasks := new List<MethodInfo>(200);
procedure Show(s: string);
begin
@ -1213,7 +1213,8 @@ begin
begin
tasks.Add(e);
GroupKey := GroupKey + Copy(e.Name, 5, 100);
end;
end;
tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач!
if tasks.Count = 0 then
begin
Show('Группа ' + GroupName + ' не содержит заданий'#13#10+

39
TestSuite/CompilationSamples/SF.pas
View file

@ -1,5 +1,30 @@
unit SF;
type
int = integer;
bool = boolean;
bi = BigInteger;
FunI = () -> int;
FunR = () -> real;
FunS = () -> string;
FunII = int -> int;
FunIR = int -> real;
FunIS = int -> string;
FunRI = real -> int;
FunRR = real -> real;
FunRS = real -> string;
FunSI = string -> int;
FunSR = string -> real;
FunSS = string -> string;
Pred = () -> bool;
PredI = int -> bool;
PredR = real -> bool;
PredS = string -> bool;
Act = () -> ();
ProcI = int -> ();
ProcR = real -> ();
ProcS = string -> ();
procedure Pr(params a: array of object) := Print(a);
procedure Pr(o: object) := Print(o);
procedure Pr(s: string) := Print(s);
@ -126,6 +151,9 @@ function Av(Self: sequence of integer): real; extensionmethod := Self.Average;
/// Возвращает среднее элементов последовательности
function Av(Self: sequence of real): real; extensionmethod := Self.Average;
/// Возвращает количество элементов последовательности
function Cnt<T>(Self: sequence of T): integer; extensionmethod := Self.Count;
function Dst<T>(Self: sequence of T): sequence of T; extensionmethod := Self.Distinct;
function Ord<T>(Self: sequence of T): sequence of T; extensionmethod := Self.Order;
@ -195,4 +223,15 @@ procedure Tr<T>(a: array of T; transform: T->T) := a.Transform(transform);
function H<T>(Self: array of T): integer; extensionmethod := Self.High;
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

9
TestSuite/CompilationSamples/School.pas
View file

@ -755,4 +755,13 @@ end;
{$endregion}
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

9
TestSuite/formatter_tests/input/PT4MakerNetX.pas
View file

@ -1,9 +1,9 @@
/// Конструктор учебных заданий для задачника Programming Taskbook.
/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018.
/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020.
/// Все компоненты конструктора могут вызываться либо как классовые методы класса pt,
/// либо как обычные константы и процедуры.
unit PT4MakerNetX;
interface
const
@ -659,7 +659,7 @@ var
yd, yr, ye, nd, nr, pr, wd: integer;
nt, ut, fd, fr: boolean;
fmt: string;
tasks := new List<MethodInfo>(100);
tasks := new List<MethodInfo>(200);
procedure Show(s: string);
begin
@ -1213,7 +1213,8 @@ begin
begin
tasks.Add(e);
GroupKey := GroupKey + Copy(e.Name, 5, 100);
end;
end;
tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач!
if tasks.Count = 0 then
begin
Show('Группа ' + GroupName + ' не содержит заданий'#13#10+

7
TestSuite/units/u_questiondot1.pas Normal file
View file

@ -0,0 +1,7 @@
unit u_questiondot1;
type
t1 = class end;
end.

7
TestSuite/usesunits/use_questiondot1.pas Normal file
View file

@ -0,0 +1,7 @@
uses u_questiondot1;
begin
var a: t1 := nil;
var s := a?.ToString;
assert(string.IsNullOrEmpty(s));
end.

3
TreeConverter/NetWrappers/NetHelper.cs
View file

@ -1106,7 +1106,8 @@ namespace PascalABCCompiler.NetHelper
function_node fn = si.sym_info as function_node;
if ((fn.return_value_type == to || fn.return_value_type.original_generic == to) &&
fn.parameters.Count == 1 &&
(fn.parameters[0].type == from || fn.parameters[0].type.original_generic == from))
(fn.parameters[0].type == from || fn.parameters[0].type.original_generic == from)
|| fn.parameters[0].type.type_special_kind == type_special_kind.array_kind && fn.parameters[0].type.element_type.is_generic_parameter)
{
return fn;
}

14
TreeConverter/TreeRealization/types.cs
View file

@ -3662,7 +3662,8 @@ namespace PascalABCCompiler.TreeRealization
//TODO: Доопределить.
public override function_node get_implicit_conversion_to(type_node ctn)
{
compiled_type_node cctn = ctn as compiled_type_node;
// То есть получается, что конвертировать откомпилированный тип в неоткомпилированный нельзя несмотря на то что есть extension оператор
var cctn = ctn as compiled_type_node;
if (cctn == null)
{
return null;
@ -3673,6 +3674,17 @@ namespace PascalABCCompiler.TreeRealization
fn = NetHelper.NetHelper.get_implicit_conversion(this, this, cctn, scope);
if (fn is compiled_function_node)
_implicit_convertions_to.Add(cctn, fn);
else if (fn == null && this.type_special_kind == SemanticTree.type_special_kind.array_kind && this.base_type.Scope != null)
{
fn = NetHelper.NetHelper.get_implicit_conversion(this.base_type as compiled_type_node, this.base_type as compiled_type_node, cctn, this.base_type.Scope as NetHelper.NetTypeScope);
if (fn != null)
{
List<type_node> instance_params = new List<type_node>();
instance_params.Add(this.element_type);
fn = fn.get_instance(instance_params, false, null);
return fn;
}
}
else if (fn == null && (this.is_generic_type_instance || cctn.is_generic_type_instance))
{
List<type_node> instance_params1 = this.instance_params;

30
VisualPascalABCNET/Form1.cs
View file

@ -840,7 +840,7 @@ namespace VisualPascalABC
private void StartMenuItem_Click(object sender, EventArgs e)
{
WorkbenchServiceFactory.RunService.Run(true);
if (VisualEnvironmentCompiler.Compiler != null && VisualEnvironmentCompiler.Compiler.ErrorsList.Count == 0)
/*if (VisualEnvironmentCompiler.Compiler != null && VisualEnvironmentCompiler.Compiler.ErrorsList.Count == 0)
{
var Percent = VisualEnvironmentCompiler.Compiler.PABCCodeHealth;
if (Percent > 0)
@ -856,33 +856,7 @@ namespace VisualPascalABC
var PM100 = 100 - Percent;
HealthLabel.BackColor = Color.FromArgb(c.R - PM100 - 20, c.G - PM100 - 20, c.B - PM100 - 20);
}
}
/*if (VisualEnvironmentCompiler.StandartCompiler != null &&
VisualEnvironmentCompiler.StandartCompiler.LinesCompiled > 1000)
return;
var root = VisualEnvironmentCompiler?.StandartCompiler?.CurrentCompilationUnit?.SyntaxTree;
if (root == null)
return;
if (VisualEnvironmentCompiler.StandartCompiler.CurrentCompilationUnit.SemanticTree == null)
return;
var stat = new SyntaxVisitors.ABCStatisticsVisitor();
stat.ProcessNode(root);
var Percent = stat.CalcHealth(out int n, out int p);
if (Percent >= 100)
{
HealthLabel.Text = "";
return;
}
HealthLabel.Text = $"{Percent}%";
var c = SystemColors.Control;
var PM100 = 100 - Percent;
HealthLabel.BackColor = Color.FromArgb(c.R - PM100 - 20, c.G - PM100 - 20, c.B - PM100 - 20);
*/
}*/
}
private void Form1_KeyUp(object sender, KeyEventArgs e)

9
bin/Lib/BlockFileOfT.pas
View file

@ -830,4 +830,13 @@ end;
{$endregion Utils}
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

8
bin/Lib/NumLibABC.pas
View file

@ -2776,5 +2776,13 @@ end;
{$endregion}
//----------------------------------------
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

73
bin/Lib/PABCSystem.pas
View file

@ -492,6 +492,7 @@ type
function ToString: string; override;
class function operator implicit<T>(s: TypedSet): HashSet<T>;
class function operator implicit<T>(s: HashSet<T>): TypedSet;
//class function operator implicit<T>(a: array of T): TypedSet;
function Count: integer := ht.Count;
procedure Print(delim: string := ' ');
procedure Println(delim: string := ' ');
@ -3369,6 +3370,17 @@ begin
Result := ts;
end;
///--
{class function TypedSet.operator implicit<T>(a: array of T): TypedSet;
begin
var ts := new TypedSet();
foreach key: T in a do
begin
ts.ht[key] := key;
end;
Result := ts;
end;}
///--
function TypedSet.ToString: string;
var
@ -5193,33 +5205,6 @@ begin
Result := sb.ToString;
end;}
function ReadLexem(f: Text): string;
begin
if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
if f.sr = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING));
var i: integer;
repeat
i := f.sr.Read();
until not char.IsWhiteSpace(char(i)); // pass spaces
if i=-1 then
raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE));
var c := char(i);
var sb := System.Text.StringBuilder.Create;
repeat
sb.Append(c);
i := f.sr.Peek();
if i = -1 then
break;
c := char(i);
if char.IsWhiteSpace(c) then
break;
f.sr.Read();
until False; // accumulate nonspaces
Result := sb.ToString;
end;
// -----------------------------------------------------
// IOStandardSystem: implementation
// -----------------------------------------------------
@ -6447,6 +6432,34 @@ begin
Result := ReadBoolean(f);
Readln(f);
end;
function ReadLexem(f: Text): string;
begin
if f.fi = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED));
if f.sr = nil then
raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING));
var i: integer;
repeat
i := f.sr.Read();
until not char.IsWhiteSpace(char(i)); // pass spaces
if i=-1 then
raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE));
var c := char(i);
var sb := System.Text.StringBuilder.Create;
repeat
sb.Append(c);
i := f.sr.Peek();
if i = -1 then
break;
c := char(i);
if char.IsWhiteSpace(c) then
break;
f.sr.Read();
until False; // accumulate nonspaces
Result := sb.ToString;
end;
// -----------------------------------------------------
// TextFile methods
// -----------------------------------------------------
@ -6982,6 +6995,7 @@ begin
begin
f.sr := new StreamReader(f.fi.FullName, DefaultEncoding);
(CurrentIOSystem as IOStandardSystem).tr := f.sr;
(CurrentIOSystem as IOStandardSystem).realbuflen := -1;
_IsPipedRedirected := True;
_IsPipedRedirectedQuery := True;
end;
@ -7032,6 +7046,11 @@ begin
f.sr.BaseStream.Position := 0;
f.sr.DiscardBufferedData;
end;
if f = input then
begin
(CurrentIOSystem as IOStandardSystem).tr := f.sr;
(CurrentIOSystem as IOStandardSystem).realbuflen := -1;
end;
end;
procedure Reset(f: Text; name: string) := Reset(f, name, DefaultEncoding);

9
bin/Lib/PT4MakerNetX.pas
View file

@ -1,9 +1,9 @@
/// Конструктор учебных заданий для задачника Programming Taskbook.
/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018.
/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020.
/// Все компоненты конструктора могут вызываться либо как классовые методы класса pt,
/// либо как обычные константы и процедуры.
unit PT4MakerNetX;
interface
const
@ -659,7 +659,7 @@ var
yd, yr, ye, nd, nr, pr, wd: integer;
nt, ut, fd, fr: boolean;
fmt: string;
tasks := new List<MethodInfo>(100);
tasks := new List<MethodInfo>(200);
procedure Show(s: string);
begin
@ -1213,7 +1213,8 @@ begin
begin
tasks.Add(e);
GroupKey := GroupKey + Copy(e.Name, 5, 100);
end;
end;
tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач!
if tasks.Count = 0 then
begin
Show('Группа ' + GroupName + ' не содержит заданий'#13#10+

39
bin/Lib/SF.pas
View file

@ -1,5 +1,30 @@
unit SF;
type
int = integer;
bool = boolean;
bi = BigInteger;
FunI = () -> int;
FunR = () -> real;
FunS = () -> string;
FunII = int -> int;
FunIR = int -> real;
FunIS = int -> string;
FunRI = real -> int;
FunRR = real -> real;
FunRS = real -> string;
FunSI = string -> int;
FunSR = string -> real;
FunSS = string -> string;
Pred = () -> bool;
PredI = int -> bool;
PredR = real -> bool;
PredS = string -> bool;
Act = () -> ();
ProcI = int -> ();
ProcR = real -> ();
ProcS = string -> ();
procedure Pr(params a: array of object) := Print(a);
procedure Pr(o: object) := Print(o);
procedure Pr(s: string) := Print(s);
@ -126,6 +151,9 @@ function Av(Self: sequence of integer): real; extensionmethod := Self.Average;
/// Возвращает среднее элементов последовательности
function Av(Self: sequence of real): real; extensionmethod := Self.Average;
/// Возвращает количество элементов последовательности
function Cnt<T>(Self: sequence of T): integer; extensionmethod := Self.Count;
function Dst<T>(Self: sequence of T): sequence of T; extensionmethod := Self.Distinct;
function Ord<T>(Self: sequence of T): sequence of T; extensionmethod := Self.Order;
@ -195,4 +223,15 @@ procedure Tr<T>(a: array of T; transform: T->T) := a.Transform(transform);
function H<T>(Self: array of T): integer; extensionmethod := Self.High;
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

9
bin/Lib/School.pas
View file

@ -755,4 +755,13 @@ end;
{$endregion}
///--
procedure __InitModule__;
begin
end;
///--
procedure __FinalizeModule__;
begin
end;
end.

BIN
bin/PT4/Lib/PT4ABegin.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4ABoolean.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4ACase.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4AExam.dll
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4AIf.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4AInteger.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4ALoopFor.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4ASeries.dll Normal file
View file

Binary file not shown.

BIN
bin/PT4/Lib/PT4AWhile.dll Normal file
View file

Binary file not shown.

12
bin/PT4/loaddat.txt Normal file
View file

@ -0,0 +1,12 @@
RB
DM
ABegin
AInteger
ALoopFor
ABoolean
AIf
ACase
AWhile
ASeries
AExam
=br