pastojs: external class bracket accessor

git-svn-id: trunk@35738 -

packages/pastojs/src/fppas2js.pp

@@ -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;

packages/pastojs/tests/tcmodules.pas

@@ -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:[email protected];');
+  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;