pastojs: external bracket accessor call, implemented simple calls and give error on others

git-svn-id: trunk@38973 -

packages/pastojs/src/fppas2js.pp

@@ -467,6 +467,7 @@ const
   nNestedInheritedNeedsParameters = 4022;
   nFreeNeedsVar = 4023;
   nDuplicateGUIDXInYZ = 4024;
+  nCantCallExtBracketAccessor = 4025;
 // resourcestring patterns of messages
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -493,6 +494,7 @@ resourcestring
   sNestedInheritedNeedsParameters = 'nested inherited needs parameters';
   sFreeNeedsVar = 'Free needs a variable';
   sDuplicateGUIDXInYZ = 'Duplicate GUID %s in %s and %s';
+  sCantCallExtBracketAccessor = 'cannot call external bracket accessor, use a property instead';
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -1253,6 +1255,7 @@ type
     ScannerBoolSwitches: TBoolSwitches;
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual;
     function GetRootModule: TPasModule;
+    function GetNonDotContext: TConvertContext;
     function GetFunctionContext: TFunctionContext;
     function GetLocalName(El: TPasElement): string; virtual;
     function GetSelfContext: TFunctionContext;
@@ -1553,6 +1556,7 @@ type
       RecordExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
     Function CreateCallback(El: TPasElement; ResolvedEl: TPasResolverResult;
       AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExternalBracketAccessorCall(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function CreateAssignStatement(LeftEl: TPasElement; AssignContext: TAssignContext): TJSElement; virtual;
     Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
       AContext: TConvertContext): TJSElement; virtual;
@@ -4602,6 +4606,13 @@ begin
     Result:=nil;
 end;
 
+function TConvertContext.GetNonDotContext: TConvertContext;
+begin
+  Result:=Self;
+  while Result is TDotContext do
+    Result:=Result.Parent;
+end;
+
 function TConvertContext.GetFunctionContext: TFunctionContext;
 begin
   Result:=TFunctionContext(GetContextOfType(TFunctionContext));
@@ -6087,10 +6098,13 @@ var
   ParamsExpr: TParamsExpr;
   RightEl: TPasExpr;
   RightRefDecl: TPasElement;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
 
   ParamsExpr:=nil;
+  // a.(RightEl.(b.c))
   RightEl:=El.right;
   while RightEl.ClassType=TParamsExpr do
     begin
@@ -6116,16 +6130,16 @@ begin
         Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
       exit;
       end
-    else if AContext.Resolver.IsTObjectFreeMethod(RightEl) then
+    else if aResolver.IsTObjectFreeMethod(RightEl) then
       begin
       Result:=ConvertTObjectFree(El,RightEl,AContext);
       exit;
       end;
     end;
 
-  if AContext.Resolver<>nil then
+  if aResolver<>nil then
     begin
-    AContext.Resolver.ComputeElement(El.left,LeftResolved,[]);
+    aResolver.ComputeElement(El.left,LeftResolved,[]);
     if LeftResolved.BaseType=btModule then
       begin
       // e.g. System.ExitCode
@@ -6390,6 +6404,8 @@ begin
     Result:=ConvertExternalConstructor(nil,Ref,nil,AContext);
     exit;
     end;
+  if aResolver.IsExternalBracketAccessor(Decl) then
+    DoError(20180511154132,nCantCallExtBracketAccessor,sCantCallExtBracketAccessor,[],El);
 
   if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
     begin
@@ -7464,9 +7480,7 @@ Var
 begin
   if El.Kind<>pekArrayParams then
     RaiseInconsistency(20170209113713,El);
-  ArgContext:=AContext;
-  while ArgContext is TDotContext do
-    ArgContext:=ArgContext.Parent;
+  ArgContext:=AContext.GetNonDotContext;
   if AContext.Resolver=nil then
     begin
     // without Resolver
@@ -7651,7 +7665,11 @@ begin
       exit;
       end
     else if C.InheritsFrom(TPasProcedure) then
-      TargetProcType:=TPasProcedure(Decl).ProcType
+      begin
+      TargetProcType:=TPasProcedure(Decl).ProcType;
+      if aResolver.IsExternalBracketAccessor(Decl) then
+        exit(ConvertExternalBracketAccessorCall(El,AContext));
+      end
     else if (C=TPasClassType)
         or (C=TPasClassOfType)
         or (C=TPasRecordType)
@@ -8484,9 +8502,7 @@ begin
   else
     begin
     Result:=nil;
-    ArgContext:=AContext;
-    while ArgContext is TDotContext do
-      ArgContext:=ArgContext.Parent;
+    ArgContext:=AContext.GetNonDotContext;
     Call:=CreateCallExpression(El);
     try
       Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]);
@@ -12927,6 +12943,63 @@ begin
   end;
 end;
 
+function TPasToJSConverter.ConvertExternalBracketAccessorCall(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Ref: TResolvedReference;
+  ArgContext: TConvertContext;
+  ok: Boolean;
+  AssignSt: TJSSimpleAssignStatement;
+  IndexJS: TJSElement;
+  WithData: TPas2JSWithExprScope;
+  Path: String;
+  BracketJS: TJSBracketMemberExpression;
+begin
+  Result:=nil;
+  if length(El.Params)<1 then
+    RaiseInconsistency(20180511151259,El);
+  if not (El.Value.CustomData is TResolvedReference) then
+    RaiseInconsistency(20180511144445,El);
+  Ref:=TResolvedReference(El.Value.CustomData);
+  ArgContext:=AContext.GetNonDotContext;
+  ok:=false;
+  try
+    // First convert index, because it may raise an exception
+    IndexJS:=ConvertElement(El.Params[0],ArgContext);
+
+    if Ref.WithExprScope<>nil then
+      begin
+      // with path do GetItems(astring) -> withtmp1[astring]
+      WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
+      Path:=WithData.WithVarName;
+      end
+    else
+      begin
+      // GetItems(astring) -> this[astring]
+      Path:='this';
+      end;
+    BracketJS:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    Result:=BracketJS;
+    BracketJS.Name:=IndexJS;
+    BracketJS.MExpr:=CreatePrimitiveDotExpr(Path,El);
+
+    if length(El.Params)>1 then
+      begin
+      // SetItems(astring,value) -> this[astring]:=value
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=Result;
+      Result:=AssignSt;
+      AssignSt.Expr:=ConvertElement(El.Params[1],ArgContext); // may raise an exception
+      end;
+
+    if length(El.Params)>2 then
+      DoError(20180511144047,nCantCallExtBracketAccessor,sCantCallExtBracketAccessor,[],El);
+    ok:=true;
+  finally
+    if not ok then Result.Free;
+  end;
+end;
+
 function TPasToJSConverter.CreateAssignStatement(LeftEl: TPasElement;
   AssignContext: TAssignContext): TJSElement;
 var
@@ -16896,9 +16969,7 @@ var
   OldAccess: TCtxAccess;
 begin
   // get context
-  ArgContext:=AContext;
-  while ArgContext is TDotContext do
-    ArgContext:=ArgContext.Parent;
+  ArgContext:=AContext.GetNonDotContext;
   i:=0;
   OldAccess:=ArgContext.Access;
   if TargetProc<>nil then

packages/pastojs/tests/tcmodules.pas

@@ -481,6 +481,7 @@ type
     Procedure TestExternalClass_TypeCastStringToExternalString;
     Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
     Procedure TestExternalClass_BracketAccessor;
+    Procedure TestExternalClass_BracketAccessor_Call;
     Procedure TestExternalClass_BracketAccessor_2ParamsFail;
     Procedure TestExternalClass_BracketAccessor_ReadOnly;
     Procedure TestExternalClass_BracketAccessor_WriteOnly;
@@ -12971,30 +12972,36 @@ end;
 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 ''[]'';');
-  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);');
-  Add('begin end;');
-  Add('var');
-  Add('  Arr: tjsarray;');
-  Add('  s: string;');
-  Add('  i: longint;');
-  Add('  v: jsvalue;');
-  Add('begin');
-  Add('  v:=arr[0];');
-  Add('  v:=arr.items[1];');
-  Add('  arr[2]:=s;');
-  Add('  arr.items[3]:=s;');
-  Add('  arr[4]:=i;');
-  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([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSArray = class external name ''Array2''',
+  '    function GetItems(Index: longint): jsvalue; external name ''[]'';',
+  '    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
+  '    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
+  '  end;',
+  'procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);',
+  'begin end;',
+  'var',
+  '  Arr: tjsarray;',
+  '  s: string;',
+  '  i: longint;',
+  '  v: jsvalue;',
+  'begin',
+  '  v:=arr[0];',
+  '  v:=arr.items[1];',
+  '  arr[2]:=s;',
+  '  arr.items[3]:=s;',
+  '  arr[4]:=i;',
+  '  arr[5]:=arr[6];',
+  '  arr.items[7]:=arr.items[8];',
+  '  with arr do items[9]:=items[10];',
+  '  doit(arr[7],arr[8],arr[9],arr[10]);',
+  '  with arr do begin',
+  '    v:=GetItems(14);',
+  '    setitems(15,16);',
+  '  end;',
+  '']);
   ConvertProgram;
   CheckSource('TestExternalClass_BracketAccessor',
     LinesToStr([ // statements
@@ -13034,6 +13041,81 @@ begin
     '      this.p[this.a] = v;',
     '    }',
     '});',
+    'var $with2 = $mod.Arr;',
+    '$mod.v = $with2[14];',
+    '$with2[15] = 16;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_Call;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSArray = class external name ''Array2''',
+  '    function GetItems(Index: longint): jsvalue; external name ''[]'';',
+  '    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';',
+  '    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;',
+  '  end;',
+  '  TMyArr = class(TJSArray)',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure tmyarr.DoIt;',
+  'begin',
+  '  Items[1]:=Items[2];',
+  '  SetItems(3,getItems(4));',
+  'end;',
+  'var',
+  '  Arr: tmyarr;',
+  '  s: string;',
+  '  i: longint;',
+  '  v: jsvalue;',
+  'begin',
+  '  v:=arr[0];',
+  '  v:=arr.items[1];',
+  '  arr[2]:=s;',
+  '  arr.items[3]:=s;',
+  '  arr[4]:=i;',
+  '  arr[5]:=arr[6];',
+  '  arr.items[7]:=arr.items[8];',
+  '  with arr do items[9]:=items[10];',
+  '  with arr do begin',
+  '    v:=GetItems(14);',
+  '    setitems(15,16);',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_Call',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TMyArr", Array2, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this[1] = this[2];',
+    '    this[3] = this[4];',
+    '  };',
+    '});',
+    'this.Arr = null;',
+    'this.s = "";',
+    'this.i = 0;',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.Arr[0];',
+    '$mod.v = $mod.Arr[1];',
+    '$mod.Arr[2] = $mod.s;',
+    '$mod.Arr[3] = $mod.s;',
+    '$mod.Arr[4] = $mod.i;',
+    '$mod.Arr[5] = $mod.Arr[6];',
+    '$mod.Arr[7] = $mod.Arr[8];',
+    'var $with1 = $mod.Arr;',
+    '$with1[9] = $with1[10];',
+    'var $with2 = $mod.Arr;',
+    '$mod.v = $with2[14];',
+    '$with2[15] = 16;',
     '']));
 end;