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

3.8.3

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2022-03-08 21:41:46 +03:00
parent 67a07ffecc
commit a03d33b586
13 changed files with 161 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Configuration/GlobalAssemblyInfo.cs
View file

@ -14,8 +14,8 @@ internal static class RevisionClass
{
public const string Major = "3";
public const string Minor = "8";
public const string Build = "2";
public const string Revision = "3086";
public const string Build = "3";
public const string Revision = "3090";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=2
%REVISION%=3086
%COREVERSION%=3
%REVISION%=3090
%MINOR%=8
%MAJOR%=3

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.8.2.3086
3.8.3.3090

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.8.2.3086'
!define VERSION '3.8.3.3090'

6
SyntaxTreeConverters/StandardSyntaxConverter.cs
View file

@ -40,12 +40,12 @@ namespace PascalABCCompiler.SyntaxTreeConverters
StandOutExprWithLambdaInForeachSequenceAndNestedLambdasVisitor.New.ProcessNode(root);
VarNamesInMethodsWithSameNameAsClassGenericParamsReplacer.New.ProcessNode(root); // SSM bug fix #1147
FindOnExceptVarsAndApplyRenameVisitor.New.ProcessNode(root);
#if DEBUG
//new SimplePrettyPrinterVisitor("E:/projs/out.txt").ProcessNode(root);
#endif
// loop
LoopDesugarVisitor.New.ProcessNode(root);
#if DEBUG
new SimplePrettyPrinterVisitor("D:/out.txt").ProcessNode(root);
#endif
// tuple_node
TupleVisitor.New.ProcessNode(root);

11
SyntaxVisitors/SugarVisitors/LoopDesugarVisitor.cs
View file

@ -99,7 +99,12 @@ namespace SyntaxVisitors.SugarVisitors
var IncIh = new method_call(new ident("Inc"), exlist, i.source_context);
var stlist = new statement_list(fn.statements, fn.statements.source_context);
var pc = new procedure_call(IncIh, IncIh.source_context);
stlist.Add(pc);
var ig0 = new bin_expr(j.TypedClone(), new int32_const(1), Operators.Greater, i.source_context);
var ifpc = new if_node(ig0, pc, null, ig0.source_context);
stlist.Insert(0, ifpc);
//stlist.Add(pc);
var semCheck1 = new semantic_check_sugared_statement_node(typeof(for_node), new List<syntax_tree_node> { a,b }, a.source_context);
@ -162,9 +167,9 @@ namespace SyntaxVisitors.SugarVisitors
if (fe.index != null && !fe.index.name.StartsWith("##")) // Повторно обходить ## не надо - он для семантики
{
var newindex = new ident("##" + fe.index, fe.index.source_context); // нам нужно это имя на семантике для контроля неизменения переменной внутри цикла
var indexvar = new var_statement(fe.index, new int32_const(0), fe.index.source_context);
var indexvar = new var_statement(fe.index, new int32_const(-1), fe.index.source_context);
var IncIndex = new assign(fe.index.TypedClone(), new int32_const(1), Operators.AssignmentAddition);
var forstat = new statement_list(fe.stmt, IncIndex);
var forstat = new statement_list(IncIndex, fe.stmt);
var fe2 = new foreach_stmt(fe.identifier, fe.type_name, fe.in_what, forstat, newindex, fe.source_context);
var stat = new statement_list(indexvar,fe2);
ReplaceUsingParent(fe, stat);

2
SyntaxVisitors/SugarVisitors/NewRangeDesugarVisitor.cs
View file

@ -59,7 +59,7 @@ namespace SyntaxVisitors.SugarVisitors
public override void visit(foreach_stmt fe)
{
if (fe.in_what is diapason_expr_new diap)
if (fe.in_what is diapason_expr_new diap && fe.index == null)
{
var from = diap.left;
var typ = fe.type_name;

93
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -1501,6 +1501,11 @@ function GetEXEFileName: string;
/// Преобразует указатель к строковому представлению
function PointerToString(p: pointer): string;
/// Для типа System.Type возвращает имя типа объекта
function TypeToTypeName(t: System.Type): string;
/// Возвращает имя типа объекта
function TypeName(o: Object): string;
/// Запускает программу или документ с именем fileName
procedure Exec(fileName: string);
/// Запускает программу или документ с именем fileName и параметрами командной строки args
@ -7611,7 +7616,6 @@ begin
TypeCode.UInt64: Result := ReadUInt64;
TypeCode.SByte: Result := ReadSByte;
TypeCode.Single: Result := ReadSingle;
end;
end
else if t.IsEnum then Result := f.br.ReadInt32
@ -13136,6 +13140,93 @@ begin
Result := L.Select(i -> i - 1)
end;
/// Для типа System.Type возвращает имя типа объекта
function TypeToTypeName(t: System.Type): string;
begin
if t.IsPrimitive then
case System.Type.GetTypeCode(t) of
TypeCode.Boolean: Result := 'boolean';
TypeCode.Char: Result := 'char';
TypeCode.Byte: Result := 'byte';
TypeCode.Int16: Result := 'smallint';
TypeCode.Int32: Result := 'integer';
TypeCode.Int64: Result := 'int64';
TypeCode.UInt16: Result := 'word';
TypeCode.UInt32: Result := 'longword';
TypeCode.UInt64: Result := 'uint64';
TypeCode.SByte: Result := 'shortint';
TypeCode.Double: Result := 'real';
TypeCode.Single: Result := 'single';
end
else if t = typeof(string) then
Result := 'string'
else if t = typeof(decimal) then
Result := 'decimal'
else if t.IsArray then
begin
var ts := t.ToString;
var dims := ts.MatchValue('\[,*\]');
if dims = '[]' then
dims := ''
else dims := dims + ' ';
Result := 'array ' + dims + 'of ' + TypeToTypeName(t.GetElementType);
end
else if t.IsGenericType then
begin
var name := t.ToString.MatchValue('\w+(?=`)');
var ss := t.GetGenericArguments.Select(x->TypeToTypeName(x));
if name = 'Tuple' then
Result := '('+ss.JoinToString(',')+')'
else if name = 'Func' then
begin
if ss.Count = 1 then
Result := '() -> '+ ss.Last
else if ss.Count = 2 then
Result := ss.First + ' -> '+ ss.Last
else
Result := '('+ss.SkipLast.JoinToString(',')+') -> '+ ss.Last;
end
else if name = 'Action' then
begin
if ss.Count = 1 then
Result := ss.First + ' -> ()'
else
Result := '('+ss.JoinToString(',')+') -> ()';
end
else Result := name + '<'+ss.JoinToString(',')+'>'
end
else
begin
//Всё остальное
var s := t.ToString;
if s = 'System.Action' then
begin
Result := 'procedure';
exit;
end;
var ind := s.LastIndexOf('.');
if ind >= 0 then
s := s.Substring(ind + 1);
Result := s;
end;
end;
/// Возвращает имя типа объекта
function TypeName(o: Object): string;
begin
if o = nil then
Result := 'nil'
else if o is System.Reflection.Pointer then
Result := 'pointer'
else if o.GetType.GetField('NullBasedArray') <> nil then
begin
// неточно для двумерных массивов
var fi := o.GetType.GetField('NullBasedArray');
var f := fi.GetValue(o).GetType;
Result := TypeToTypeName(f);
end
else Result := TypeToTypeName(o.GetType);
end;
///--
function CreateSliceFromStringInternal(Self: string; from, step, count: integer): string;

25
TestSuite/CompilationSamples/School.pas
View file

@ -970,6 +970,17 @@ end;
procedure SwapSubstr(var Self: string; ss1, ss2: string);
extensionmethod := SwapSubstr(Self, ss1, ss2);
function InternalConvertTupleString(s: string): string;
begin
var tt := '([\w.`<>\[\],()]+?)';
s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)');
s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)');
s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)');
s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)');
s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)');
Result := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)');
end;
function InternalConvertTypeString(s: string): string;
begin
s := s.Replace('System.Int32','integer');
@ -984,18 +995,8 @@ begin
s := Regex.Replace(s,$'{tt}\[,\]','array [,] of $1');
s := Regex.Replace(s,$'System.Collections.Generic.(Dictionary|SortedDictionary)`2\[{tt},{tt}\]','$1<$2,$3>');
s := Regex.Replace(s,$'System.Collections.Generic.(List|Stack|Queue|HashSet|SortedSet)`1\[{tt}\]','$1<$2>');
s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)');
s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)');
s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)');
s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)');
s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)');
s := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)');
s := Regex.Replace(s,$'System.Tuple`2\[{tt},{tt}\]','($1,$2)');
s := Regex.Replace(s,$'System.Tuple`3\[{tt},{tt},{tt}\]','($1,$2,$3)');
s := Regex.Replace(s,$'System.Tuple`4\[{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4)');
s := Regex.Replace(s,$'System.Tuple`5\[{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5)');
s := Regex.Replace(s,$'System.Tuple`6\[{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6)');
s := Regex.Replace(s,$'System.Tuple`7\[{tt},{tt},{tt},{tt},{tt},{tt},{tt}\]','($1,$2,$3,$4,$5,$6,$7)');
s := InternalConvertTupleString(s);
s := InternalConvertTupleString(s);
Result := s;
end;

4
TestSuite/CompilationSamples/WPFObjects.pas
View file

@ -275,7 +275,7 @@ type
/// Угол поворота графического объекта (по часовой стрелке)
property RotateAngle: real read InvokeReal(()->rot.Angle) write Invoke(procedure->begin rot.CenterX := Width/2; rot.CenterY := Height/2; rot.Angle := value end);
/// Множитель масштабирования объекта
property ScaleFactor: real read InvokeReal(()->sca.ScaleX) write Invoke(()->begin (sca.ScaleX, sca.ScaleY) := (value,value); end);
property ScaleFactor: real read InvokeReal(()->sca.ScaleX) write Invoke(()->begin sca.CenterX := Width/2; sca.CenterY := Height/2; (sca.ScaleX, sca.ScaleY) := (value,value); end);
// Центр поворота графического объекта - запретил, т.к. это будет сбивать координаты объекта
{property RotateCenter: Point
read Invoke&<Point>(()->new Point(rot.CenterX,rot.CenterY))
@ -366,6 +366,8 @@ type
procedure AnimScaleP(a,sec: real);
begin
var an := new DoubleAnimation(a, System.TimeSpan.FromSeconds(sec));
sca.CenterX := Width / 2;
sca.CenterY := Height / 2;
sca.BeginAnimation(ScaleTransform.ScaleXProperty, an, HandoffBehavior.Compose);
sca.BeginAnimation(ScaleTransform.ScaleYProperty, an, HandoffBehavior.Compose);
end;

8
TestSuite/for_step2.pas Normal file
View file

@ -0,0 +1,8 @@
begin
var l := new List<integer>;
for var i:=1 to 5 step 2 do
begin
l.Add(i);
end;
Assert(l.SequenceEqual(Arr(1,3,5)));
end.

17
TestSuite/foreach_index1.pas Normal file
View file

@ -0,0 +1,17 @@
begin
var l := new List<integer>;
foreach var x in Arr(1,3,5) index i do
begin
l.Add(x);
l.Add(i);
end;
Assert(l.SequenceEqual(Arr(1,0,3,1,5,2)));
l := new List<integer>;
foreach var x in 1..3 index i do
begin
l.Add(x);
l.Add(i);
end;
Assert(l.SequenceEqual(Arr(1,0,2,1,3,2)));
end.

10
TestSuite/foreach_index2.pas Normal file
View file

@ -0,0 +1,10 @@
begin
var l := new List<integer>;
foreach var x in Arr(1,3,5) index i do
begin
l.Add(x);
l.Add(i);
continue;
end;
Assert(l.SequenceEqual(Arr(1,0,3,1,5,2)));
end.