Prechádzať zdrojové kódy

* Patch from Mattias Gaertner:
pastree:
- allow custom data to be chained.
pparser:
- procedure modifier assembler
- Self[]
- Self.member
- fixed some wrong parents
pasresolver:
- aString[i]:=
- check proc external modifier
- test if WithExprScope is set
- Self[]
- Self.member
fppas2js:
- proc assembler modifier
- assigned(class-instance)
- class default property
- low(array), high(array)
- multi dim arrays [index1,index2] -> [index1][index2]
- string: read and write char aString[]
- procedure modifier external name 'funcname'
- option to add "use strict";
- with-do using local var
- with record do i:=v;
- with classinstance do begin create; i:=v; f(); i:=a[]; end;
- Self[]
- Self.member

git-svn-id: trunk@35428 -

michael 8 rokov pred
rodič
commit
bc22805000

+ 1 - 1
packages/fcl-js/src/jstree.pp

@@ -457,7 +457,7 @@ Type
 
   TJSVariableDeclarationList = Class(TJSBinary); // A->first variable, B->next in list, chained.
 
-  { TJSWithStatement }
+  { TJSWithStatement - with(A)do B; }
 
   TJSWithStatement = Class(TJSBinary); // A-> with expression, B->statement(s)
 

+ 38 - 17
packages/fcl-passrc/src/pasresolver.pp

@@ -460,14 +460,13 @@ type
 
   { TResolveData - base class for data stored in TPasElement.CustomData }
 
-  TResolveData = Class
+  TResolveData = Class(TPasElementBase)
   private
     FElement: TPasElement;
     procedure SetElement(AValue: TPasElement);
   public
     Owner: TObject; // e.g. a TPasResolver
     Next: TResolveData; // TPasResolver uses this for its memory chain
-    CustomData: TObject; // not used by TPasResolver, free for your extension
     constructor Create; virtual;
     destructor Destroy; override;
     property Element: TPasElement read FElement write SetElement;// Element.CustomData=Self
@@ -783,7 +782,8 @@ type
 
   TPasResolverResultFlag = (
     rrfReadable,
-    rrfWritable
+    rrfWritable,
+    rrfAssignable  // not writable in general, e.g. aString[1]:=
     );
   TPasResolverResultFlags = set of TPasResolverResultFlag;
 
@@ -2793,9 +2793,15 @@ begin
       end;
 
     // finish non method, i.e. interface/implementation/nested procedure/method declaration
+
     if not IsValidIdent(ProcName) then
       RaiseNotYetImplemented(20160922163407,El);
 
+    if Proc.LibraryExpr<>nil then
+      ResolveExpr(Proc.LibraryExpr);
+    if Proc.LibrarySymbolName<>nil then
+      ResolveExpr(Proc.LibrarySymbolName);
+
     if Proc.Parent is TPasClassType then
       begin
       FinishMethodDeclHeader(Proc);
@@ -2957,6 +2963,11 @@ var
   SelfArg: TPasArgument;
   p: Integer;
 begin
+  if ImplProc.IsExternal then
+    RaiseMsg(nInvalidProcModifiers,sInvalidProcModifiers,[ImplProc.ElementTypeName,'external'],ImplProc);
+  if ImplProc.IsExported then
+    RaiseMsg(nInvalidProcModifiers,sInvalidProcModifiers,[ImplProc.ElementTypeName,'export'],ImplProc);
+
   ProcName:=ImplProc.Name;
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishMethodBodyHeader searching declaration "',ProcName,'" ...');
@@ -4254,6 +4265,8 @@ begin
 
     // found compatible element -> create reference
     Ref:=CreateReference(FindCallData.Found,Params.Value);
+    if FindCallData.StartScope.ClassType=TPasWithExprScope then
+      Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
     FindData:=Default(TPRFindData);
     FindData.ErrorPosEl:=Params.Value;
     FindData.StartScope:=FindCallData.StartScope;
@@ -4288,41 +4301,48 @@ var
   FindData: TPRFindData;
   DeclEl: TPasElement;
   ResolvedEl, ResolvedArg: TPasResolverResult;
-  ArgExp: TPasExpr;
+  ArgExp, Value: TPasExpr;
   Ref: TResolvedReference;
   PropEl: TPasProperty;
   ClassScope: TPasClassScope;
   SubParams: TParamsExpr;
 begin
   DeclEl:=nil;
-  if (Params.Value.ClassType=TPrimitiveExpr)
-      and (TPrimitiveExpr(Params.Value).Kind=pekIdent) then
+  Value:=Params.Value;
+  if (Value.ClassType=TPrimitiveExpr)
+      and (TPrimitiveExpr(Value).Kind=pekIdent) then
     begin
     // e.g. Name[]
-    ArrayName:=TPrimitiveExpr(Params.Value).Value;
+    ArrayName:=TPrimitiveExpr(Value).Value;
     // find first
-    DeclEl:=FindElementWithoutParams(ArrayName,FindData,Params.Value,true);
+    DeclEl:=FindElementWithoutParams(ArrayName,FindData,Value,true);
     Ref:=CreateReference(DeclEl,Params.Value,@FindData);
     CheckFoundElement(FindData,Ref);
-    ComputeElement(Params.Value,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
+    ComputeElement(Value,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
     end
-  else if Params.Value.ClassType=TParamsExpr then
+  else if (Value.ClassType=TSelfExpr) then
+    begin
+    // e.g. Self[]
+    ResolveNameExpr(Value,'Self');
+    ComputeElement(Value,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
+    end
+  else if Value.ClassType=TParamsExpr then
     begin
     // e.g. Name()[] or Name[][]
-    SubParams:=TParamsExpr(Params.Value);
+    SubParams:=TParamsExpr(Value);
     if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
       begin
       ResolveExpr(SubParams);
       ComputeElement(SubParams,ResolvedEl,[rcSkipTypeAlias,rcReturnFuncResult]);
       end
     else
-      RaiseNotYetImplemented(20161010194925,Params.Value);
+      RaiseNotYetImplemented(20161010194925,Value);
     end
   else
-    RaiseNotYetImplemented(20160927212610,Params.Value);
+    RaiseNotYetImplemented(20160927212610,Value);
 
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.ResolveArrayParamsExpr Params.Value=',GetObjName(Params.Value),' ',GetResolverResultDesc(ResolvedEl));
+  writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDesc(ResolvedEl));
   {$ENDIF}
   if ResolvedEl.BaseType in btAllStrings then
     begin
@@ -5236,9 +5256,10 @@ begin
       ResolvedEl.BaseType:=btWideChar
     else
       ResolvedEl.BaseType:=btChar;
-    ResolvedEl.IdentEl:=nil;
+    // keep ResolvedEl.IdentEl the string var
     ResolvedEl.TypeEl:=FBaseTypes[ResolvedEl.BaseType];
     ResolvedEl.ExprEl:=Params;
+    ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfAssignable];
     end
   else if (ResolvedEl.IdentEl is TPasProperty)
       and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
@@ -6187,7 +6208,7 @@ begin
   inherited Create;
   FDefaultScope:=TPasDefaultScope.Create;
   FPendingForwards:=TFPList.Create;
-  FBaseTypeStringIndex:=btComp;
+  FBaseTypeStringIndex:=btChar;
   PushScope(FDefaultScope);
 end;
 
@@ -7281,7 +7302,7 @@ begin
       end;
     exit;
     end;
-  if (rrfWritable in ResolvedEl.Flags) then
+  if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
     exit(true);
   // not writable
   if not ErrorOnFalse then exit;

+ 24 - 8
packages/fcl-passrc/src/pastree.pp

@@ -82,9 +82,17 @@ type
   // Visitor pattern.
   TPassTreeVisitor = class;
 
+  { TPasElementBase }
+
   TPasElementBase = class
-    procedure Accept(Visitor: TPassTreeVisitor); virtual; abstract;
+  private
+    FData: TObject;
+  protected
+    procedure Accept(Visitor: TPassTreeVisitor); virtual;
+  public
+    Property CustomData : TObject Read FData Write FData;
   end;
+  TPasElementBaseClass = class of TPasElementBase;
 
 
   TPasModule = class;
@@ -109,7 +117,6 @@ type
 
   TPasElement = class(TPasElementBase)
   private
-    FData: TObject;
     FDocComment: String;
     FRefCount: LongWord;
     FName: string;
@@ -145,7 +152,6 @@ type
     property Name: string read FName write FName;
     property Parent: TPasElement read FParent Write FParent;
     Property Hints : TPasMemberHints Read FHints Write FHints;
-    Property CustomData : TObject Read FData Write FData;
     Property HintMessage : String Read FHintMessage Write FHintMessage;
     Property DocComment : String Read FDocComment Write FDocComment;
   end;
@@ -1313,17 +1319,20 @@ Type
     ExceptAddr : TPasExpr;
   end;
 
-  { TPassTreeVisitor }
-
-  TPassTreeVisitor = class
-    procedure Visit(obj: TPasElement); virtual;
-  end;
+  { TPasImplLabelMark }
 
   TPasImplLabelMark = class(TPasImplElement)
   public
     LabelId: AnsiString;
   end;
 
+  { TPassTreeVisitor }
+
+  TPassTreeVisitor = class
+  public
+    procedure Visit(obj: TPasElement); virtual;
+  end;
+
 const
   AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
   AllVisibilities: TPasMemberVisibilities =
@@ -1408,6 +1417,13 @@ begin
   El:=nil;
 end;
 
+{ TPasElementBase }
+
+procedure TPasElementBase.Accept(Visitor: TPassTreeVisitor);
+begin
+
+end;
+
 { TPasTypeRef }
 
 procedure TPasTypeRef.ForEachCall(const aMethodCall: TOnForEachPasElement;

+ 69 - 38
packages/fcl-passrc/src/pparser.pp

@@ -367,6 +367,7 @@ type
     procedure ParseStatement(Parent: TPasImplBlock;  out NewImplElement: TPasImplElement);
     procedure ParseLabels(AParent: TPasElement);
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
+    procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
     function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
     procedure ParseArgList(Parent: TPasElement;
@@ -1447,10 +1448,12 @@ var
 begin
   Result:=nil;
   if paramskind in [pekArrayParams, pekSet] then begin
-    if CurToken<>tkSquaredBraceOpen then Exit;
+    if CurToken<>tkSquaredBraceOpen then
+      ParseExc(nParserExpectTokenError,SParserExpectTokenError,['[']);
     PClose:=tkSquaredBraceClose;
   end else begin
-    if CurToken<>tkBraceOpen then Exit;
+    if CurToken<>tkBraceOpen then
+      ParseExc(nParserExpectTokenError,SParserExpectTokenError,['(']);
     PClose:=tkBraceClose;
   end;
 
@@ -1461,11 +1464,12 @@ begin
     if not isEndOfExp then begin
       repeat
         p:=DoParseExpression(params);
-        if not Assigned(p) then Exit; // bad param syntax
+        if not Assigned(p) then
+          ParseExcSyntaxError;
         params.AddParam(p);
         if (CurToken=tkColon) then
           if Not AllowFormatting then
-            ParseExcSyntaxError
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,[','])
           else
             begin
             NextToken;
@@ -1476,15 +1480,14 @@ begin
               p.format2:=DoParseExpression(p);
               end;
             end;
-        if not (CurToken in [tkComma, PClose]) then begin
-          Exit;
-        end;
+        if not (CurToken in [tkComma, PClose]) then
+          ParseExc(nParserExpectTokenError,SParserExpectTokenError,[',']);
 
         if CurToken = tkComma then begin
           NextToken;
           if CurToken = PClose then begin
             //ErrorExpected(parser, 'identifier');
-            Exit;
+            ParseExcSyntaxError;
           end;
         end;
       until CurToken=PClose;
@@ -1573,18 +1576,15 @@ begin
         b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone);
         if not Assigned(b.right) then
           begin
-          B.Release;
-          Exit; // error
+          b.Release;
+          ParseExcExpectedIdentifier;
           end;
         Last:=b;
-        UngetToken;
-        end
-      else
-        UngetToken;
+        end;
+      UngetToken;
       end;
     tkself:
       begin
-      //Last:=CreatePrimitiveExpr(AParent,pekString, CurTokenText); //function(self);
       Last:=CreateSelfExpr(AParent);
       NextToken;
       if CurToken = tkDot then
@@ -1594,8 +1594,8 @@ begin
         b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
         if not Assigned(b.right) then
           begin
-          B.Release;
-          Exit; // error
+          b.Release;
+          ParseExcExpectedIdentifier;
           end;
         Last:=b;
         end;
@@ -1633,7 +1633,7 @@ begin
 
   ok:=false;
   try
-    if Last.Kind=pekIdent then
+    if Last.Kind in [pekIdent,pekSelf] then
       begin
       while CurToken in [tkDot] do
         begin
@@ -1906,10 +1906,12 @@ end;
 
 function GetExprIdent(p: TPasExpr): String;
 begin
-  if Assigned(p) and (p is TPrimitiveExpr) and (p.Kind=pekIdent) then
+  Result:='';
+  if not Assigned(p) then exit;
+  if (p.ClassType=TPrimitiveExpr) and (p.Kind=pekIdent) then
     Result:=TPrimitiveExpr(p).Value
-  else
-    Result:='';
+  else if (p.ClassType=TSelfExpr) then
+    Result:='Self';
 end;
 
 function TPasParser.DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
@@ -2353,6 +2355,7 @@ var
   PT : TProcType;
   NamePos: TPasSourcePos;
   ok: Boolean;
+  Proc: TPasProcedure;
 
 begin
   CurBlock := declNone;
@@ -2586,6 +2589,9 @@ begin
         begin
         if Declarations is TProcedureBody then
           begin
+          Proc:=Declarations.Parent as TPasProcedure;
+          if pmAssembler in Proc.Modifiers then
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,['asm']);
           SetBlock(declNone);
           ParseProcBeginBlock(TProcedureBody(Declarations));
           break;
@@ -2600,6 +2606,20 @@ begin
         else
           ParseExcSyntaxError;
         end;
+      tkasm:
+        begin
+        if Declarations is TProcedureBody then
+          begin
+          Proc:=Declarations.Parent as TPasProcedure;
+          if not (pmAssembler in Proc.Modifiers) then
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,['begin']);
+          SetBlock(declNone);
+          ParseProcAsmBlock(TProcedureBody(Declarations));
+          break;
+          end
+        else
+          ParseExcSyntaxError;
+        end;
       tklabel:
         begin
           SetBlock(declNone);
@@ -3319,11 +3339,11 @@ begin
     NextToken;
     if CurToken in [tkString,tkIdentifier] then
       begin
-      // extrenal libname
+      // external libname
       // external libname name XYZ
       // external name XYZ
       Tok:=UpperCase(CurTokenString);
-      if Not ((curtoken=tkIdentifier) and (Tok='NAME')) then
+      if Not ((CurToken=tkIdentifier) and (Tok='NAME')) then
         begin
         E:=DoParseExpression(Parent);
         if Assigned(P) then
@@ -3334,7 +3354,7 @@ begin
       else
         begin
         Tok:=UpperCase(CurTokenString);
-        if ((curtoken=tkIdentifier) and (Tok='NAME')) then
+        if ((CurToken=tkIdentifier) and (Tok='NAME')) then
           begin
           NextToken;
           if not (CurToken in [tkString,tkIdentifier]) then
@@ -3789,7 +3809,6 @@ var
   BeginBlock: TPasImplBeginBlock;
   SubBlock: TPasImplElement;
 begin
-
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
   repeat
@@ -3809,7 +3828,17 @@ begin
 //  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
-procedure TPasParser.ParseAsmBlock(AsmBlock : TPasImplAsmStatement);
+procedure TPasParser.ParseProcAsmBlock(Parent: TProcedureBody);
+var
+  AsmBlock: TPasImplAsmStatement;
+begin
+  AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
+  Parent.Body:=AsmBlock;
+  ParseAsmBlock(AsmBlock);
+  ExpectToken(tkSemicolon);
+end;
+
+procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
 begin
   if po_asmwhole in Options then
     begin
@@ -3917,9 +3946,9 @@ begin
   while True do
   begin
     NextToken;
-    //WriteLn(i,'Token=',CurTokenText);
+    //WriteLn('Token=',CurTokenText);
     case CurToken of
-    tkasm :
+    tkasm:
       begin
       El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
       ParseAsmBlock(TPasImplAsmStatement(El));
@@ -3940,9 +3969,10 @@ begin
       begin
         NextToken;
         Left:=DoParseExpression(CurBlock);
-        UNgettoken;
+        UngetToken;
         El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
         TPasImplIfElse(El).ConditionExpr:=Left;
+        Left.Parent:=El;
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
         CreateBlock(TPasImplIfElse(El));
         ExpectToken(tkthen);
@@ -4003,8 +4033,8 @@ begin
       begin
         // while Condition do
         NextToken;
-        left:=DoParseExpression(Parent);
-        ungettoken;
+        left:=DoParseExpression(CurBlock);
+        UngetToken;
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
         El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
         TPasImplWhileDo(El).ConditionExpr:=left;
@@ -4013,7 +4043,7 @@ begin
       end;
     tkgoto:
       begin
-        nexttoken;
+        NextToken;
         curblock.AddCommand('goto '+curtokenstring);
         expecttoken(tkSemiColon);
       end;
@@ -4080,17 +4110,18 @@ begin
         // with Expr, Expr do
         SrcPos:=Scanner.CurSourcePos;
         NextToken;
-        Left:=DoParseExpression(Parent);
+        Left:=DoParseExpression(CurBlock);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
         El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
         TPasImplWithDo(El).AddExpression(Left);
+        Left.Parent:=El;
         CreateBlock(TPasImplWithDo(El));
         repeat
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
             ParseExcTokenError(TokenInfos[tkdo]);
           NextToken;
-          Left:=DoParseExpression(Parent);
+          Left:=DoParseExpression(CurBlock);
           //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
           TPasImplWithDo(CurBlock).AddExpression(Left);
         until false;
@@ -4098,7 +4129,7 @@ begin
     tkcase:
       begin
         NextToken;
-        Left:=DoParseExpression(Parent);
+        Left:=DoParseExpression(CurBlock);
         UngetToken;
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
@@ -4299,7 +4330,7 @@ begin
         if CurBlock is TPasImplRepeatUntil then
         begin
           NextToken;
-          Left:=DoParseExpression(Parent);
+          Left:=DoParseExpression(CurBlock);
           UngetToken;
           TPasImplRepeatUntil(CurBlock).ConditionExpr:=Left;
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
@@ -4308,7 +4339,7 @@ begin
           ParseExcSyntaxError;
       end;
     else
-      left:=DoParseExpression(Parent);
+      left:=DoParseExpression(CurBlock);
       case CurToken of
         tkAssign,
         tkAssignPlus,
@@ -4319,7 +4350,7 @@ begin
           // assign statement
           Ak:=TokenToAssignKind(CurToken);
           NextToken;
-          right:=DoParseExpression(Parent); // this may solve TPasImplWhileDo.AddElement BUG
+          right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
           El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
           left.Parent:=El;
           right.Parent:=El;

+ 146 - 21
packages/fcl-passrc/tests/tcresolver.pas

@@ -153,6 +153,10 @@ type
 
     // strings
     Procedure TestString_SetLength;
+    Procedure TestString_Element;
+    Procedure TestStringElement_MissingArgFail;
+    Procedure TestStringElement_IndexNonIntFail;
+    Procedure TestStringElement_AsVarArgFail;
 
     // enums
     Procedure TestEnums;
@@ -178,8 +182,6 @@ type
     Procedure TestBooleanOperators;
     Procedure TestStringOperators;
     Procedure TestFloatOperators;
-    Procedure TestStringElementMissingArgFail;
-    Procedure TestStringElementIndexNonIntFail;
     Procedure TestCAssignments;
     Procedure TestTypeCastBaseTypes;
     Procedure TestTypeCastStrToIntFail;
@@ -240,6 +242,7 @@ type
     Procedure TestExit;
     Procedure TestBreak;
     Procedure TestContinue;
+    Procedure TestProcedureExternal;
 
     // record
     Procedure TestRecord;
@@ -299,6 +302,7 @@ type
     Procedure TestClass_ConDestructor_CallInherited;
     Procedure TestClass_Constructor_Inherited;
     Procedure TestClass_SubObject;
+    Procedure TestClass_WithClassInstance;
 
     // class of
     Procedure TestClassOf;
@@ -1585,6 +1589,55 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestString_Element;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  if s[1]=s then ;');
+  Add('  if s=s[2] then ;');
+  Add('  if s[3+4]=c then ;');
+  Add('  if c=s[5] then ;');
+  Add('  c:=s[6];');
+  Add('  s[7]:=c;');
+  Add('  s[8]:=''a'';');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStringElement_MissingArgFail;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  if s[]=s then ;');
+  CheckResolverException('Missing parameter character index',PasResolver.nMissingParameterX);
+end;
+
+procedure TTestResolver.TestStringElement_IndexNonIntFail;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  if s[true]=s then ;');
+  CheckResolverException('Incompatible types: got "Boolean" expected "Char"',
+    PasResolver.nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestStringElement_AsVarArgFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(var c: char);');
+  Add('begin');
+  Add('end;');
+  Add('var s: string;');
+  Add('begin');
+  Add('  DoIt(s[1]);');
+  CheckResolverException('Variable identifier expected',
+    PasResolver.nVariableIdentifierExpected);
+end;
+
 procedure TTestResolver.TestEnums;
 begin
   StartProgram(false);
@@ -2121,25 +2174,6 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestStringElementMissingArgFail;
-begin
-  StartProgram(false);
-  Add('var s: string;');
-  Add('begin');
-  Add('  if s[]=s then ;');
-  CheckResolverException('Missing parameter character index',PasResolver.nMissingParameterX);
-end;
-
-procedure TTestResolver.TestStringElementIndexNonIntFail;
-begin
-  StartProgram(false);
-  Add('var s: string;');
-  Add('begin');
-  Add('  if s[true]=s then ;');
-  CheckResolverException('Incompatible types: got "Boolean" expected "Comp"',
-    PasResolver.nIncompatibleTypesGotExpected);
-end;
-
 procedure TTestResolver.TestCAssignments;
 begin
   StartProgram(false);
@@ -3060,6 +3094,23 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcedureExternal;
+begin
+  StartProgram(false);
+  Add('procedure {#ProcA}ProcA; external ''ExtProcA'';');
+  Add('function {#FuncB}FuncB: longint; external ''ExtFuncB'';');
+  Add('function {#FuncC}FuncC(d: double): string; external ''ExtFuncC'';');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  {@ProcA}ProcA;');
+  Add('  i:={@FuncB}FuncB;');
+  Add('  i:={@FuncB}FuncB();');
+  Add('  s:={@FuncC}FuncC(1.2);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);
@@ -4371,6 +4422,78 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestClass_WithClassInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualRefWith: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FInt: longint;');
+  Add('    FObj: TObject;');
+  Add('    FArr: array of longint;');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Size: longint read GetSize write SetSize;');
+  Add('    property Items[Index: longint]: longint read GetItems write SetItems;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin end;');
+  Add('procedure TObject.SetSize(Value: longint); begin end;');
+  Add('function TObject.GetItems(Index: longint): longint; begin end;');
+  Add('procedure TObject.SetItems(Index, Value: longint); begin end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    {#A}FInt:=3;');
+  Add('    i:={#B}FInt;');
+  Add('    i:={#C}GetSize;');
+  Add('    i:={#D}GetSize();');
+  Add('    {#E}SetSize(i);');
+  Add('    i:={#F}Size;');
+  Add('    {#G}Size:=i;');
+  Add('    i:={#H}Items[i];');
+  Add('    {#I}Items[i]:=i;');
+  Add('    i:={#J}FArr[i];');
+  Add('    {#K}FArr[i]:=i;');
+  Add('  end;');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualRefWith:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if Ref.WithExprScope=nil then continue;
+        ActualRefWith:=true;
+        break;
+        end;
+      if not ActualRefWith then
+        RaiseErrorAtSrcMarker('expected Ref.WithExprScope<>nil at "#'+aMarker^.Identifier+', but got nil"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestClassOf;
 begin
   StartProgram(false);
@@ -5142,6 +5265,8 @@ begin
   Add('end;');
   Add('procedure TObject.SetB(Index: longint; Value: longint);');
   Add('begin');
+  Add('  if Value=Self[Index] then ;');
+  Add('  Self[Index]:=Value;');
   Add('end;');
   Add('var o: TObject;');
   Add('begin');

Rozdielové dáta súboru neboli zobrazené, pretože súbor je príliš veľký
+ 531 - 140
packages/pastojs/src/fppas2js.pp


+ 7 - 5
packages/pastojs/tests/tcconverter.pp

@@ -268,7 +268,6 @@ begin
   E:=TJSExpressionStatement(Convert(R,TJSExpressionStatement));
   AssertNotNull('Have call node',E.A);
   AssertEquals('Have call expression',TJSCallExpression,E.A.ClassType);
-  AssertEquals('Have call expression',TJSCallExpression,E.A.ClassType);
   C:=TJSCallExpression(E.A);
   AssertIdentifier('Call expression',C.Expr,'a');
 end;
@@ -972,12 +971,15 @@ Procedure TTestExpressionConverter.TestBinaryDiv;
 Var
   B : TBinaryExpr;
   E : TJSMultiplicativeExpressionDiv;
-
+  C: TJSCallExpression;
+  Args: TJSArguments;
 begin
   B:=TBinaryExpr.Create(Nil,pekBinary,eopDiv);
   B.left:=CreateLiteral(1.23);
   B.Right:=CreateLiteral(3.45);
-  E:=TJSMultiplicativeExpressionDiv(TestBinaryExpression(B,TJSMultiplicativeExpressionDiv));
+  C:=TJSCallExpression(Convert(B,TJSCallExpression));
+  Args:=TJSArguments(AssertElement('Math.floor param',TJSArguments,C.Args));
+  E:=TJSMultiplicativeExpressionDiv(AssertElement('param',TJSMultiplicativeExpressionDiv,Args.Elements.Elements[0].Expr));
   AssertLiteral('Correct left literal for div',E.A,1.23);
   AssertLiteral('Correct right literal for div',E.B,3.45);
 end;
@@ -1013,13 +1015,13 @@ end;
 Procedure TTestExpressionConverter.TestBinarySHR;
 Var
   B : TBinaryExpr;
-  E : TJSRShiftExpression;
+  E : TJSURShiftExpression;
 
 begin
   B:=TBinaryExpr.Create(Nil,pekBinary,eopSHR);
   B.left:=CreateLiteral(13);
   B.Right:=CreateLiteral(3);
-  E:=TJSRShiftExpression(TestBinaryExpression(B,TJSRShiftExpression));
+  E:=TJSURShiftExpression(TestBinaryExpression(B,TJSURShiftExpression));
   AssertLiteral('Correct left literal for shr',E.A,13);
   AssertLiteral('Correct right literal for shr',E.B,3);
 end;

+ 644 - 14
packages/pastojs/tests/tcmodules.pas

@@ -136,7 +136,9 @@ type
   Published
     // modules
     Procedure TestEmptyProgram;
+    Procedure TestEmptyProgramUseStrict;
     Procedure TestEmptyUnit;
+    Procedure TestEmptyUnitUseStrict;
 
     // vars/const
     Procedure TestVarInt;
@@ -149,8 +151,11 @@ type
 
     // strings
     Procedure TestCharConst;
+    Procedure TestChar_Compare;
     Procedure TestStringConst;
+    Procedure TestString_Compare;
     Procedure TestString_SetLength;
+    Procedure TestString_CharAt;
     // ToDo: TestString: read, write []
 
     Procedure TestEmptyProc;
@@ -174,6 +179,9 @@ type
     Procedure TestExit;
     Procedure TestBreak;
     Procedure TestContinue;
+    Procedure TestProcedureExternal;
+    Procedure TestProcedureAsm;
+    Procedure TestProcedureAssembler;
 
     // ToDo: pass by reference
 
@@ -190,9 +198,6 @@ type
     Procedure TestIncDec;
     Procedure TestAssignments;
     Procedure TestArithmeticOperators1;
-    // test integer := double
-    // test integer := integer + double
-    // test pass double to an integer parameter
     Procedure TestLogicalOperators;
     Procedure TestBitwiseOperators;
     Procedure TestFunctionInt;
@@ -211,11 +216,12 @@ type
     Procedure TestCaseOfNoElse;
     Procedure TestCaseOfNoElse_UseSwitch;
     Procedure TestCaseOfRange;
+    Procedure TestWithRecordDo;
 
     // arrays
     Procedure TestArray_Dynamic;
     Procedure TestArray_Dynamic_Nil;
-    // ToDo: TestArray_LowHigh
+    Procedure TestArray_DynMultiDimensional;
 
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
@@ -233,12 +239,15 @@ type
     Procedure TestClass_Property_ClassMethod;
     Procedure TestClass_Property_Index;
     Procedure TestClass_PropertyOfTypeArray;
+    Procedure TestClass_PropertyDefault;
+    Procedure TestClass_Assigned;
+    Procedure TestClass_WithClassDoCreate;
+    Procedure TestClass_WithClassInstDoProperty;
+    Procedure TestClass_WithClassInstDoPropertyWithParams;
+    Procedure TestClass_WithClassInstDoFunc;
     // ToDo: overload
     // ToDo: second constructor
     // ToDo: call another constructor within a constructor
-    // ToDo: call class.classmethod
-    // ToDo: call instance.classmethod
-    // ToDo: property
     // ToDo: event
 
     // ToDo: class of
@@ -888,7 +897,16 @@ begin
   StartProgram(false);
   Add('begin');
   ConvertProgram;
-  CheckSource('Empty program','','');
+  CheckSource('TestEmptyProgram','','');
+end;
+
+procedure TTestModule.TestEmptyProgramUseStrict;
+begin
+  Converter.Options:=Converter.Options+[coUseStrict];
+  StartProgram(false);
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestEmptyProgramUseStrict','"use strict";','');
 end;
 
 procedure TTestModule.TestEmptyUnit;
@@ -897,6 +915,30 @@ begin
   Add('interface');
   Add('implementation');
   ConvertUnit;
+  CheckSource('TestEmptyUnit',
+    LinesToStr([
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestEmptyUnitUseStrict;
+begin
+  Converter.Options:=Converter.Options+[coUseStrict];
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  ConvertUnit;
+  CheckSource('TestEmptyUnitUseStrict',
+    LinesToStr([
+    '"use strict";',
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;'
+    ]),
+    '');
 end;
 
 procedure TTestModule.TestVarInt;
@@ -1563,6 +1605,76 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProcedureExternal;
+begin
+  StartProgram(false);
+  Add('procedure Foo; external name ''console.log'';');
+  Add('function Bar: longint; external name ''get.item'';');
+  Add('function Bla(s: string): longint; external name ''apply.something'';');
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Foo;');
+  Add('  i:=Bar;');
+  Add('  i:=Bla(''abc'');');
+  ConvertProgram;
+  CheckSource('TestProcedureExternal',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    'console.log();',
+    'this.i = get.item();',
+    'this.i = apply.something("abc");'
+    ]));
+end;
+
+procedure TTestModule.TestProcedureAsm;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('begin;');
+  Add('  asm');
+  Add('  { a:{ b:{}, c:[]}, d:''1'' };');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcedureAsm',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '    { a:{ b:{}, c:[]}, d:''1'' };',
+    ';',
+    'return Result;',
+    '};'
+    ]),
+    LinesToStr([
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProcedureAssembler;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint; assembler;');
+  Add('asm');
+  Add('{ a:{ b:{}, c:[]}, d:''1'' };');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcedureAssembler',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '    { a:{ b:{}, c:[]}, d:''1'' };',
+    ';',
+    '};'
+    ]),
+    LinesToStr([
+    ''
+    ]));
+end;
+
 procedure TTestModule.TestEnumName;
 begin
   StartProgram(false);
@@ -1988,6 +2100,49 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestChar_Compare;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:=c=''1'';');
+  Add('  b:=''2''=c;');
+  Add('  b:=''3''=''4'';');
+  Add('  b:=c<>''5'';');
+  Add('  b:=''6''<>c;');
+  Add('  b:=c>''7'';');
+  Add('  b:=''8''>c;');
+  Add('  b:=c>=''9'';');
+  Add('  b:=''A''>=c;');
+  Add('  b:=c<''B'';');
+  Add('  b:=''C''<c;');
+  Add('  b:=c<=''D'';');
+  Add('  b:=''E''<=c;');
+  ConvertProgram;
+  CheckSource('TestChar_Compare',
+    LinesToStr([
+    'this.c="";',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    'this.b = this.c == "1";',
+    'this.b = "2" == this.c;',
+    'this.b = "3" == "4";',
+    'this.b = this.c != "5";',
+    'this.b = "6" != this.c;',
+    'this.b = this.c > "7";',
+    'this.b = "8" > this.c;',
+    'this.b = this.c >= "9";',
+    'this.b = "A" >= this.c;',
+    'this.b = this.c < "B";',
+    'this.b = "C" < this.c;',
+    'this.b = this.c <= "D";',
+    'this.b = "E" <= this.c;',
+    '']));
+end;
+
 procedure TTestModule.TestStringConst;
 begin
   StartProgram(false);
@@ -2002,7 +2157,7 @@ begin
   Add('  s:=''"'';');
   Add('  s:=''"''''"'';');
   ConvertProgram;
-  CheckSource('TestCharConst',
+  CheckSource('TestStringConst',
     LinesToStr([
     'this.s="abc";'
     ]),
@@ -2017,6 +2172,36 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestString_Compare;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s, t: string;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:=s=t;');
+  Add('  b:=s<>t;');
+  Add('  b:=s>t;');
+  Add('  b:=s>=t;');
+  Add('  b:=s<t;');
+  Add('  b:=s<=t;');
+  ConvertProgram;
+  CheckSource('TestString_Compare',
+    LinesToStr([ // statements
+    'this.s = "";',
+    'this.t = "";',
+    'this.b =false;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.b = this.s == this.t;',
+    'this.b = this.s != this.t;',
+    'this.b = this.s > this.t;',
+    'this.b = this.s >= this.t;',
+    'this.b = this.s < this.t;',
+    'this.b = this.s <= this.t;',
+    '']));
+end;
+
 procedure TTestModule.TestString_SetLength;
 begin
   StartProgram(false);
@@ -2033,6 +2218,41 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestString_CharAt;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:= s[1] = c;');
+  Add('  b:= c = s[1];');
+  Add('  b:= c <> s[1];');
+  Add('  b:= c > s[1];');
+  Add('  b:= c >= s[1];');
+  Add('  b:= c < s[1];');
+  Add('  b:= c <= s[1];');
+  Add('  s[1] := c;');
+  ConvertProgram;
+  CheckSource('TestString_CharAt',
+    LinesToStr([ // statements
+    'this.s = "";',
+    'this.c = "";',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.b = this.s.charAt(1-1) == this.c;',
+    'this.b = this.c == this.s.charAt(1 - 1);',
+    'this.b = this.c != this.s.charAt(1 - 1);',
+    'this.b = this.c > this.s.charAt(1 - 1);',
+    'this.b = this.c >= this.s.charAt(1 - 1);',
+    'this.b = this.c < this.s.charAt(1 - 1);',
+    'this.b = this.c <= this.s.charAt(1 - 1);',
+    'this.s = rtl.setCharAt(this.s, 1, this.c);',
+    '']));
+end;
+
 procedure TTestModule.TestProcTwoArgs;
 begin
   StartProgram(false);
@@ -2573,6 +2793,41 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestWithRecordDo;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    vI: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  Int: longint;');
+  Add('  r: TRec;');
+  Add('begin');
+  Add('  with r do');
+  Add('    int:=vi;');
+  Add('  with r do begin');
+  Add('    int:=vi;');
+  Add('    vi:=int;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestWithRecordDo',
+    LinesToStr([ // statements
+    'this.TRec = function () {',
+    '  this.vI = 0;',
+    '};',
+    'this.Int = 0;',
+    'this.r = new this.TRec();'
+    ]),
+    LinesToStr([ // this.$main
+    'var $with1 = this.r;',
+    'this.Int = $with1.vI;',
+    'var $with2 = this.r;',
+    'this.Int = $with2.vI;',
+    '$with2.vI = this.Int;'
+    ]));
+end;
+
 procedure TTestModule.TestClass_TObjectDefaultConstructor;
 begin
   StartProgram(false);
@@ -2605,8 +2860,8 @@ begin
     ]),
     LinesToStr([ // this.$main
     'this.Obj = this.TObject.$create("Create");',
-    'this.Obj.$destroy("Destroy");'
-    ]));
+    'this.Obj.$destroy("Destroy");',
+    '']));
 end;
 
 procedure TTestModule.TestClass_TObjectConstructorWithParams;
@@ -3477,6 +3732,321 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClass_PropertyDefault;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Items[Index: longint]: longint read getitems write setitems; default;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure tobject.setitems(index, value: longint);');
+  Add('begin');
+  Add('  Self[1]:=2;');
+  Add('  Self[3]:=Self[index];');
+  Add('  Self[index]:=Self[Self[value]];');
+  Add('  Self[Self[4]]:=value;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj[11]:=12;');
+  Add('  obj[13]:=obj[14];');
+  Add('  obj[obj[15]]:=obj[obj[15]];');
+  ConvertProgram;
+  CheckSource('TestClass_PropertyDefault',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '    this.SetItems(1, 2);',
+    '    this.SetItems(3, this.GetItems(Index));',
+    '    this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
+    '    this.SetItems(this.GetItems(4), Value);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Obj.SetItems(11, 12);',
+    'this.Obj.SetItems(13, this.Obj.GetItems(14));',
+    'this.Obj.SetItems(this.Obj.GetItems(15), this.Obj.GetItems(this.Obj.GetItems(15)));'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Assigned;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  if Assigned(obj) then ;');
+  Add('  b:=Assigned(obj) or false;');
+  ConvertProgram;
+  CheckSource('TestClass_Assigned',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // this.$main
+    'if (this.Obj != null) {',
+    '};',
+    'this.b = (this.Obj != null) || false;'
+    ]));
+end;
+
+procedure TTestModule.TestClass_WithClassDoCreate;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    aBool: boolean;');
+  Add('    Arr: array of boolean;');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  with tobject.create do begin');
+  Add('    b:=abool;');
+  Add('    abool:=b;');
+  Add('    b:=arr[1];');
+  Add('    arr[2]:=b;');
+  Add('  end;');
+  Add('  with tobject do');
+  Add('    obj:=create;');
+  Add('  with obj do begin');
+  Add('    create;');
+  Add('    b:=abool;');
+  Add('    abool:=b;');
+  Add('    b:=arr[3];');
+  Add('    arr[4]:=b;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassDoCreate',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.aBool = false;',
+    '    this.Arr = [];',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $with1 = this.TObject.$create("Create");',
+    'this.b = $with1.aBool;',
+    '$with1.aBool = this.b;',
+    'this.b = $with1.Arr[1];',
+    '$with1.Arr[2] = this.b;',
+    'var $with2 = this.TObject;',
+    'this.Obj = $with2.$create("Create");',
+    'var $with3 = this.Obj;',
+    '$with3.Create();',
+    'this.b = $with3.aBool;',
+    '$with3.aBool = this.b;',
+    'this.b = $with3.Arr[3];',
+    '$with3.Arr[4] = this.b;',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FInt: longint;');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('    property Int: longint read FInt write FInt;');
+  Add('    property Size: longint read GetSize write SetSize;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin; end;');
+  Add('procedure TObject.SetSize(Value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=int;');
+  Add('    int:=i;');
+  Add('    i:=size;');
+  Add('    size:=i;');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=int;');
+  Add('    int:=i;');
+  Add('    i:=size;');
+  Add('    size:=i;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoProperty',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FInt = 0;',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetSize = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $with1 = this.TObject.$create("Create");',
+    'this.i = $with1.FInt;',
+    '$with1.FInt = this.i;',
+    'this.i = $with1.GetSize();',
+    '$with1.SetSize(this.i);',
+    'var $with2 = this.Obj;',
+    'this.i = $with2.FInt;',
+    '$with2.FInt = this.i;',
+    'this.i = $with2.GetSize();',
+    '$with2.SetSize(this.i);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Items[Index: longint]: longint read GetItems write SetItems;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function tobject.getitems(index: longint): longint; begin; end;');
+  Add('procedure tobject.setitems(index, value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=Items[1];');
+  Add('    Items[2]:=i;');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=Items[3];');
+  Add('    Items[4]:=i;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoPropertyWithParams',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $with1 = this.TObject.$create("Create");',
+    'this.i = $with1.GetItems(1);',
+    '$with1.SetItems(2, this.i);',
+    'var $with2 = this.Obj;',
+    'this.i = $with2.GetItems(3);',
+    '$with2.SetItems(4, this.i);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin; end;');
+  Add('procedure TObject.SetSize(Value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=GetSize;');
+  Add('    i:=GetSize();');
+  Add('    SetSize(i);');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=GetSize;');
+  Add('    i:=GetSize();');
+  Add('    SetSize(i);');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoFunc',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetSize = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'var $with1 = this.TObject.$create("Create");',
+    'this.i = $with1.GetSize();',
+    'this.i = $with1.GetSize();',
+    '$with1.SetSize(this.i);',
+    'var $with2 = this.Obj;',
+    'this.i = $with2.GetSize();',
+    'this.i = $with2.GetSize();',
+    '$with2.SetSize(this.i);',
+    '']));
+end;
+
 procedure TTestModule.TestArray_Dynamic;
 begin
   StartProgram(false);
@@ -3484,20 +4054,30 @@ begin
   Add('  TArrayInt = array of longint;');
   Add('var');
   Add('  Arr: TArrayInt;');
+  Add('  i: longint;');
   Add('begin');
   Add('  SetLength(arr,3);');
   Add('  arr[0]:=4;');
   Add('  arr[1]:=length(arr)+arr[0];');
+  Add('  arr[i]:=5;');
+  Add('  arr[arr[i]]:=arr[6];');
+  Add('  i:=low(arr);');
+  Add('  i:=high(arr);');
   ConvertProgram;
   CheckSource('TestArray_Dynamic',
     LinesToStr([ // statements
-    'this.Arr = [];'
+    'this.Arr = [];',
+    'this.i = 0;'
     ]),
     LinesToStr([ // this.$main
     'this.Arr = rtl.setArrayLength(this.Arr,3,0);',
     'this.Arr[0] = 4;',
-    'this.Arr[1] = rtl.length(this.Arr)+this.Arr[0];'
-    ]));
+    'this.Arr[1] = rtl.length(this.Arr)+this.Arr[0];',
+    'this.Arr[this.i] = 5;',
+    'this.Arr[this.Arr[this.i]] = this.Arr[6];',
+    'this.i = 0;',
+    'this.i = rtl.length(this.Arr);',
+    '']));
 end;
 
 procedure TTestModule.TestArray_Dynamic_Nil;
@@ -3523,6 +4103,56 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestArray_DynMultiDimensional;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('  TArrayArrayInt = array of TArrayInt;');
+  Add('var');
+  Add('  Arr: TArrayInt;');
+  Add('  Arr2: TArrayArrayInt;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  arr2:=nil;');
+  Add('  if arr2=nil then;');
+  Add('  if nil=arr2 then;');
+  Add('  i:=low(arr2);');
+  Add('  i:=low(arr2[1]);');
+  Add('  i:=high(arr2);');
+  Add('  i:=high(arr2[2]);');
+  Add('  arr2[3]:=arr;');
+  Add('  arr2[4][5]:=i;');
+  Add('  i:=arr2[6][7];');
+  Add('  arr2[8,9]:=i;');
+  Add('  i:=arr2[10,11];');
+  Add('  SetLength(arr2,14);');
+  Add('  SetLength(arr2[15],16);');
+  ConvertProgram;
+  CheckSource('TestArray_Dynamic',
+    LinesToStr([ // statements
+    'this.Arr = [];',
+    'this.Arr2 = [];',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Arr2 = null;',
+    'if (this.Arr2 == null) {};',
+    'if (null == this.Arr2) {};',
+    'this.i = 0;',
+    'this.i = 0;',
+    'this.i = rtl.length(this.Arr2);',
+    'this.i = rtl.length(this.Arr2[2]);',
+    'this.Arr2[3] = this.Arr;',
+    'this.Arr2[4][5] = this.i;',
+    'this.i = this.Arr2[6][7];',
+    'this.Arr2[8][9] = this.i;',
+    'this.i = this.Arr2[10][11];',
+    'this.Arr2 = rtl.setArrayLength(this.Arr2, 14, []);',
+    'this.Arr2[15] = rtl.setArrayLength(this.Arr2[15], 16, 0);',
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.

Niektoré súbory nie sú zobrazené, pretože je v týchto rozdielových dátach zmenené mnoho súborov