paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-21 19:53:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: (a as b)[]

Browse Source 
git-svn-id: trunk@45966 -
This commit is contained in:
Mattias Gaertner 2020-07-29 22:14:07 +00:00
parent ebf35bcac4
commit 8dbf8ae823
1 changed files with 60 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
packages/pastojs/tests/tcmodules.pas
View File

@ -513,7 +513,8 @@ type
Procedure TestClass_Property_IndexSpec; Procedure TestClass_Property_IndexSpec;
Procedure TestClass_PropertyOfTypeArray; Procedure TestClass_PropertyOfTypeArray;
Procedure TestClass_PropertyDefault; Procedure TestClass_PropertyDefault;
Procedure TestClass_PropertyDefault2; Procedure TestClass_PropertyDefault_TypecastToOtherDefault;
//Procedure TestClass_PropertyDefault;
Procedure TestClass_PropertyOverride; Procedure TestClass_PropertyOverride;
Procedure TestClass_PropertyIncVisibility; Procedure TestClass_PropertyIncVisibility;
Procedure TestClass_Assigned; Procedure TestClass_Assigned;
@ -13158,32 +13159,34 @@ end;
procedure TTestModule.TestClass_Property_Indexed; procedure TTestModule.TestClass_Property_Indexed;
begin begin
StartProgram(false); StartProgram(false);
Add('type'); Add([
Add(' TObject = class'); 'type',
Add(' FItems: array of longint;'); ' TObject = class',
Add(' function GetItems(Index: longint): longint;'); ' FItems: array of longint;',
Add(' procedure SetItems(Index: longint; Value: longint);'); ' function GetItems(Index: longint): longint;',
Add(' procedure DoIt;'); ' procedure SetItems(Index: longint; Value: longint);',
Add(' property Items[Index: longint]: longint read getitems write setitems;'); ' procedure DoIt;',
Add(' end;'); ' property Items[Index: longint]: longint read getitems write setitems;',
Add('function tobject.getitems(index: longint): longint;'); ' end;',
Add('begin'); 'function tobject.getitems(index: longint): longint;',
Add(' Result:=fitems[index];'); 'begin',
Add('end;'); ' Result:=fitems[index];',
Add('procedure tobject.setitems(index: longint; value: longint);'); 'end;',
Add('begin'); 'procedure tobject.setitems(index: longint; value: longint);',
Add(' fitems[index]:=value;'); 'begin',
Add('end;'); ' fitems[index]:=value;',
Add('procedure tobject.doit;'); 'end;',
Add('begin'); 'procedure tobject.doit;',
Add(' items[1]:=2;'); 'begin',
Add(' items[3]:=items[4];'); ' items[1]:=2;',
Add(' self.items[5]:=self.items[6];'); ' items[3]:=items[4];',
Add(' items[items[7]]:=items[items[8]];'); ' self.items[5]:=self.items[6];',
Add('end;'); ' items[items[7]]:=items[items[8]];',
Add('var Obj: tobject;'); 'end;',
Add('begin'); 'var Obj: tobject;',
Add(' obj.Items[11]:=obj.Items[12];'); 'begin',
' obj.Items[11]:=obj.Items[12];',
'']);
ConvertProgram; ConvertProgram;
CheckSource('TestClass_Property_Indexed', CheckSource('TestClass_Property_Indexed',
LinesToStr([ // statements LinesToStr([ // statements
@ -13366,36 +13369,50 @@ begin
'type', 'type',
' TArray = array of longint;', ' TArray = array of longint;',
' TObject = class', ' TObject = class',
' end;',
' TBird = class',
' FItems: TArray;', ' FItems: TArray;',
' function GetItems(Index: longint): longint;', ' function GetItems(Index: longint): longint;',
' procedure SetItems(Index, Value: longint);', ' procedure SetItems(Index, Value: longint);',
' property Items[Index: longint]: longint read getitems write setitems; default;', ' property Items[Index: longint]: longint read getitems write setitems; default;',
' end;', ' end;',
'function tobject.getitems(index: longint): longint;', 'function TBird.getitems(index: longint): longint;',
'begin', 'begin',
'end;', 'end;',
'procedure tobject.setitems(index, value: longint);', 'procedure TBird.setitems(index, value: longint);',
'begin', 'begin',
' Self[1]:=2;', ' Self[1]:=2;',
' Self[3]:=Self[index];', ' Self[3]:=Self[index];',
' Self[index]:=Self[Self[value]];', ' Self[index]:=Self[Self[value]];',
' Self[Self[4]]:=value;', ' Self[Self[4]]:=value;',
'end;', 'end;',
'var Obj: tobject;', 'var',
' Bird: TBird;',
' Obj: TObject;',
'begin', 'begin',
' obj[11]:=12;', ' bird[11]:=12;',
' obj[13]:=obj[14];', ' bird[13]:=bird[14];',
' obj[obj[15]]:=obj[obj[15]];', ' bird[Bird[15]]:=bird[Bird[15]];',
' TObject(obj)[16]:=TObject(obj)[17];']); ' TBird(obj)[16]:=TBird(obj)[17];',
' (obj as tbird)[18]:=19;',
'']);
ConvertProgram; ConvertProgram;
CheckSource('TestClass_PropertyDefault', CheckSource('TestClass_PropertyDefault',
LinesToStr([ // statements LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {', 'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {', ' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
'});',
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
' this.$init = function () {',
' $mod.TObject.$init.call(this);',
' this.FItems = [];', ' this.FItems = [];',
' };', ' };',
' this.$final = function () {', ' this.$final = function () {',
' this.FItems = undefined;', ' this.FItems = undefined;',
' $mod.TObject.$final.call(this);',
' };', ' };',
' this.GetItems = function (Index) {', ' this.GetItems = function (Index) {',
' var Result = 0;', ' var Result = 0;',
@ -13408,17 +13425,19 @@ begin
' this.SetItems(this.GetItems(4), Value);', ' this.SetItems(this.GetItems(4), Value);',
' };', ' };',
'});', '});',
'this.Obj = null;' 'this.Bird = null;',
]), 'this.Obj = null;',
'']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
'$mod.Obj.SetItems(11, 12);', '$mod.Bird.SetItems(11, 12);',
'$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));', '$mod.Bird.SetItems(13, $mod.Bird.GetItems(14));',
'$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));', '$mod.Bird.SetItems($mod.Bird.GetItems(15), $mod.Bird.GetItems($mod.Bird.GetItems(15)));',
'$mod.Obj.SetItems(16, $mod.Obj.GetItems(17));', '$mod.Obj.SetItems(16, $mod.Obj.GetItems(17));',
'rtl.as($mod.Obj, $mod.TBird).SetItems(18, 19);',
''])); '']));
end; end;
procedure TTestModule.TestClass_PropertyDefault2; procedure TTestModule.TestClass_PropertyDefault_TypecastToOtherDefault;
begin begin
StartProgram(false); StartProgram(false);
Add([ Add([
@ -13451,7 +13470,7 @@ begin
' TBetaList(List[false])[5]:=nil;', ' TBetaList(List[false])[5]:=nil;',
'']); '']);
ConvertProgram; ConvertProgram;
CheckSource('TestClass_PropertyDefault2', CheckSource('TestClass_PropertyDefault_TypecastToOtherDefault',
LinesToStr([ // statements LinesToStr([ // statements
'rtl.createClass($mod, "TObject", null, function () {', 'rtl.createClass($mod, "TObject", null, function () {',
' this.$init = function () {', ' this.$init = function () {',