mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 07:09:29 +02:00
pastojs: external class bracket accessor
git-svn-id: trunk@35738 -
This commit is contained in:
Mattias Gaertner
parent
972b24286d
commit
07c98e816f
@ -188,6 +188,7 @@ Works:
|
||||
- Pascal descendant can override newinstance
|
||||
- any class can be typecasted to any root class
|
||||
- class instances cannot access external class members (e.g. static class functions)
|
||||
- external class bracket accessor, getter/setter has external name '[]'
|
||||
- external class 'Array' bracket operator [integer] type jsvalue
|
||||
- external class 'Object' bracket operator [string] type jsvalue
|
||||
- jsvalue
|
||||
@ -214,11 +215,8 @@ Works:
|
||||
- use 0o for octal literals
|
||||
|
||||
ToDos:
|
||||
- using external class must not mark the unit as used
|
||||
- compiler error code only when option -Jsomething given for fpc compatibility
|
||||
- -Jirtl.js-
|
||||
- make -Jirtl.js default for -Jc and -Tnodejs
|
||||
- external class array accessor: pass by ref
|
||||
- make -Jirtl.js default for -Jc and -Tnodejs, needs #IFDEF in cfg
|
||||
- remove 'Object' array workaround
|
||||
- FuncName:= (instead of Result:=)
|
||||
- ord(s[i]) -> s.charCodeAt(i)
|
||||
@ -307,7 +305,7 @@ const
|
||||
nNewInstanceFunctionMustBeVirtual = 4016;
|
||||
nNewInstanceFunctionMustHaveTwoParameters = 4017;
|
||||
nNewInstanceFunctionMustNotHaveOverloads = 4018;
|
||||
nArrayAccessorOfExternalClassMustHaveOneParameter = 4019;
|
||||
nBracketAccessorOfExternalClassMustHaveOneParameter = 4019;
|
||||
// resourcestring patterns of messages
|
||||
resourcestring
|
||||
sPasElementNotSupported = 'Pascal element not supported: %s';
|
||||
@ -328,10 +326,10 @@ resourcestring
|
||||
sNewInstanceFunctionMustBeVirtual = 'NewInstance function must be virtual';
|
||||
sNewInstanceFunctionMustHaveTwoParameters = 'NewInstance function must have two parameters';
|
||||
sNewInstanceFunctionMustNotHaveOverloads = 'NewInstance function must not have overloads';
|
||||
sArrayAccessorOfExternalClassMustHaveOneParameter = 'Array accessor of external class must have one parameter';
|
||||
sBracketAccessorOfExternalClassMustHaveOneParameter = 'Bracket accessor of external class must have one parameter';
|
||||
|
||||
const
|
||||
ExtClassArrayAccessor = 'Array'; // external name 'Array' marks the array param getter/setter
|
||||
ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
|
||||
|
||||
type
|
||||
TPas2JSBuiltInName = (
|
||||
@ -702,7 +700,7 @@ type
|
||||
function ExtractPasStringLiteral(El: TPasElement; const S: String): TJSString; virtual;
|
||||
function ComputeConst(Expr: TPasExpr; StoreCustomData: boolean): TJSValue; virtual;
|
||||
function ComputeConstString(Expr: TPasExpr; StoreCustomData, NotEmpty: boolean): String; virtual;
|
||||
function IsExternalArrayAccessor(El: TPasElement): boolean;
|
||||
function IsExternalBracketAccessor(El: TPasElement): boolean;
|
||||
// CustomData
|
||||
function GetElementData(El: TPasElementBase;
|
||||
DataClass: TPas2JsElementDataClass): TPas2JsElementData; virtual;
|
||||
@ -1698,30 +1696,30 @@ end;
|
||||
procedure TPas2JSResolver.FinishPropertyOfClass(PropEl: TPasProperty);
|
||||
var
|
||||
Getter, Setter: TPasElement;
|
||||
GetterIsArrayAccessor, SetterIsArrayAcessor: Boolean;
|
||||
GetterIsBracketAccessor, SetterIsBracketAccessor: Boolean;
|
||||
Arg: TPasArgument;
|
||||
ArgResolved: TPasResolverResult;
|
||||
begin
|
||||
inherited FinishPropertyOfClass(PropEl);
|
||||
Getter:=GetPasPropertyGetter(PropEl);
|
||||
GetterIsArrayAccessor:=IsExternalArrayAccessor(Getter);
|
||||
GetterIsBracketAccessor:=IsExternalBracketAccessor(Getter);
|
||||
Setter:=GetPasPropertySetter(PropEl);
|
||||
SetterIsArrayAcessor:=IsExternalArrayAccessor(Setter);
|
||||
if GetterIsArrayAccessor then
|
||||
SetterIsBracketAccessor:=IsExternalBracketAccessor(Setter);
|
||||
if GetterIsBracketAccessor then
|
||||
begin
|
||||
if PropEl.Args.Count<>1 then
|
||||
RaiseMsg(20170403001743,nArrayAccessorOfExternalClassMustHaveOneParameter,
|
||||
sArrayAccessorOfExternalClassMustHaveOneParameter,
|
||||
RaiseMsg(20170403001743,nBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
sBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
[],PropEl);
|
||||
end;
|
||||
if SetterIsArrayAcessor then
|
||||
if SetterIsBracketAccessor then
|
||||
begin
|
||||
if PropEl.Args.Count<>1 then
|
||||
RaiseMsg(20170403001806,nArrayAccessorOfExternalClassMustHaveOneParameter,
|
||||
sArrayAccessorOfExternalClassMustHaveOneParameter,
|
||||
RaiseMsg(20170403001806,nBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
sBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
[],PropEl);
|
||||
end;
|
||||
if GetterIsArrayAccessor or SetterIsArrayAcessor then
|
||||
if GetterIsBracketAccessor or SetterIsBracketAccessor then
|
||||
begin
|
||||
Arg:=TPasArgument(PropEl.Args[0]);
|
||||
if not (Arg.Access in [argDefault,argConst]) then
|
||||
@ -2397,14 +2395,14 @@ begin
|
||||
Result:=String(V.AsString);
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.IsExternalArrayAccessor(El: TPasElement): boolean;
|
||||
function TPas2JSResolver.IsExternalBracketAccessor(El: TPasElement): boolean;
|
||||
var
|
||||
ExtName: String;
|
||||
begin
|
||||
if (not (El is TPasProcedure)) or (TPasProcedure(El).LibrarySymbolName=nil) then
|
||||
exit(false);
|
||||
ExtName:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,false,false);
|
||||
Result:=ExtName=ExtClassArrayAccessor;
|
||||
Result:=ExtName=ExtClassBracketAccessor;
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.GetElementData(El: TPasElementBase;
|
||||
@ -4168,7 +4166,7 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function IsJSArrayAccessorAndConvert(Prop: TPasProperty;
|
||||
function IsJSBracketAccessorAndConvert(Prop: TPasProperty;
|
||||
AccessEl: TPasElement;
|
||||
AContext: TConvertContext; ChompPropName: boolean): boolean;
|
||||
// If El.Value contains property name set ChompPropName = true
|
||||
@ -4179,13 +4177,13 @@ var
|
||||
Ref: TResolvedReference;
|
||||
Path: String;
|
||||
begin
|
||||
if not AContext.Resolver.IsExternalArrayAccessor(AccessEl) then
|
||||
if not AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
|
||||
exit(false);
|
||||
Result:=true;
|
||||
// array accessor of external class
|
||||
// bracket accessor of external class
|
||||
if Prop.Args.Count<>1 then
|
||||
RaiseInconsistency(20170403003753);
|
||||
// array accessor of external class -> create PathEl[param]
|
||||
// bracket accessor of external class -> create PathEl[param]
|
||||
Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,Prop));
|
||||
try
|
||||
PathEl:=El.Value;
|
||||
@ -4252,7 +4250,7 @@ var
|
||||
caAssign:
|
||||
begin
|
||||
AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
|
||||
if IsJSArrayAccessorAndConvert(Prop,AccessEl,AContext,true) then
|
||||
if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
|
||||
exit;
|
||||
AssignContext:=AContext.AccessContext as TAssignContext;
|
||||
AssignContext.PropertyEl:=Prop;
|
||||
@ -4262,7 +4260,7 @@ var
|
||||
caRead:
|
||||
begin
|
||||
AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
|
||||
if IsJSArrayAccessorAndConvert(Prop,AccessEl,AContext,true) then
|
||||
if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
|
||||
exit;
|
||||
end
|
||||
else
|
||||
@ -4322,32 +4320,38 @@ var
|
||||
DotContext: TDotContext;
|
||||
Left, Right: TJSElement;
|
||||
OldAccess: TCtxAccess;
|
||||
AccessEl: TPasElement;
|
||||
AccessEl, SetAccessEl: TPasElement;
|
||||
begin
|
||||
case AContext.Access of
|
||||
caAssign:
|
||||
begin
|
||||
AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
|
||||
if IsJSArrayAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
exit;
|
||||
end;
|
||||
caRead:
|
||||
begin
|
||||
AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
|
||||
if IsJSArrayAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
exit;
|
||||
end;
|
||||
{caByReference:
|
||||
caByReference:
|
||||
begin
|
||||
ParamContext:=AContext.AccessContext as TParamContext;
|
||||
//ParamContext:=AContext.AccessContext as TParamContext;
|
||||
AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
|
||||
SetAccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
|
||||
if IsJSArrayAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
if AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
|
||||
begin
|
||||
|
||||
if AContext.Resolver.IsExternalBracketAccessor(SetAccessEl) then
|
||||
begin
|
||||
// read and write are brackets -> easy
|
||||
if not IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
|
||||
RaiseNotSupported(El,AContext,20170405090845);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
RaiseNotSupported(El,AContext,20170403000550);
|
||||
end;}
|
||||
end;
|
||||
else
|
||||
RaiseNotSupported(El,AContext,20170402233834);
|
||||
end;
|
||||
|
||||
@ -367,12 +367,16 @@ type
|
||||
Procedure TestExternalClass_NewInstance_NonVirtualFail;
|
||||
Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
|
||||
Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
|
||||
Procedure TestExternalClass_PascalProperty;
|
||||
Procedure TestExternalClass_TypeCastToRootClass;
|
||||
Procedure TestExternalClass_TypeCastStringToExternalString;
|
||||
Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
|
||||
Procedure TestExternalClass_BracketOperatorOld;
|
||||
Procedure TestExternalClass_BracketOperator;
|
||||
// ToDo: check array accessors has one parameter
|
||||
Procedure TestExternalClass_BracketAccessor;
|
||||
Procedure TestExternalClass_BracketAccessor_2ParamsFail;
|
||||
Procedure TestExternalClass_BracketAccessor_ReadOnly;
|
||||
Procedure TestExternalClass_BracketAccessor_WriteOnly;
|
||||
Procedure TestExternalClass_BracketAccessor_MultiType;
|
||||
|
||||
// proc types
|
||||
Procedure TestProcType;
|
||||
@ -8516,6 +8520,52 @@ begin
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_PascalProperty;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSElement = class;');
|
||||
Add(' TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
|
||||
Add(' TJSElement = class external name ''ExtA''');
|
||||
Add(' end;');
|
||||
Add(' TControl = class(TJSElement)');
|
||||
Add(' private');
|
||||
Add(' FOnClick: TJSNotifyEvent;');
|
||||
Add(' property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
|
||||
Add(' procedure Click(Sender: TJSElement);');
|
||||
Add(' end;');
|
||||
Add('procedure TControl.Click(Sender: TJSElement);');
|
||||
Add('begin');
|
||||
Add(' OnClick(Self);');
|
||||
Add('end;');
|
||||
Add('var');
|
||||
Add(' Ctrl: TControl;');
|
||||
Add('begin');
|
||||
Add(' Ctrl.OnClick:=@Ctrl.Click;');
|
||||
Add(' Ctrl.OnClick(Ctrl);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_PascalProperty',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClassExt(this, "TControl", ExtA, "", function () {',
|
||||
' this.$init = function () {',
|
||||
' this.FOnClick = null;',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' this.FOnClick = undefined;',
|
||||
' };',
|
||||
' this.Click = function (Sender) {',
|
||||
' this.FOnClick(this);',
|
||||
' };',
|
||||
'});',
|
||||
'this.Ctrl = null;',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.Ctrl.FOnClick = rtl.createCallback(this.Ctrl, "Click");',
|
||||
'this.Ctrl.FOnClick(this.Ctrl);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_TypeCastToRootClass;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -8711,14 +8761,14 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_BracketOperator;
|
||||
procedure TTestModule.TestExternalClass_BracketAccessor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSArray = class external name ''Array2''');
|
||||
Add(' function GetItems(Index: longint): jsvalue; external name ''Array'';');
|
||||
Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''Array'';');
|
||||
Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
|
||||
Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
|
||||
Add(' property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
|
||||
Add(' end;');
|
||||
Add('procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);');
|
||||
@ -8737,7 +8787,7 @@ begin
|
||||
Add(' arr[5]:=arr[6];');
|
||||
Add(' arr.items[7]:=arr.items[8];');
|
||||
Add(' with arr do items[9]:=items[10];');
|
||||
//Add(' doit(arr[7],arr[8],arr[9],arr[10]);');
|
||||
Add(' doit(arr[7],arr[8],arr[9],arr[10]);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_BracketOperator',
|
||||
LinesToStr([ // statements
|
||||
@ -8758,6 +8808,154 @@ begin
|
||||
'this.Arr[7] = this.Arr[8];',
|
||||
'var $with1 = this.Arr;',
|
||||
'$with1[9] = $with1[10];',
|
||||
'this.DoIt(this.Arr[7], this.Arr[8], {',
|
||||
' a: 9,',
|
||||
' p: this.Arr,',
|
||||
' get: function () {',
|
||||
' return this.p[this.a];',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p[this.a] = v;',
|
||||
' }',
|
||||
'}, {',
|
||||
' a: 10,',
|
||||
' p: this.Arr,',
|
||||
' get: function () {',
|
||||
' return this.p[this.a];',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p[this.a] = v;',
|
||||
' }',
|
||||
'});',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSArray = class external name ''Array2''');
|
||||
Add(' function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
|
||||
Add(' procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
|
||||
Add(' property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
nBracketAccessorOfExternalClassMustHaveOneParameter);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSArray = class external name ''Array2''');
|
||||
Add(' function GetItems(Index: longint): jsvalue; external name ''[]'';');
|
||||
Add(' property Items[Index: longint]: jsvalue read GetItems; default;');
|
||||
Add(' end;');
|
||||
Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
|
||||
Add('begin end;');
|
||||
Add('var');
|
||||
Add(' Arr: tjsarray;');
|
||||
Add(' v: jsvalue;');
|
||||
Add('begin');
|
||||
Add(' v:=arr[0];');
|
||||
Add(' v:=arr.items[1];');
|
||||
Add(' with arr do v:=items[2];');
|
||||
Add(' doit(arr[3],arr[4]);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
|
||||
LinesToStr([ // statements
|
||||
'this.DoIt = function (vI, vJ) {',
|
||||
'};',
|
||||
'this.Arr = null;',
|
||||
'this.v = undefined;',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.v = this.Arr[0];',
|
||||
'this.v = this.Arr[1];',
|
||||
'var $with1 = this.Arr;',
|
||||
'this.v = $with1[2];',
|
||||
'this.DoIt(this.Arr[3], this.Arr[4]);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSArray = class external name ''Array2''');
|
||||
Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
|
||||
Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
|
||||
Add(' end;');
|
||||
Add('var');
|
||||
Add(' Arr: tjsarray;');
|
||||
Add(' s: string;');
|
||||
Add(' i: longint;');
|
||||
Add(' v: jsvalue;');
|
||||
Add('begin');
|
||||
Add(' arr[2]:=s;');
|
||||
Add(' arr.items[3]:=s;');
|
||||
Add(' arr[4]:=i;');
|
||||
Add(' with arr do items[5]:=i;');
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
|
||||
LinesToStr([ // statements
|
||||
'this.Arr = null;',
|
||||
'this.s = "";',
|
||||
'this.i = 0;',
|
||||
'this.v = undefined;',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.Arr[2] = this.s;',
|
||||
'this.Arr[3] = this.s;',
|
||||
'this.Arr[4] = this.i;',
|
||||
'var $with1 = this.Arr;',
|
||||
'$with1[5] = this.i;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('{$modeswitch externalclass}');
|
||||
Add('type');
|
||||
Add(' TJSArray = class external name ''Array2''');
|
||||
Add(' procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
|
||||
Add(' property Items[Index: longint]: jsvalue write SetItems; default;');
|
||||
Add(' procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
|
||||
Add(' property Numbers[Index: longint]: longint write SetNumbers;');
|
||||
Add(' end;');
|
||||
Add('var');
|
||||
Add(' Arr: tjsarray;');
|
||||
Add(' s: string;');
|
||||
Add(' i: longint;');
|
||||
Add(' v: jsvalue;');
|
||||
Add('begin');
|
||||
Add(' arr[2]:=s;');
|
||||
Add(' arr.items[3]:=s;');
|
||||
Add(' arr.numbers[4]:=i;');
|
||||
Add(' with arr do items[5]:=i;');
|
||||
Add(' with arr do numbers[6]:=i;');
|
||||
ConvertProgram;
|
||||
CheckSource('TestExternalClass_BracketAccessor_MultiType',
|
||||
LinesToStr([ // statements
|
||||
'this.Arr = null;',
|
||||
'this.s = "";',
|
||||
'this.i = 0;',
|
||||
'this.v = undefined;',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.Arr[2] = this.s;',
|
||||
'this.Arr[3] = this.s;',
|
||||
'this.Arr[4] = this.i;',
|
||||
'var $with1 = this.Arr;',
|
||||
'$with1[5] = this.i;',
|
||||
'var $with2 = this.Arr;',
|
||||
'$with2[6] = this.i;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user